I'm working on a component installer (only for Delphi XE2) and I would like to detect if the Delphi XE2 IDE is running. How would you detect it?
P.S. I know about the TAppBuilder
window class name, but I need to detect also the IDE version.
I'm working on a component installer (only for Delphi XE2) and I would like to detect if the Delphi XE2 IDE is running. How would you detect it?
P.S. I know about the TAppBuilder
window class name, but I need to detect also the IDE version.
These are the steps to determine if the Delphi XE2 is running
1) First Read the location of the the bds.exe file from the App
entry in the \Software\Embarcadero\BDS\9.0
registry key which can be located in the HKEY_CURRENT_USER or HKEY_LOCAL_MACHINE Root key.
2) Then using the CreateToolhelp32Snapshot function you can check if exist a exe with the same name running.
3) Finally using the PID of the last processed entry you can resolve the full file path of the Exe (using the GetModuleFileNameEx
function) and then compare the names again.
Check this sample code
{$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 resources.
Detecting installed delphi versions
Check DebugHook <> 0. The down side is that currently if your app is built with packages, DebugHook will return 0. But normally this is would be a very elegant and simple test. Works great in D2009, I just noticed that it has the package dependency bug in XE2 (http://qc.embarcadero.com/wc/qcmain.aspx?d=105365).
qc.embarcadero.com
links anymore. If you need access to old QC data, look at QCScraper. –
Fabron © 2022 - 2024 — McMap. All rights reserved.