获取进程列表的单元

unit ProcessInfos;

interface

uses
Windows, TLHelp32, PsAPI, SysUtils;

type
TProcessInfo = record
PID: Cardinal;
PathName: string;
CMDName: string;
end;
PProcessInfo = ^TProcessInfo;
TProcessInfos = array of TProcessInfo;

procedure GetProcessInfos(var APIList: TProcessInfos);
function FindProcess(APathName: string; var API: TProcessInfo): Boolean;
function GetProcessInfo(APID: Cardinal; API: PProcessInfo): Boolean;

implementation

type
UNICODE_STRING = packed record
Length: Word;
MaximumLength: Word;
Buffer: PWideChar;
end;
PUNICODE_STRING = UNICODE_STRING;

PROCESS_PARAMETERS = packed record
AllocationSize: ULONG;
ActualSize: ULONG;
Flags: ULONG;
Unknown1: ULONG;
Unknown2: UNICODE_STRING;
InputHandle: THandle;
OutputHandle: THandle;
ErrorHandle: THandle;
CurrentDirectory: UNICODE_STRING;
CurrentDirectoryHandle: THandle;
SearchPaths: UNICODE_STRING;
ApplicationName: UNICODE_STRING;
CommandLine: UNICODE_STRING;
EnvironmentBlock: Pointer;
Unknown: array[0..9 - 1] of ULONG;
Unknown3: UNICODE_STRING;
Unknown4: UNICODE_STRING;
Unknown5: UNICODE_STRING;
Unknown6: UNICODE_STRING;
end;
PPROCESS_PARAMETERS = ^PROCESS_PARAMETERS;

PEB = packed record
AllocationSize: ULONG;
Unknown1: ULONG;
ProcessHinstance: Longword;
ListDlls: Pointer;
ProcessParameters: PPROCESS_PARAMETERS;
Unknown2: ULONG;
Heap: THandle;
end;
PPEB = ^PEB;

_PROCESS_BASIC_INFORMATION = packed record
Reserved1: Pointer;
PebBaseAddress: PPEB;
Reserved2: array[0..1] of Pointer;
UniqueProcessId: PULONG;
Reserved3: Pointer;
end;
PROCESS_BASIC_INFORMATION = _PROCESS_BASIC_INFORMATION;
PPROCESS_BASIC_INFORMATION = ^PROCESS_BASIC_INFORMATION;
PROCESSINFOCLASS = (
ProcessBasicInformation = 0,
ProcessWow64Information = 26
);
NTSTATUS = DWORD;

function NtQueryInformationProcess(
ProcessHandle: THandle;
ProcessInformationClass: PROCESSINFOCLASS;
ProcessInformation: Pointer;
ProcessInformationLength: ULONG;
ReturnLength: PULONG
): NTSTATUS; stdcall; external 'ntdll.dll' name 'NtQueryInformationProcess';

var
_SystemRoot: string;

procedure GetProcessInfos(var APIList: TProcessInfos);
var
nContinueLoop: BOOL;
nSnapShotHandle: THandle;
nProcessEntry32: TProcessEntry32;
nCount: Word;
begin
nSnapShotHandle := CreateToolhelp32SnapShot(TH32CS_SNAPPROCESS, 0);
try
nProcessEntry32.dwSize := SizeOf(nProcessEntry32);
nContinueLoop := Process32First(nSnapShotHandle, nProcessEntry32);

SetLength(APIList, 65536);
nCount := 0;

while nContinueLoop do
begin
if GetProcessInfo(nProcessEntry32.th32ProcessID, @APIList[nCount]) then
Inc(nCount);
nContinueLoop := Process32Next(nSnapShotHandle, nProcessEntry32);
end;

SetLength(APIList, nCount);
finally
CloseHandle(nSnapShotHandle);
end;
end;

function FindProcess(APathName: string; var API: TProcessInfo): Boolean;
var
nContinueLoop: BOOL;
nSnapShotHandle: THandle;
nProcessEntry32: TProcessEntry32;
nR: TProcessInfo;
begin
Result := False;
nSnapShotHandle := CreateToolhelp32SnapShot(TH32CS_SNAPPROCESS, 0);
try
nProcessEntry32.dwSize := SizeOf(nProcessEntry32);
nContinueLoop := Process32First(nSnapShotHandle, nProcessEntry32);

while nContinueLoop do
begin
if GetProcessInfo(nProcessEntry32.th32ProcessID, @nR) then
begin
if SameText(nR.PathName, APathName) then
begin
API := nR;
Result := True;
Break;
end;
end;
nContinueLoop := Process32Next(nSnapShotHandle, nProcessEntry32);
end;
finally
CloseHandle(nSnapShotHandle);
end;
end;

function GetProcessInfo(APID: Cardinal; API: PProcessInfo): Boolean;

procedure _CurePath(var APath: string);
begin
APath := Trim(APath);
if APath = '' then
Exit;
if Copy(APath, 1, 4) = '\??\' then
{类似\??\c:\windows\system32\winlogon.exe的路径}
APath := Copy(APath, 5, Length(APath))
else if Copy(APath, 1, 12) = '\SystemRoot\' then
{类似\SystemRoot\system32\smss.exe的路径}
APath := IncludeTrailingBackslash(_SystemRoot) + ExtractFileName(APath);
end;

var
nPHandle: THandle;
nStr: string;
nStrC: WideString;
nPBI: PROCESS_BASIC_INFORMATION;
nR: Cardinal;
nPEB: PEB;
nPP: PROCESS_PARAMETERS;
nCount: Word;
nBuff: array [0..MAX_PATH] of Char;
begin
Result := False;
if API = nil then
Exit;

nPHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, APID);

if nPHandle = 0 then
Exit;

try
if GetModuleFileNameEx(nPHandle, 0, @nBuff[0], SizeOf(nBuff)) > 0 then
API^.PathName := nBuff
else
API^.PathName := '';

try
if NtQueryInformationProcess(nPHandle, ProcessBasicInformation, @nPBI, SizeOf(nPBI), @nR) <> 0 then
Abort;
if not ReadProcessMemory(nPHandle, nPBI.PebBaseAddress, @nPEB, SizeOf(nPEB), nR) then
Abort;
if not ReadProcessMemory(nPHandle, nPEB.ProcessParameters, @nPP, SizeOf(nPP), nR) then
Abort;
if nPP.CommandLine.Length = 0 then
Abort;
SetLength(nStrC, nPP.CommandLine.Length div 2);
if not ReadProcessMemory(nPHandle, nPP.CommandLine.Buffer, @nStrC[1],
nPP.CommandLine.Length, nR) then
Abort;
API^.CMDName := nStrC;
except
API^.CMDName := '';
end;
finally
CloseHandle(nPHandle);
end;

_CurePath(API^.PathName);
_CurePath(API^.CMDName);
API^.PID := APID;
Result := True;
end;

var
nBuff: array [0..MAX_PATH] of Char;
initialization
GetSystemDirectory(nBuff, SizeOf(nBuff));
_SystemRoot := nBuff;

end.