如何檢測特定的Delphi IDE是否正在運行？

Question

我正在使用組件安裝程序（僅適用於Delphi XE2），並且我想檢測Delphi XE2 IDE是否正在運行。你會如何檢測它？

P.S.我知道TAppBuilder窗口類的名稱，但我還需要檢測IDE版本。

Answer 1

這些都是確定德爾福XE2運行

步驟

1）首先閱讀的bds.exe文件從可設在該\Software\Embarcadero\BDS\9.0註冊表項App條目中的位置HKEY_CURRENT_USER或HKEY_LOCAL_MACHINE根密鑰。

2）然後使用CreateToolhelp32Snapshot函數，您可以檢查是否存在一個運行相同名稱的exe。

3）最後使用最後處理條目的PID，可以解析Exe的完整文件路徑（使用GetModuleFileNameEx函數），然後再次比較名稱。

入住此示例代碼

{$APPTYPE CONSOLE} 

{$R *.res} 

uses 

    Registry, 
    PsAPI, 
    TlHelp32, 
    Windows, 
    SysUtils; 

function ProcessFileName(dwProcessId: DWORD): string; 
var 
    hModule: Cardinal; 
begin 
    Result := ''; 
    hModule := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, dwProcessId); 
    if hModule <> 0 then 
    try 
     SetLength(Result, MAX_PATH); 
     if GetModuleFileNameEx(hModule, 0, PChar(Result), MAX_PATH) > 0 then 
     SetLength(Result, StrLen(PChar(Result))) 
     else 
     Result := ''; 
    finally 
     CloseHandle(hModule); 
    end; 
end; 

function IsAppRunning(const FileName: string): boolean; 
var 
    hSnapshot  : Cardinal; 
    EntryParentProc: TProcessEntry32; 
begin 
    Result := False; 
    hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); 
    if hSnapshot = INVALID_HANDLE_VALUE then 
    exit; 
    try 
    EntryParentProc.dwSize := SizeOf(EntryParentProc); 
    if Process32First(hSnapshot, EntryParentProc) then 
     repeat 
     if CompareText(ExtractFileName(FileName), EntryParentProc.szExeFile) = 0 then 
      if CompareText(ProcessFileName(EntryParentProc.th32ProcessID), FileName) = 0 then 
      begin 
      Result := True; 
      break; 
      end; 
     until not Process32Next(hSnapshot, EntryParentProc); 
    finally 
    CloseHandle(hSnapshot); 
    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 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 GetDelphiXE2LocationExeName: string; 
Const 
Key = '\Software\Embarcadero\BDS\9.0'; 
begin 
    Result:=''; 
    if RegKeyExists(Key, HKEY_CURRENT_USER) then 
    begin 
     RegReadStr(Key, 'App', Result, HKEY_CURRENT_USER); 
     exit; 
    end; 

    if RegKeyExists(Key, HKEY_LOCAL_MACHINE) then 
     RegReadStr(Key, 'App', Result, HKEY_LOCAL_MACHINE); 
end; 


Var 
Bds : String; 

begin 
    try 
    Bds:=GetDelphiXE2LocationExeName; 
    if Bds<>'' then 
    begin 
     if IsAppRunning(Bds) then 
     Writeln('The Delphi XE2 IDE Is running') 
     else 
     Writeln('The Delphi XE2 IDE Is not running') 
    end 
    else 
    Writeln('The Delphi XE2 IDE Is was not found'); 
    except 
    on E: Exception do 
     Writeln(E.ClassName, ': ', E.Message); 
    end; 
    Readln; 
end. 

Addtional資源。 Detecting installed delphi versions

Answer 2

檢查DebugHook <> 0 的一面是，目前，如果您的應用程序與包建，DebugHook將返回0 但通常這是將是一個非常優雅和簡單的測試。在D2009中工作得很好，我只注意到它在XE2中存在程序包依賴錯誤（http://qc.embarcadero.com/wc/qcmain.aspx?d=105365）。