Einzelnen Beitrag anzeigen

Unplugged

Registriert seit: 14. Apr 2004
Ort: Leipzig
125 Beiträge
 
Delphi 6 Enterprise
 
#22
  Alt 14. Apr 2004, 16:15
Zitat von Luckie:
Delphi-Quellcode:
uses
  PSAPI;

function GetProcessName(PID: DWORD): String;
var
  hProcess: cardinal;
  buffer : array [0..MAX_PATH-1] of Char;
begin
  result := '';
  Zeromemory(@buffer, sizeof(buffer));
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE,
    PID);
  if hProcess <> 0 then
  begin
    GetModulebaseName(hProcess, 0, buffer, sizeof(buffer));
    result := String(buffer);
    CloseHandle(hProcess);
  end
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  pdwResult : PDWORD; // für den Buffer
  pdwWork : PDWORD; // um dem Buffer verarbeiten zu können
  dwCountIn : DWORD; // Grösse des Buffers in Byte
  dwCountOut : DWORD; // Zurückgelieferte Anzahl Byte
  i : integer;
begin
  dwCountOut := 0; // Sicherheitshalber initialisieren, muss nicht sein
  dwCountIn := 1024; // Willkürlich gewählt, genügt für 256 Prozesse
  pdwResult := AllocMem(dwCountIn);
  try
    if not EnumProcesses(pdwResult,dwCountIn,dwCountOut) then begin
      ShowMessage(SysErrorMessage(GetLastError));
    end else begin
      pdwWork := pdwResult; // zur Verarbeitung übergeben, damit FreeMem funktioniert
      for i := 1 to (dwCountOut shr 2) do begin // shr 2 = / 4, da 4 Byte je DWORD
        // Prozess Id ausgeben
        //ShowMessage('ProzessId# '+IntToStr(i)+': '+IntToStr(pdwWork^));
        ShowMessage(GetProcessName(pdwWork^));
        // auf nächste addressieren (inc erhöht automatisch um 4, da es ein typisierter Pointer ist
        inc(pdwWork);
      end;
    end;
  finally
    FreeMem(pdwResult,dwCountIn);
  end;
end;
Hallo!

Grundsätzlich funktioniert diese Prozedur fehlerfrei, jedoch kann es sein, dass es Probleme unter Windows 98 gibt? Einige Nutzer eines meiner Programme meldeten mir einen recht merkwürdigen Fehler und meine Recherche führte zu diesem Teil des Quellcodes.

Thx & Greetz
  Mit Zitat antworten Zitat