获取进程列表的单元

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.