我的程序如何判断Delphi是否正在运行？

I've heard that some custom component authors use an RTL routine that checks to see if Delphi is running in order to set up shareware restrictions. Does anyone know what this routine is? Checking obvious names like "DelphiRunning" or "IsDelphiRunning" doesn't turn up anything useful.

我听说一些自定义组件作者使用RTL例程来检查Delphi是否正在运行以设置共享软件限制。有谁知道这个例程是什么?检查明显的名称,如“DelphiRunning”或“IsDelphiRunning”并没有发现任何有用的东西。

3 个解决方案

#1

There are 2 different ideas here:
- Delphi is up and running
- The application is running under the debugger

这里有两个不同的想法: - Delphi启动并运行 - 应用程序在调试器下运行

The common way to test if Delphi is running is to check the presence of known IDE Windows which have a specific classname like TAppBuilder or TPropertyInspector.
Those 2 works in all version of Delphi IIRC.

测试Delphi是否正在运行的常用方法是检查是否存在具有特定类名的已知IDE Windows,如TAppBuilder或TPropertyInspector。这两个版本适用于所有版本的Delphi IIRC。

If you want to know if your application is running under the debugger, i.e. launched normally from the IDE with "Run" (F9) or attached to the debugger while already running, you just have to test the DebugHook global variable.
Note that "Detach from program" does not remove the DebugHook value, but "Attach to process" sets it.

如果您想知道您的应用程序是否在调试器下运行,即通过IDE“运行”(F9)正常启动或在运行时连接到调试器,您只需要测试DebugHook全局变量。请注意,“从程序中分离”不会删除DebugHook值,但“附加到进程”会设置它。

function IsDelphiRunning: Boolean;
begin
  Result := (FindWindow('TAppBuilder', nil) > 0) and
    (FindWindow('TPropertyInspector', 'Object Inspector') > 0);
end;

function IsOrWasUnderDebugger: Boolean;
begin
  Result := DebugHook <> 0;
end;

If the goal is to restrict the use of a trial version of your component to when the application is being developped, both have flaws:
- Hidden windows with the proper Classname/Title can be included in the application
- DebugHook can be manually set in the code

如果目标是将组件的试用版本限制为在开发应用程序时使用,则两者都有缺陷: - 应用程序中可以包含具有正确类名/标题的隐藏窗口 - 可以手动设置DebugHook码

#2

You can use DebugHook <> 0 from your component code. DebugHook is a global variable (IIRC, it's in the Systems unit) that's set by the Delphi/RAD Studio IDE, and couldn't be set from anywhere else.

您可以使用组件代码中的DebugHook <> 0。 DebugHook是一个全局变量(IIRC,它在系统单元中),由Delphi / RAD Studio IDE设置,无法从其他任何地方设置。

There are other techniques (FindWindow() for TAppBuilder, for instance), but DebugHook takes all of the work out of it.

还有其他技术(例如,TAppBuilder的FindWindow()),但是DebugHook将完成所有工作。

#3

This is a code snippet from www.delphitricks.com/source-code/misc/check_if_delphi_is_running.html.

这是来自www.delphitricks.com/source-code/misc/check_if_delphi_is_running.html的代码片段。

function WindowExists(AppWindowName, AppClassName: string): Boolean; 
var 
  hwd: LongWord; 
begin 
  hwd    := 0; 
  hwd    := FindWindow(PChar(AppWindowName), PChar(AppClassName)); 
  Result := False; 
  if not (Hwd = 0) then {window was found if not nil} 
    Result := True; 
end; 

function DelphiLoaded: Boolean; 
begin 
  DelphiLoaded := False; 
  if WindowExists('TPropertyInspector', 'Object Inspector') then 
    if WindowExists('TMenuBuilder', 'Menu Designer') then 
      if WindowExists('TAppBuilder', '(AnyName)') then 
        if WindowExists('TApplication', 'Delphi') then 
          if WindowExists('TAlignPalette', 'Align') then 
            DelphiLoaded := True; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if DelphiLoaded then 
  begin 
    ShowMessage('Delphi is running'); 
  end; 
end; 


function DelphiIsRunning: Boolean; 
begin 
  Result := DebugHook <> 0; 
end;

#1