Server : Apache/2.4.43 (Win64) OpenSSL/1.1.1g PHP/7.4.6
System : Windows NT USER-PC 6.1 build 7601 (Windows 7 Professional Edition Service Pack 1) AMD64
User : User ( 0)
PHP Version : 7.4.6
Disable Function : NONE
Directory :  C:/xampp/src/xampp-control-panel/
Upload File :
Current Directory [ Writeable ] Root Directory [ Writeable ]


Current File : C:/xampp/src/xampp-control-panel/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);

  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;

initialization

Processes := tProcesses.Create;

finalization

Processes.Free;

end.