uses
PsAPI, TlHelp32;
function RunningProcessesList(
const List: TStrings; FullPath: Boolean): Boolean;
// Portions by jedi
const
RsSystemIdleProcess = '
System Idle Process';
RsSystemProcess = '
System Process';
function IsWinXP_or_Above: Boolean;
begin
Result := (Win32Platform = VER_PLATFORM_WIN32_NT)
and
(Win32MajorVersion >= 5)
and (Win32MinorVersion >= 1);
end;
function IsWin2k: Boolean;
begin
Result := (Win32MajorVersion >= 5)
and
(Win32Platform = VER_PLATFORM_WIN32_NT);
end;
function IsWinNT4: Boolean;
begin
Result := Win32Platform = VER_PLATFORM_WIN32_NT;
Result := Result
and (Win32MajorVersion = 4);
end;
function IsWin3X: Boolean;
begin
Result := Win32Platform = VER_PLATFORM_WIN32_NT;
Result := Result
and (Win32MajorVersion = 3)
and
((Win32MinorVersion = 1)
or (Win32MinorVersion = 5)
or (Win32MinorVersion = 51));
end;
function ProcessFileName(PID: DWORD):
string;
var
Handle: THandle;
begin
Result := '
';
Handle := OpenProcess(PROCESS_QUERY_INFORMATION
or PROCESS_VM_READ, Bool(False), PID);
if Handle <> 0
then
try
SetLength(Result, MAX_PATH);
if FullPath
then
begin
if GetModuleFileNameEx(
Handle, 0, PChar(Result), MAX_PATH) > 0
then
SetLength(Result, StrLen(PChar(Result)))
else
Result := '
';
end
else
begin
if GetModuleBaseNameA(
Handle, 0, PChar(Result), MAX_PATH) > 0
then
SetLength(Result, StrLen(PChar(Result)))
else
Result := '
';
end;
finally
CloseHandle(
Handle);
end;
end;
function BuildListTH: Boolean;
var
SnapProcHandle: THandle;
ProcEntry: TProcessEntry32;
NextProc: Boolean;
FileName:
string;
begin
SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
Result := (SnapProcHandle <> INVALID_HANDLE_VALUE);
if Result
then
try
ProcEntry.dwSize := SizeOf(ProcEntry);
NextProc := Process32First(SnapProcHandle, ProcEntry);
while NextProc
do
begin
if ProcEntry.th32ProcessID = 0
then
begin
// PID 0 is always the "System Idle Process" but this name cannot be
// retrieved from the system and has to be fabricated.
FileName := RsSystemIdleProcess;
end
else
begin
if IsWin2k
or IsWinXP_or_Above
then
begin
FileName := ProcessFileName(ProcEntry.th32ProcessID);
if FileName = '
'
then
FileName := ProcEntry.szExeFile;
end
else
begin
FileName := ProcEntry.szExeFile;
if not FullPath
then
FileName := ExtractFileName(FileName);
end;
end;
List.AddObject(FileName, Pointer(ProcEntry.th32ProcessID));
NextProc := Process32Next(SnapProcHandle, ProcEntry);
end;
finally
CloseHandle(SnapProcHandle);
end;
end;
function BuildListPS: Boolean;
var
PIDs:
array[0..1024]
of DWORD;
Needed: DWORD;
I: Integer;
FileName:
string;
begin
Result := EnumProcesses(@PIDs, SizeOf(PIDs), Needed);
if Result
then
begin
for I := 0
to (Needed
div SizeOf(DWORD)) - 1
do
begin
case PIDs[I]
of
0:
// PID 0 is always the "System Idle Process" but this name cannot be
// retrieved from the system and has to be fabricated.
FileName := RsSystemIdleProcess;
2:
// On NT 4 PID 2 is the "System Process" but this name cannot be
// retrieved from the system and has to be fabricated.
if IsWinNT4
then
FileName := RsSystemProcess
else
FileName := ProcessFileName(PIDs[I]);
8:
// On Win2K PID 8 is the "System Process" but this name cannot be
// retrieved from the system and has to be fabricated.
if IsWin2k
or IsWinXP_or_Above
then
FileName := RsSystemProcess
else
FileName := ProcessFileName(PIDs[I]);
else
FileName := ProcessFileName(PIDs[I]);
end;
if FileName <> '
'
then
List.AddObject(FileName, Pointer(PIDs[I]));
end;
end;
end;
begin
if IsWin3X
or IsWinNT4
then
Result := BuildListPS
else
Result := BuildListTH;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
List: TStrings;
begin
List := TStringList.Create;
try
RunningProcessesList(List, True);
ListBox1.Items.Assign(List);
finally
List. Free;
end;
end;