确定进程是否处于活动状态

Question

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Tlhelp32, StdCtrls;

  function processExists(exeFileName: string): Boolean; 
var
  ContinueLoop: BOOL; 
  FSnapshotHandle: THandle; 
  FProcessEntry32: TProcessEntry32;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32); 
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); 
  Result := False;
  while Integer(ContinueLoop) <> 0 do 
  begin 
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = 
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = 
      UpperCase(ExeFileName))) then
    begin 
      Result := True; 
    end; 
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); 
  end;
  CloseHandle(FSnapshotHandle); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if processExists('notepad.exe') then 
    ShowMessage('process is running')
  else 
    ShowMessage('process not running');
end;

enprocedure TForm1.Button1Click(Sender: TObject);
begin

end;

这是我遇到错误的确切代码，它是 delphi 技巧的示例。现在我只是想填满我的编辑，以便stackoverflow让我发布我的编辑，我显然有大部分代码，所以我需要礼貌地添加更多细节

Answer 1

您问题中的代码失败了，因为您已设法将函数 processExists 的内容复制到 FormCreate 方法中，而不是复制到实际函数本身中。

从FormCreate中删除代码并在实现部分实现函数processExists：

function processExists(exeFileName : string) : Boolean;
begin
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  Result := False;
  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
    begin
      Result := True;
    end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);  
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if processExists('notepad.exe') then
    ShowMessage('process is running')
  else
    ShowMessage('process not running');
end;

Answer 2

代码似乎放错了地方。我们看不到您对ProcessExists 的实现，但那是代码应该存在的地方。

但我想专注于包含多个错误的问题中的代码。下面是我的写法：

function ProcessExists(const ExeFileName: string): Boolean;
var
  SnapshotHandle: THandle;
  ProcessEntry32: TProcessEntry32;
  Continue: BOOL;
begin
  Result := False;
  SnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  Win32Check(SnapshotHandle<>INVALID_HANDLE_VALUE);
  try
    ProcessEntry32.dwSize := SizeOf(ProcessEntry32);
    Continue := Process32First(SnapshotHandle, ProcessEntry32);
    while Continue do
    begin
      if SameText(ProcessEntry32.szExeFile, ExeFileName) then
      begin
        Result := True;
        exit;
      end;
      Continue := Process32Next(SnapshotHandle, ProcessEntry32);
    end;
  finally
    CloseHandle(SnapshotHandle);
  end;
end;

我已经解决的问题：

1. 这里不要使用全局变量。这里的变量都可以并且应该是局部变量。将局部变量优先于所有其他变量，并尽可能使用它们。
2. 不要将BOOL 转换为整数并与0 进行比较。BOOL 是逻辑的，因此可以直接在逻辑上下文中使用。
3. 使用SameText 而不是UpperCase 混乱。
4. 不要两次执行相同的文本比较。一次就够了。
5. 找到匹配项时跳出循环。
6. 使用 try/finally 来防御导致资源泄漏的异常。

Answer 3

链接页面中显示的代码使用的是 Windows 中的ToolHelp API。您应该查看链接页面。

当您使用该 API 时，您会创建操作系统当前进程列表的快照，并使用 Process32First 和 Process32Next 遍历该列表以检测该进程。

建议：MadCollection 的 MadKernel 部分（MadExcept 和 MadCodeHook 是付费部分）围绕这些功能做了一个非常好的和有用的包装器。这些调用使我的 50 行函数将消息发送到父应用程序到 10 行。

PS：除了使用他们的库之外，我与 madshi.net 没有任何关系；-)