Gecko [ 8.222.176.185 ]

Name	Size	Permission
gfx	[ DIR ]	drwxrwxrwx
locale	[ DIR ]	drwxrwxrwx
.mad-root	0 B	-rw-rw-rw-
VersInfo.pas	42.97 KB	-rw-rw-rw-
adminer.php	465.43 KB	-rw-rw-rw-
default.po	32.22 KB	-rw-rw-rw-
ggexclude.cfg	227 B	-rw-rw-rw-
gnugettext.pas	114.84 KB	-rw-rw-rw-
ignore.po	7.28 KB	-rw-rw-rw-
pwnkit	10.99 KB	-rw-rw-rw-
sonar-project.properties	464 B	-rw-rw-rw-
uApache.pas	15.79 KB	-rw-rw-rw-
uBaseModule.pas	2.25 KB	-rw-rw-rw-
uConfig.dfm	14.81 KB	-rw-rw-rw-
uConfig.pas	4.43 KB	-rw-rw-rw-
uConfigUserDefined.dfm	14.73 KB	-rw-rw-rw-
uConfigUserDefined.pas	3.36 KB	-rw-rw-rw-
uExceptionDialog.dcu	32.71 KB	-rw-rw-rw-
uExceptionDialog.dfm	2.08 KB	-rw-rw-rw-
uExceptionDialog.pas	27.37 KB	-rw-rw-rw-
uFileZilla.pas	14.85 KB	-rw-rw-rw-
uGetWinVersionInfo.dcu	8.09 KB	-rw-rw-rw-
uGetWinVersionInfo.pas	11.13 KB	-rw-rw-rw-
uHelp.dfm	3.18 KB	-rw-rw-rw-
uHelp.pas	1.81 KB	-rw-rw-rw-
uJclSysInfo.pas	22.05 KB	-rw-rw-rw-
uLanguage.dfm	12.95 KB	-rw-rw-rw-
uLanguage.pas	2 KB	-rw-rw-rw-
uLogOptions.dfm	6.42 KB	-rw-rw-rw-
uLogOptions.pas	2.1 KB	-rw-rw-rw-
uMain.dfm	217.14 KB	-rw-rw-rw-
uMain.pas	39.26 KB	-rw-rw-rw-
uMercury.pas	11.42 KB	-rw-rw-rw-
uMySQL.pas	13.95 KB	-rw-rw-rw-
uNetstat.dfm	3.53 KB	-rw-rw-rw-
uNetstat.pas	7.95 KB	-rw-rw-rw-
uNetstatTable.pas	7.58 KB	-rw-rw-rw-
uProcesses.pas	6.25 KB	-rw-rw-rw-
uProcesses_new.pas	2.14 KB	-rw-rw-rw-
uServiceSettings.dfm	16.89 KB	-rw-rw-rw-
uServiceSettings.pas	8.26 KB	-rw-rw-rw-
uServices.pas	6.14 KB	-rw-rw-rw-
uTomcat.pas	15.9 KB	-rw-rw-rw-
uTools.pas	26.61 KB	-rw-rw-rw-
xampp_control3.dpr	2.21 KB	-rw-rw-rw-
xampp_control3.dproj	30.26 KB	-rw-rw-rw-
xampp_control3.dproj.local	38.45 KB	-rw-rw-rw-
xampp_control3.drc	78.46 KB	-rw-rw-rw-
xampp_control3.dres	37.08 KB	-rw-rw-rw-
xampp_control3.identcache	1.29 KB	-rw-rw-rw-
xampp_control3.stat	170 B	-rw-rw-rw-
xampp_control3Resource.rc	341 B	-rw-rw-rw-
xampp_control3_project.tvsconf...	72 B	-rw-rw-rw-

Code Editor : uProcesses.pas

unit uProcesses;

interface

uses GnuGettext, TlHelp32, uTools, Classes, SysUtils, Windows, ExtCtrls, PsAPI;

type
  TProcInfo = class
    PID: integer;
    Module, ExePath: String;
    CanDelete: boolean;
  end;

tProcesses = class
  public
    ProcessList: tList;
    function GetProcInfo(PID: integer): TProcInfo;
    procedure Update;
    procedure UpdateProcesses;
    constructor Create;
    destructor Destroy; override;
  end;

function GetProcessPath(PID: Cardinal): string;

var
  Processes: tProcesses;

implementation

uses uMain;

const
  cModuleName = 'procs';

{ tProcessList }

constructor tProcesses.Create;
begin
  ProcessList := tList.Create;
end;

destructor tProcesses.Destroy;
var
  ProcInfo: TProcInfo;
  p: integer;
begin
  for p := 0 to ProcessList.Count - 1 do
  begin
    ProcInfo := ProcessList[p];
    FreeAndNil(ProcInfo);
  end;
  FreeAndNil(ProcessList);
  inherited;
end;

function GetProcessPath(PID: Cardinal): string;
var
  hProcess: THandle;
begin
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,PID);
  if hProcess <> 0 then
  begin
    try
      SetLength(Result,MAX_PATH);
      FillChar(Result[1],Length(Result) * SizeOf(Char), 0);
      if GetModuleFileNameEx(hProcess,0,PChar(Result),Length(Result)) > 0 then
        Result := Trim(Result)
      else
        Result := 'Unable to get info';
    finally
      CloseHandle(hProcess)
    end;
  end
  else
    Result := 'Unable to open process';
end;

function tProcesses.GetProcInfo(PID: integer): TProcInfo;
var
  ProcInfo: TProcInfo;
  p: integer;
begin
  for p := 0 to ProcessList.Count - 1 do
  begin
    ProcInfo := ProcessList[p];
    if ProcInfo.PID = PID then
    begin
      result := ProcInfo;
      exit;
    end;
  end;
  result := nil;
end;

procedure tProcesses.UpdateProcesses;
var
  hSnapShot: THandle;
  pe32: TProcessEntry32;
  ProcInfo: TProcInfo;
  i: integer;
begin

for i := 0 to ProcessList.Count - 1 do
  begin
    ProcInfo := ProcessList[i];
    ProcInfo.CanDelete := true;
  end;

hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  if hSnapShot <> INVALID_HANDLE_VALUE then
  begin
    try
      pe32.dwSize := SizeOf(pe32);
      if Process32First(hSnapshot,pe32) then
      repeat
        ProcInfo := TProcInfo.Create;
        ProcInfo.Module := LowerCase(Trim(pe32.szExeFile));
        //ProcInfo.ExePath := LowerCase(Trim(GetProcessPath(pe32.th32ProcessID)));
        ProcInfo.ExePath := LowerCase(Trim(pe32.szExeFile));
        ProcInfo.PID := pe32.th32ProcessID;
        if Length(ProcInfo.ExePath) <> 0 then
          ProcInfo.CanDelete := false
        else
          ProcInfo.CanDelete := true;
        ProcessList.Add(ProcInfo);
        pe32.dwSize := SizeOf(pe32);
      until Process32Next(hSnapshot,pe32) = False;
    finally
      CloseHandle(hSnapShot);
    end;
  end;

i := 0;
  while i < ProcessList.Count do
  begin
    ProcInfo := ProcessList[i];
    if ProcInfo.CanDelete then
    begin
      fMain.AddLog(cModuleName, Format(_('Deleting PID-entry %d: %s'), [ProcInfo.PID, ProcInfo.ExePath]), ltDebugDetails);
      FreeAndNil(ProcInfo);
      ProcessList.Delete(i);
    end
    else
    begin
      inc(i);
    end;
  end;

end;

procedure tProcesses.Update;
var
  hProcessSnap: tHandle;
  TProcessEntry: TProcessEntry32;
  ProcInfo: TProcInfo;
  hModuleSnap: tHandle;
  ModuleEntry: MODULEENTRY32;
  i: integer;
  PID: Cardinal;
begin
   fMain.AddLog('processes', 'Checking processes...', ltDebugDetails);

for i := 0 to ProcessList.Count - 1 do
  begin
    ProcInfo := ProcessList[i];
    ProcInfo.CanDelete := true;
  end;

hProcessSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if (hProcessSnap = INVALID_HANDLE_VALUE) then
    exit;
  TProcessEntry.dwSize := SizeOf(TProcessEntry);
  if (Process32First(hProcessSnap, TProcessEntry)) then
  begin
    repeat
      PID := TProcessEntry.th32ProcessID;
      ProcInfo := GetProcInfo(PID);
      if ProcInfo <> nil then
      begin
        ProcInfo.CanDelete := false
      end
      else
      begin
        // hModuleSnap := INVALID_HANDLE_VALUE;
        hModuleSnap := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, TProcessEntry.th32ProcessID);
        if (hModuleSnap <> INVALID_HANDLE_VALUE) then
        begin
          ModuleEntry.dwSize := SizeOf(MODULEENTRY32);
          if (Module32First(hModuleSnap, &ModuleEntry)) then
          begin
            ProcInfo := TProcInfo.Create;
            ProcInfo.Module := LowerCase(ModuleEntry.szModule);
            ProcInfo.ExePath := LowerCase(ModuleEntry.szExePath);
            //ProcInfo.ExePath := LowerCase(GetProcessPath(TProcessEntry.th32ProcessID));
            ProcInfo.PID := TProcessEntry.th32ProcessID;
            ProcInfo.CanDelete := false;
            ProcessList.Add(ProcInfo);
          end
          else
          begin
            ProcInfo := nil;
          end;
        end
        else
        begin
          ProcInfo := TProcInfo.Create;
          ProcInfo.Module := LowerCase(TProcessEntry.szExeFile);
          ProcInfo.ExePath := LowerCase(TProcessEntry.szExeFile);
          //ProcInfo.ExePath := LowerCase(ModuleEntry.szExePath);
          //ProcInfo.ExePath := LowerCase(GetProcessPath(TProcessEntry.th32ProcessID));
          ProcInfo.PID := TProcessEntry.th32ProcessID;
          ProcInfo.CanDelete := false;
          ProcessList.Add(ProcInfo);
        end;
        if ProcInfo <> nil then
          fMain.AddLog(cModuleName, Format(_('Creating PID-entry %d: %s'), [ProcInfo.PID, ProcInfo.ExePath]), ltDebugDetails);
        CloseHandle(hModuleSnap);
      end;
    until not(Process32Next(hProcessSnap, TProcessEntry));
  end;
  CloseHandle(hProcessSnap);

initialization

Processes := tProcesses.Create;

finalization

Processes.Free;

end.

${this.title}

Code Editor : uProcesses.pas