Tech-Ecke / Delphi Inhalt / Datei zu einem Prozess finden

 

     Dateipfad zu einem laufenden Prozess finden

 

   GetProcessPath – benötigt tlhelp32 in uses! (nur für 32Bit-Prozesse)

  function GetProcessPath(Exename: string): String;
var
   hProcSnap, hModSnap: THandle;
   PE32: TProcessEntry32;
   ME32: TModuleEntry32;
begin
   Result := '';
   hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
   if hProcSnap <> INVALID_HANDLE_VALUE then
      begin
         PE32.dwSize := SizeOf(ProcessEntry32);
         if Process32First(hProcSnap, PE32) = True then
            begin
               while Process32Next(hProcSnap, PE32) = True do
                  begin
                     if Pos(Exename, PE32.szExeFile) <> 0 then
                        begin
                           hModSnap := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, PE32.th32ProcessID);
                           if hModSnap <> INVALID_HANDLE_VALUE then
                              begin
                                 ME32.dwSize := SizeOf(TModuleEntry32);
                                 if Module32First(hModSnap, ME32) = True then
                                    Result := ME32.szExePath;
                              end;
                          CloseHandle(hModSnap);
                        end;
                  end;
             end;
             CloseHandle(hProcSnap);
      end;
end;
 

Aufruf:

  Edit1.Text := GetProcessPath('explorer.exe');
 

 

   GetProcessPathEx – benötigt StrUtils und tlhelp32 in uses! (auch für 64Bit-Prozesse)

Um den Dateipfad eines laufenden 64Bit-Prozesses zufinden, benötigt man GetProcessImageFileName, wobei das ganze Packet aus drei Functions besteht und diese in der vierten Function GetProcessPathEx zusammengefasst werden.

  function GetProcessID(Exename: string): DWORD;
var
   hProcSnap: THandle;
   pe32: TProcessEntry32;
begin
   result :=
0;
   hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,
0);
  
if hProcSnap <> INVALID_HANDLE_VALUE then
     
begin
         pe32.dwSize := SizeOf(ProcessEntry32);
        
if Process32First(hProcSnap, pe32) = true then
            begin
               while Process32Next(hProcSnap, pe32) = true do
                  begin
                    
if pos(Exename, pe32.szExeFile) <> 0 then
                        result := pe32.th32ProcessID;
                   end;
               end;
               CloseHandle(hProcSnap);
   end;
end;

function GetProcessImageFileName(hProcess: tHANDLE; lpImageFileName: LPTSTR;
nSize: DWORD): DWORD;
stdcall;
external 'psapi.dll' name 'GetProcessImageFileName' +{$IFDEF UNICODE}'W'{$ELSE}'A'{$ENDIF};


function GetProcessFilePath(pid:cardinal):string;
var
      hp: THandle;
      Buffer1: array[0..MAX_PATH]
of Char;
      Len: DWORD;
begin
   Result := '';
   if pid > 0 then
      begin
         hp := OpenProcess(PROCESS_QUERY_INFORMATION, False, pid);
         if hp > 0 then
         try
            Len := GetProcessImageFileName(hp, buffer1, Length(buffer1));
            if Len > 0 then
               Result := Copy(buffer1, 1, Len)
            else
            Result := SysErrorMessage(GetLastError);
         finally
            CloseHandle(hp);
         end;
   end;
end;


function DevicePathToWin32Path(path:String):String;
var
      c:char;
      s:
string;
      i:integer;
begin
   i:=posex('\', path, 2);
   i:=posex('\', path, i+1);
   result:=copy(path, i, length(path));
   delete(path, i, length(path));
   for c:='A' to 'Z' do
      begin
         setlength(s, 1000);
         if querydosdevice(pchar(string(c) +':'), pchar(s), 1000) <> 0 then
            begin
               s := pchar(s);
               if sametext(path, s) then
                 
begin
                     result:=c +':' +result;
                     exit;
                  end;
            end;
      end;
   result:='';
end;


function GetProcessPathEx(ProcessName: String): String;
begin
   result := DevicePathToWin32Path(GetProcessFilePath(GetProcessID(ProcessName)));
end;

 

Aufruf:

  Edit1.Text := GetProcessPathEx('notepad.exe');
 

Exe-Demo zum testen:

    GetProcessPathEx.zip

 

"Die Option Drucken funktioniert erst ab Netscape V4.0 bzw. I-Explorer 5.0 !"

[letzte Aktualisierung 30.05.2010]