如何检测特定的Delphi IDE是否正在运行?

5

我正在开发一个组件安装程序(仅适用于Delphi XE2),我希望能够检测到Delphi XE2 IDE是否正在运行。如何检测?

附注:我知道TAppBuilder窗口类名,但我还需要检测IDE版本。


7
如果你可以找到主窗口的句柄,就可以使用GetWindowThreadProcessId函数获取进程ID。然后调用OpenProcess函数获取进程句柄。接着使用GetModuleFileNameEx函数获取可执行文件名。再使用GetFileVersionInfo等函数读取exe文件的版本资源。哇! - David Heffernan
@DavidHeffernan: :-) 深呼吸,再来一次,再来一次。这样应该会感觉更好。 - Marjan Venema
我认为上述方法可以完成工作,但如果有人能找到更简单的方法,我一点也不会感到惊讶。 - David Heffernan
2个回答

8
这些是确定Delphi XE2是否正在运行的步骤:
1)首先从HKEY_CURRENT_USER或HKEY_LOCAL_MACHINE根键中的\Software\Embarcadero\BDS\9.0注册表项的App条目中读取文件的位置。
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.

额外资源。 检测已安装的Delphi版本

在Win 10 x64中,我认为更安全的方法是检查以下注册表路径:"\HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Embarcadero\BDS\xx.xx",其中xx.xx是Delphi版本号,例如:"\HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Embarcadero\BDS\20.0",对应Rio版本。 - Linces Marques

1

检查DebugHook <> 0。 不足之处是,如果您的应用程序使用包构建,则DebugHook将返回0。 但通常这将是一个非常优雅和简单的测试。在D2009中运行良好,我刚刚注意到它在XE2中存在包依赖性错误(http://qc.embarcadero.com/wc/qcmain.aspx?d=105365)。


请注意,QualityCentral现已关闭,因此您无法再访问qc.embarcadero.com链接。如果您需要访问旧的QC数据,请查看QCScraper - Remy Lebeau

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接