Enumerate Processes
Post date: Mar 16, 2010 3:41:16 PM
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;