Delphi-PRAXiS - Delphi EnumProcesses

nein, das ganze funktioniert mit NtQuerySystemInformation().

Ich hab mal die Funktion EnumProcesses in Delphi nachgebaut, so oder sehr Aehnlich duerfte sie Microsoft implementiert haben:

Delphi-Quellcode:

			const

  SystemProcessInformation = 5;

  STATUS_INFO_LENGTH_MISMATCH = Integer($C0000004);

type

  UNICODE_STRING = record

    Length: Word;

    MaximumLength: Word;

    Buffer: PWideChar;

  end;

  PUNICODE_STRING = ^UNICODE_STRING;

  TUNICODE_STRING = UNICODE_STRING;

  _SYSTEM_PROCESS_INFORMATION = record

    NextEntryOffset: ULONG;

    NumberOfThreads: ULONG;

    SpareLi1, SpareLi2, SpareLi3: TLargeInteger;

    CreateTime, UserTime, KernelTime: TLargeInteger;

    ImageName: UNICODE_STRING;

    BasePriority: ULONG;

    UniqueProcessId: THandle;

    InheritedFromUniqueProcessId: THandle;

    HandleCount: ULONG;

    SessionId: ULONG;

    SpareUl3: ULONG;

    PeekVirtualSize: ULONG;

    VirtualSize: ULONG;

    PageFaultCount: ULONG;

    PeakWorkingSetSize: ULONG;

    WorkingSetSize: ULONG;

    QuotaPeakPagedPoolUsage: ULONG;

    QuotaPagedPoolUsage: ULONG;

    QuotaPeakNonPagedPoolUsage: ULONG;

    QuotaNonPagedPoolUsage: ULONG;

    PagefileUsage: ULONG;

    PeakPagefileUsage: ULONG;

    PrivatePageCount: ULONG;

  end;

  TSYSTEM_PROCESS_INFORMATION = _SYSTEM_PROCESS_INFORMATION;

  PSYSTEM_PROCESS_INFORMATION = ^TSYSTEM_PROCESS_INFORMATION;

function NtQuerySystemInformation(SystemInformationClass: Cardinal;

                                  SystemInformation: Pointer;

                                  Length: ULONG;

                                  ResultLength: PULONG): Integer; stdcall; external 'ntdll.dll';

function RtlNtStatusToDosError(StatusCode: Integer): DWORD; stdcall; external 'ntdll.dll';

function EnumProcesses(pProcessIds: PDWORD; cb: DWORD; var pBytesReturned: DWORD): BOOL; stdcall;

const

  BUF_SIZE = $10000;

var

  ProcListBuffer: PChar;

  ProcessInfo: PSYSTEM_PROCESS_INFORMATION;

  ProcOffset: ULONG;

  BufSize: Cardinal;

  Status: Integer;

begin

  Result := false;

  // capture the process list

  BufSize := BUF_SIZE;

  repeat

    GetMem(ProcListBuffer, BufSize);

    if ProcListBuffer = nil then

    begin

      SetLastError(ERROR_NOT_ENOUGH_MEMORY);

      Exit;

    end;

    Status := NtQuerySystemInformation(SystemProcessInformation,

                                       ProcListBuffer,

                                       BufSize,

                                       nil);

    if Status = STATUS_INFO_LENGTH_MISMATCH then

    begin

      // Buffer was too small, increase the buffer size and try again

      FreeMem(ProcListBuffer);

      Inc(BufSize, BUF_SIZE);

    end

    else if Status < 0 then

    begin

      // Another error occured

      FreeMem(ProcListBuffer);

      SetLastError(RtlNtStatusToDosError(Status));

      Exit;

    end;

  until Status >= 0;

  pBytesReturned := 0;

  // we got the entire process list now, extract all PIDs

  ProcOffset := 0;

  ProcessInfo := PSYSTEM_PROCESS_INFORMATION(ProcListBuffer);

  while cb >= SizeOf(DWORD) do

  begin

    ProcessInfo := PSYSTEM_PROCESS_INFORMATION(Cardinal(ProcessInfo) + ProcOffset);

    pProcessIds^ := DWORD(ProcessInfo^.UniqueProcessId);

    ProcOffset := ProcessInfo^.NextEntryOffset;

    Inc(pProcessIds);

    Dec(cb, SizeOf(DWORD));

    Inc(pBytesReturned, SizeOf(WORD));

    if ProcOffset = 0 then

    begin

      Result := true;

      Break;

    end;

  end;

  FreeMem(ProcListBuffer);

end;

wie man erkennen kann, enthaelt die SYSTEM_PROCESS_INFORMATION structure ein Feld namens ImageName, welches ein unicode string ist, den den Prozessnamen (also den Dateinamen des Images des Prozesses) enthaelt. Das Feld Buffer in diesem Unicode string zeigt einfach auf das Ende der structure die gerade enumeriert wurde, deshalb gibt es auch ein Feld NextEntryOffset um den Beginn der naechsten structure finden zu koennen.

Der Task Manager, die PSAPI implementierung von EnumProcesses() und auch die Toolhelp32 API (welche ich fast komplett fuer ReactOS

geklont habe und auch unter WinNT funktioniert) verwenden alle diese sehr nuetzliche Funktion ;)

Hoffe das bringt etwas mehr Licht in die duesteren APIs von Windows ;)