Come posso rilevare se l'IDE Delphi specifico è in esecuzione?

Question

Sto lavorando su un componente di installazione (solo per Delphi XE2) e vorrei rilevare se l'IDE Delphi XE2 è in esecuzione. Come lo individueresti?

P.S. Conosco il nome della classe della finestra TAppBuilder, ma ho bisogno di rilevare anche la versione IDE.

Answer 1

Questi sono i passi per determinare se la Delphi XE2 è in esecuzione

1) In primo luogo Leggi la posizione del file del bds.exe dal App voce nella chiave di registro \Software\Embarcadero\BDS\9.0 che può essere situato nella HKEY_CURRENT_USER o HKEY_LOCAL_MACHINE Root key.

2) Quindi utilizzando la funzione CreateToolhelp32Snapshot è possibile verificare se esiste un exe con lo stesso nome in esecuzione.

3) Infine utilizzando il PID dell'ultima voce elaborata è possibile risolvere il percorso completo del file dell'Exe (utilizzando la funzione GetModuleFileNameEx) e confrontare nuovamente i nomi.

controllare questo codice di esempio

{$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. 

risorse Addtional. Detecting installed delphi versions

Answer 2

check DebugHook <> 0. Il lato negativo è che attualmente se la vostra applicazione è costruita con i pacchetti, DebugHook restituirà 0. Ma normalmente questo è sarebbe un test molto elegante e semplice. Funziona alla grande in D2009, ho appena notato che ha il bug di dipendenza del pacchetto in XE2 (http://qc.embarcadero.com/wc/qcmain.aspx?d=105365).