Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Laufende Prozesse komplett (!) auslesen (https://www.delphipraxis.net/16046-laufende-prozesse-komplett-auslesen.html)

fxbasic 9. Feb 2004 15:16


Laufende Prozesse komplett (!) auslesen
 
Servus,

hat irgendjemand einen Plan, wie man alle laufenden Prozesse mit vollem Pfad (C:\...\datei.exe) auslesen kann, das Beispiel aus dem EDH gibt nämlich nur den Namen der Exe an.

Dank im Voraus, fxbasic

sakura 9. Feb 2004 15:32

Re: Laufende Prozesse komplett (!) auslesen
 
Was meinst Du mit "komplett auslesen" :gruebel:

...:cat:...

toms 9. Feb 2004 15:33

Re: Laufende Prozesse komplett (!) auslesen
 
Hi,

Ich verwende folgende Funktion:

Delphi-Quellcode:
uses
  PsAPI, TlHelp32;

function RunningProcessesList(const List: TStrings; FullPath: Boolean): Boolean;
// Portions by jedi
const
  RsSystemIdleProcess = 'System Idle Process';
  RsSystemProcess = 'System Process';

  function IsWinXP_or_Above: Boolean;
  begin
    Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and
      (Win32MajorVersion >= 5) and (Win32MinorVersion >= 1);
  end;

  function IsWin2k: Boolean;
  begin
    Result := (Win32MajorVersion >= 5) and
      (Win32Platform = VER_PLATFORM_WIN32_NT);
  end;

  function IsWinNT4: Boolean;
  begin
    Result := Win32Platform = VER_PLATFORM_WIN32_NT;
    Result := Result and (Win32MajorVersion = 4);
  end;

  function IsWin3X: Boolean;
  begin
    Result := Win32Platform = VER_PLATFORM_WIN32_NT;
    Result := Result and (Win32MajorVersion = 3) and
      ((Win32MinorVersion = 1) or (Win32MinorVersion = 5) or (Win32MinorVersion = 51));
  end;

  function ProcessFileName(PID: DWORD): string;
  var
    Handle: THandle;
  begin
    Result := '';
    Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, Bool(False), PID);
    if Handle <> 0 then
    try
      SetLength(Result, MAX_PATH);
      if FullPath then
      begin
        if GetModuleFileNameEx(Handle, 0, PChar(Result), MAX_PATH) > 0 then
          SetLength(Result, StrLen(PChar(Result)))
        else
          Result := '';
      end
      else
      begin
        if GetModuleBaseNameA(Handle, 0, PChar(Result), MAX_PATH) > 0 then
          SetLength(Result, StrLen(PChar(Result)))
        else
          Result := '';
      end;
    finally
      CloseHandle(Handle);
    end;
  end;

  function BuildListTH: Boolean;
  var
    SnapProcHandle: THandle;
    ProcEntry: TProcessEntry32;
    NextProc: Boolean;
    FileName: string;
  begin
    SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    Result := (SnapProcHandle <> INVALID_HANDLE_VALUE);
    if Result then
    try
      ProcEntry.dwSize := SizeOf(ProcEntry);
      NextProc := Process32First(SnapProcHandle, ProcEntry);
      while NextProc do
      begin
        if ProcEntry.th32ProcessID = 0 then
        begin
          // PID 0 is always the "System Idle Process" but this name cannot be
          // retrieved from the system and has to be fabricated.
          FileName := RsSystemIdleProcess;
        end
        else
        begin
          if IsWin2k or IsWinXP_or_Above then
          begin
            FileName := ProcessFileName(ProcEntry.th32ProcessID);
            if FileName = '' then
              FileName := ProcEntry.szExeFile;
          end
          else
          begin
            FileName := ProcEntry.szExeFile;
            if not FullPath then
              FileName := ExtractFileName(FileName);
          end;
        end;
        List.AddObject(FileName, Pointer(ProcEntry.th32ProcessID));
        NextProc := Process32Next(SnapProcHandle, ProcEntry);
      end;
    finally
      CloseHandle(SnapProcHandle);
    end;
  end;

  function BuildListPS: Boolean;
  var
    PIDs: array[0..1024] of DWORD;
    Needed: DWORD;
    I: Integer;
    FileName: string;
  begin
    Result := EnumProcesses(@PIDs, SizeOf(PIDs), Needed);
    if Result then
    begin
      for I := 0 to (Needed div SizeOf(DWORD)) - 1 do
      begin
        case PIDs[I] of
          0:
            // PID 0 is always the "System Idle Process" but this name cannot be
            // retrieved from the system and has to be fabricated.
            FileName := RsSystemIdleProcess;
          2:
            // On NT 4 PID 2 is the "System Process" but this name cannot be
            // retrieved from the system and has to be fabricated.
            if IsWinNT4 then
              FileName := RsSystemProcess
            else
              FileName := ProcessFileName(PIDs[I]);
          8:
            // On Win2K PID 8 is the "System Process" but this name cannot be
            // retrieved from the system and has to be fabricated.
            if IsWin2k or IsWinXP_or_Above then
              FileName := RsSystemProcess
            else
              FileName := ProcessFileName(PIDs[I]);
        else
          FileName := ProcessFileName(PIDs[I]);
        end;
        if FileName <> '' then
          List.AddObject(FileName, Pointer(PIDs[I]));
      end;
    end;
  end;

begin
  if IsWin3X or IsWinNT4 then
    Result := BuildListPS
  else
    Result := BuildListTH;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 List: TStrings;
begin
   List := TStringList.Create;
 try
    RunningProcessesList(List, True);
    ListBox1.Items.Assign(List);
 finally
   List. Free;
 end;
end;

fxbasic 9. Feb 2004 15:34

Re: Laufende Prozesse komplett (!) auslesen
 
Der Code aus dem EDH liefert:
notepad.exe

Ich möchte aber haben:
C:\windows\notepad.exe

Das mein ich mit "komplett".

Über ne FindFirst-Schleife die Datei zu suchen, stel,l ich mir nämlich als ein bisschen sehr zeitraubend vor...

Gruß, fxbasic

Chewie 9. Feb 2004 16:09

Re: Laufende Prozesse komplett (!) auslesen
 
Dazu brauchst du noch Module32First und Module32Next dort steht der ganze Pfad zu der EXE drin.

stoxx 9. Feb 2004 16:17

Re: Laufende Prozesse komplett (!) auslesen
 
Zitat:

Zitat von fxbasic
Der Code aus dem EDH liefert:
notepad.exe

Ich möchte aber haben:
C:\windows\notepad.exe

Das mein ich mit "komplett".

Über ne FindFirst-Schleife die Datei zu suchen, stel,l ich mir nämlich als ein bisschen sehr zeitraubend vor...

Gruß, fxbasic


meinst Du sowas hier ???

Code:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, psapi;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
l = 512;
var
  PIDArray: array[0..1023] of DWORD;
  cb: DWORD;
  I: integer;
  ProcCount: integer;
  hMod: HMODULE;
  hProcess, h: THandle;
  ModuleName: array[0..300] of char;
  szName: array[0..l] of char;

begin

  EnumProcesses(@PIDArray, sizeof(PIDArray), cb);
  ProcCount := cb div sizeof(DWORD);
  for I := 0 to ProcCount - 1 do
  begin
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
      PROCESS_VM_READ,
      false,
      PIDArray[I]);
    if (hProcess <> 0) then
    begin
      EnumProcessModules(hProcess, @hMod, sizeof(hMod), cb);
      GetModuleFilenameEx(hProcess, hMod, ModuleName, sizeof(ModuleName));
       memo1.lines.Add(ModuleName);
      CloseHandle(hProcess);
    end;
  end;
end;

end.

crusty 12. Feb 2004 09:41

Re: Laufende Prozesse komplett (!) auslesen
 
Hi,

ich suche da auch schon ne weile rum,
ich hab das mit ToolSnapSHot32 gemacht,
DU holst dir mit
CreateToolHelpSnapShot32 das handle,
mit dem kannste du dann per Process32First und
Process32Next die liste der prozesse durchgehen
und bei jedem process mit Module32First
die passende struct fuellen (steht alles in der hilfe)
und die beeinhaltet sZExePath (vollerpfad) und
szModuleName (exe name)

es zeigt mir die vollen pfade an,
komischerweise aber nicht bei windowskomponenten
(rpcss.exe, smss.exe etc)
keine ahnugn woran das liegt aber fuer alles andere
funktioniert es


Alle Zeitangaben in WEZ +1. Es ist jetzt 04:01 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz