Làm cách nào để phát hiện xem IDE Delphi cụ thể có đang chạy không?

Question

Tôi đang làm việc trên trình cài đặt thành phần (chỉ dành cho Delphi XE2) và tôi muốn phát hiện xem IDE IDE2 Delphi có đang chạy hay không. Làm thế nào bạn sẽ phát hiện ra nó?

P.S. Tôi biết về tên lớp cửa sổ TAppBuilder, nhưng tôi cũng cần phát hiện phiên bản IDE.

Answer 1

Đây là những bước để xác định xem Delphi XE2 đang chạy

1) Trước tiên đọc vị trí của các tập tin bds.exe từ App entry trong khóa \Software\Embarcadero\BDS\9.0 registry có thể được đặt tại Phím HKEY_CURRENT_USER hoặc HKEY_LOCAL_MACHINE gốc.

2) Sau đó, sử dụng chức năng CreateToolhelp32Snapshot bạn có thể kiểm tra xem có tồn tại một exe có cùng tên đang chạy hay không.

3) Cuối cùng sử dụng PID của mục nhập được xử lý cuối cùng, bạn có thể giải quyết đường dẫn tệp đầy đủ của Exe (sử dụng hàm GetModuleFileNameEx) và sau đó so sánh lại tên.

Kiểm tra này mẫu mã

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

nguồn addtional. Detecting installed delphi versions

Answer 2

Kiểm tra DebugHook <> 0. Phía xuống là hiện nếu ứng dụng của bạn được xây dựng với các gói, DebugHook sẽ trở lại 0. Nhưng thường đây là sẽ là một thử thách rất thanh lịch và đơn giản. Hoạt động tốt trong D2009, tôi chỉ nhận thấy rằng nó có lỗi phụ thuộc gói trong XE2 (http://qc.embarcadero.com/wc/qcmain.aspx?d=105365).