[英]How do I detect if the specific Delphi IDE is running?
我正在研究組件安裝程序(僅適用於Delphi XE2),我想檢測Delphi XE2 IDE是否正在運行。 你怎么會發現它?
PS我知道TAppBuilder
窗口類名,但我還需要檢測IDE版本。
這些是確定Delphi XE2是否正在運行的步驟
1)首先從\\Software\\Embarcadero\\BDS\\9.0
注冊表項中的App
條目讀取bds.exe文件的位置,該注冊表項可以位於HKEY_CURRENT_USER或HKEY_LOCAL_MACHINE Root鍵中。
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.
檢查DebugHook <> 0.缺點是,如果您的應用程序是使用包構建的,DebugHook將返回0.但通常這將是一個非常優雅和簡單的測試。 在D2009中工作得很好,我只是注意到它在XE2中有包依賴性錯誤(http://qc.embarcadero.com/wc/qcmain.aspx?d=105365)。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.