Enumerate Processes

posted 16 Mar 2010, 08:41 by Delphi Basics
In computing, a process is an instance of a computer program that is being executed. It contains the program code and its current activity. Depending on the operating system (OS), a process may be made up of multiple threads of execution that execute instructions concurrently.

Read more: http://en.wikipedia.org/wiki/Process_%28computing%29

uses
  PSAPI, TlHelp32;

function GetProcessName(PID: DWORD; var ProcessName: string): DWORD;
var
  dwReturn     : DWORD;
  hProc        : Cardinal;
  buffer       : array[0..MAX_PATH - 1] of Char;
begin
  dwReturn := 0;
  Zeromemory(@buffer, sizeof(buffer));
  hProc := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, PID);
  if hProc <> 0 then
  begin
    GetModulebaseName(hProc, 0, buffer, sizeof(buffer));
    ProcessName := (string(buffer));
    CloseHandle(hProc);
  end
  else
    dwReturn := GetLastError;
  result := dwReturn;
end;

type
  TPIDList = array of DWORD;

function GetProcessList(var ProcessList: TPIDList): DWORD;

  function GetOSVersionInfo(var Info: TOSVersionInfo): Boolean;
  begin
    FillChar(Info, SizeOf(TOSVersionInfo), 0);
    Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
    Result := GetVersionEx(TOSVersionInfo(Addr(Info)^));
    if (not Result) then
    begin
      FillChar(Info, SizeOf(TOSVersionInfo), 0);
      Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
      Result := GetVersionEx(TOSVersionInfo(Addr(Info)^));
      if (not Result) then
        Info.dwOSVersionInfoSize := 0;
    end;
  end;

var
  dwReturn     : DWORD;
  OS           : TOSVersionInfo;
  // EnumProcesses
  PidProcesses : PDWORD;
  PidWork      : PDWORD;
  BufferSize   : Cardinal;
  Needed       : DWORD;
  cntProcesses : Cardinal;
  i            : Cardinal;
  // CreateToolhelp32Snapshot
  hProcSnapShot: THandle;
  pe32         : TProcessEntry32;
  j            : Cardinal;

begin
  dwReturn := 0;
  // What OS are we running on?
  if GetOSVersionInfo(OS) then
  begin
    if (OS.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OS.dwMajorVersion = 4) then
    // WinNT and higher
    begin
      Needed := 0;
      BufferSize := 1024;
      GetMem(PidProcesses, BufferSize);
      // make sure memory is allocated
      if Assigned(PidProcesses) then
      begin
        try
          // enumerate the processes
          if EnumProcesses(PidProcesses, BufferSize, Needed) then
          begin
            dwReturn := 0;
            cntProcesses := Needed div sizeof(DWORD) - 1;
            PidWork := PidProcesses;
            setlength(ProcessList, cntProcesses);
            // walk the processes
            for i := 0 to cntProcesses - 1 do
            begin
              ProcessList[i] := PidWork^;
              Inc(PidWork);
            end;
          end
          else // EnumProcesses = False
            dwReturn := GetLastError;
        finally
          // clean up no matter what happend
          FreeMem(PidProcesses, BufferSize);
        end;
      end
      else // GetMem = nil
        dwReturn := GetLastError;
    end
    // Win 9x and higher except WinNT
    else
    begin
      // make the snapshot
      hProcSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
      if hProcSnapShot <> INVALID_HANDLE_VALUE then
      begin
        pe32.dwSize := sizeof(TProcessEntry32);
        j := 0;
        setlength(ProcessList, j + 1);
        if Process32First(hProcSnapShot, pe32) then
        begin
          // first process
          ProcessList[j] := pe32.th32ProcessID;
          // walk the processes
          while Process32Next(hProcSnapShot, pe32) do
          begin
            Inc(j);
            setlength(ProcessList, j + 1);
            ProcessList[j] := pe32.th32ProcessID;
          end;
        end
        else // Process32First = False
          dwReturn := GetLastError;
        CloseHandle(hProcSnapShot);
      end
      else // hSnapShot = INVALID_HANDLE_VALUE
        dwReturn := GetLastError;
    end;
  end;
  result := dwReturn;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  retValue     : DWORD;
  ProcessList  : TPIDList;
  i            : Integer;
  ProcessName  : string;
  PID          : DWORD;
resourcestring
  rsUnknown    = 'unbekannt';
begin
  // VCL causes last error to be set, even nothing has already happend :-/
  SetLastError(0);
  retValue := GetProcessList(ProcessList);
  if retValue = 0 then
  begin
    for i := 0 to length(ProcessList) - 1 do
    begin
      PID := ProcessList[i];
      if GetProcessName(ProcessList[i], ProcessName) <> 0 then
        ProcessName := rsUnknown;
      Listbox1.Items.Add(IntToStr(PID) + ' - ' + ProcessName);
    end;
  end
  else
    ShowMessage(SysErrorMessage(retValue));
end;
Comments