Registriert seit: 14. Apr 2004
Ort: Leipzig
125 Beiträge
Delphi 6 Enterprise
|
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
|
|
Zitat
|