2012-02-04 11 views
5

私はコンポーネントインストーラ(Delphi XE2のみ)に取り組んでいます.Delphi XE2 IDEが動作しているかどうかを検出したいと思います。どのようにそれを検出しますか?特定のDelphi IDEが実行されているかどうかを検出するにはどうすればよいですか?

P.S.私はTAppBuilderウィンドウクラス名について知っていますが、IDEバージョンも検出する必要があります。

+7

メインウィンドウのウィンドウハンドルが見つかる場合は、GetWindowThreadProcessIdを使用してプロセスIDを取得できます。その後、OpenProcessを呼び出してプロセスハンドルを取得します。次に、GetModuleFileNameExを呼び出して、exeファイル名を取得します。次に、GetFileVersionInfoなどを使用して、exeファイルのバージョンリソースを読み取ります。ピー! –

+0

@DavidHeffernan::-)再び深呼吸してください。気分が良くなるはずです。 –

+0

私は上記が仕事をすることを期待していますが、誰かがもっと簡単な方法を見つけることができたら、私は少なくとも驚くことはありません。 –

答えて

7

デルファイXE2が

1を実行している場合、これらを判断するステップである)最初の読出しに配置することができる\Software\Embarcadero\BDS\9.0レジストリキーのAppエントリからbds.exeファイルの場所HKEY_CURRENT_USERまたはHKEY_LOCAL_MACHINEルートキー。

2)その後、CreateToolhelp32Snapshot関数を使用すると、同じ名前のexeファイルが存在するかどうかを確認できます。

3)最後に処理されたエントリのPIDを使用して、GetModuleFileNameEx関数を使用してExeの完全なファイルパスを解決し、再度名前を比較することができます。

チェックこのサンプルコードを

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

1

チェックはダウンサイドはアプリがパッケージで構築されている場合、現在、DebugHookは0 を返すということです。しかし、通常、これは非常にエレガントでシンプルなテストになりますです<> 0 をDebugHook。 D2009でうまくいきましたが、XE2(http://qc.embarcadero.com/wc/qcmain.aspx?d=105365)にパッケージの依存関係のバグがあることに気付きました。

+0

[QualityCentralは現在シャットダウンされました](https://community.embarcadero.com/blogs/entry/quality-keeps-moving-forward)、これ以上 'qc.embarcadero.com'リンクにアクセスすることはできません。古いQCデータにアクセスする必要がある場合は、[QCScraper](http://www.uweraabe.de/Blog/2017/06/09/how-to-save-qualitycentral/)を参照してください。 –

関連する問題