如何检测特定的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）。