-3 
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让我发布我的编辑，我显然有大部分代码，所以我需要礼貌地添加更多细节

4

3 回答 3

5

您问题中的代码使您失败，因为您已设法将函数的内容复制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;
于 2013-06-01T18:57:16.100 回答
3

代码似乎在错误的位置。我们看不到您的 实现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. 不要将 aBOOL转换为整数并与 0 进行比较。ABOOL是逻辑的，因此可以直接在逻辑上下文中使用。
  3. 使用SameText而不是那种UpperCase混乱。
  4. 不要两次执行相同的文本比较。一次就够了。
  5. 找到匹配项时跳出循环。
  6. 使用 try/finally 来防御导致资源泄漏的异常。
于 2013-06-01T20:02:48.167 回答
1

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

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

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

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

于 2013-06-01T18:32:39.753 回答