Prüfen mittels PID ob Prozess läuft

[stahli]

Hier die Unit.
Ich habe vorher mal schnell mit dem Windows Editor etwas aufgeräumt - und hoffentlich nicht zu viel entfernt.

Delphi-Quellcode:

unit uoRegistry;

interface

uses
  { uoInstaller, meine Datenunit }
  System.Classes;

function FoundIDE(var uoItem: TuoItem {meine Datenklasse}): Boolean;
function RunningIDE(const aFileName: String): Boolean;

implementation

uses
  Winapi.Windows, System.Win.Registry, System.SysUtils,
  ShellAPI, TlHelp32, PsAPI;

const
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;

function PidToFilename(const TargetPID: THandle): WideString;
type
  TQueryFullProcessImageNameW = function(hProcess: THandle; dwFlags: DWORD; lpExeName: PWideChar; nSize: PDWORD)
    : BOOL; stdcall;
var
  hProcess: THandle;
  TargetName: WideString;
  QueryFullProcessImageNameW: TQueryFullProcessImageNameW;
  nSize: cardinal;
begin
  Result := '';
  nSize := MAX_PATH;
  SetLength(TargetName, nSize);
  if Win32MajorVersion >= 6 then
  begin
    hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, false, TargetPID);
    if hProcess <> 0 then
    begin
      try
        @QueryFullProcessImageNameW := GetProcAddress(GetModuleHandle('kernel32'), 'QueryFullProcessImageNameW');
        if Assigned(QueryFullProcessImageNameW) then
          if QueryFullProcessImageNameW(hProcess, 0, PWideChar(TargetName), @nSize) then
            Result := PWideChar(TargetName);
      finally
        CloseHandle(hProcess);
      end;
    end;
  end
  else
  begin
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, TargetPID);
    if hProcess <> 0 then
      try
        if GetModuleFileNameExW(hProcess, 0, PWideChar(TargetName), nSize) <> 0 then
          Result := PWideChar(TargetName);
      finally
        CloseHandle(hProcess);
      end;
  end;
end;

function ProcessIsRunning(const aFileName: WideString): Boolean;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
  fullPath: WideString;
  myPID: DWORD;
  OwnPID: cardinal;
begin
  OwnPID := GetCurrentProcessId;
  FSnapshotHandle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  Result := false;
  while Integer(ContinueLoop) <> 0 do
  begin
    try
      if UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExtractFileName(aFileName)) then
      begin
        myPID := FProcessEntry32.th32ProcessID;
        fullPath := PidToFilename(myPID);
        if SameText(fullPath, aFileName) then
        begin
          Result := True;
          Break;
        end;
      end;
      ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
    except
      ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
    end;
  end;
  CloseHandle(FSnapshotHandle);
end;

function RunningIDE(const aFileName: String): Boolean;
begin
  Result := ProcessIsRunning(aFileName);
end;

function RegKeyExists(const RegPath: string; const RootKey: HKEY): Boolean;
var
  Reg: TRegistry;
begin
  try
    Reg := TRegistry.Create;
    try
      Reg.RootKey := RootKey;
      Result := Reg.KeyExists(RegPath);
    finally
      Reg.Free;
    end;
  except
    Result := false;
  end;
end;

function RegReadStr(const RegPath, RegValue: string; var Str: string; const RootKey: HKEY): Boolean;
var
  Reg: TRegistry;
begin
  try
    Reg := TRegistry.Create;
    try
      Reg.RootKey := RootKey;
      Result := Reg.OpenKey(RegPath, true);
      if Result then
        Str := Reg.ReadString(RegValue);
    finally
      Reg.Free;
    end;
  except
    Result := false;
  end;
end;

function FoundIDE(var uoItem: TuoItem): Boolean;
var
  FileName: string;
  Found: Boolean;
begin
  Result := false;

  uoItem.IdeFileName := '';
  Found := RegKeyExists(uoItem.IdeRegPath, HKEY_CURRENT_USER);
  if (Found) then
  begin
    if (RegReadStr(uoItem.IdeRegPath, 'App', FileName, HKEY_CURRENT_USER) and (FileExists(FileName))) then
    begin
      uoItem.IdeFileName := FileName;
      Exit(true);
    end;
  end;

  Found := RegKeyExists(uoItem.IdeRegPath, HKEY_LOCAL_MACHINE);
  if (Found) then
  begin
    if (RegReadStr(uoItem.IdeRegPath, 'App', FileName, HKEY_LOCAL_MACHINE) and (FileExists(FileName))) then
    begin
      uoItem.IdeFileName := FileName;
      Exit(true);
    end;
  end;

end;

end.

[HeZa]

Zitat von stahli:

Hier die Unit.
Ich habe vorher mal schnell mit dem Windows Editor etwas aufgeräumt - und hoffentlich nicht zu viel entfernt.

Danke