如何使用Delphi检查进程是否正在运行？

Question

与这个问题类似，但在Delphi中：

如何查明进程是否已使用 c# 运行？

我有一个更新程序，我希望它检查要更新的程序当前未运行，最好它会检查所有用户，不仅仅是当前用户。

Answer 1

来自： http://www.delphitricks.com/source-code/windows/check_if_a_process_is_running .html

uses TlHelp32; 

    function processExists(exeFileName: string): Boolean; 
var 
  ContinueLoop: BOOL; 
  FSnapshotHandle: THandle; 
  FProcessEntry32: TProcessEntry32; 
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

如果您正在编写一些自动更新代码，您还可以考虑与您的应用程序建立某种连接并告诉它自行关闭。

例如，这可能涉及向应用程序的主窗口发布一条消息，告诉它自行关闭。 或者打开IPC管道等。

Answer 3

uses TlHelp32, PsAPI;

function ProcessExists(anExeFileName: string): Boolean;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
  fullPath: string;
  myHandle: THandle;
  myPID: DWORD;
begin
  // wsyma 2016-04-20 Erkennung, ob ein Prozess in einem bestimmten Pfad schon gestartet wurde.
  // Detection wether a process in a certain path is allready started.
  // http://stackoverflow.com/questions/876224/how-to-check-if-a-process-is-running-using-delphi
  // http://swissdelphicenter.ch/en/showcode.php?id=2010
  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(ExtractFileName(anExeFileName)) then
    begin
      myPID := FProcessEntry32.th32ProcessID;
      myHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, myPID);
      if myHandle <> 0 then
      try
        SetLength(fullPath, MAX_PATH);
        if GetModuleFileNameEx(myHandle, 0, PChar(fullPath), MAX_PATH) > 0 then
        begin
          SetLength(fullPath, StrLen(PChar(fullPath)));
          if UpperCase(fullPath) = UpperCase(anExeFileName) then
            Result := True;
        end else
          fullPath := '';
      finally
        CloseHandle(myHandle);
      end;
      if Result then
        Break;
    end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

Answer 4

如果您可以控制应用程序（正如您的问题所暗示的那样），那么一个很好的方法是在进程启动的早期创建一个命名文件映射对象。 这类似于 RedLEON 创建互斥体的建议。

// Add this into the application you wish to update
CreateFileMapping(HWND($FFFFFFFF), nil, PAGE_READONLY, 0, 32, 'MAIN-PROGRAM');
// Note: Mapping object is destroyed when your application exits

// Add this into your updater application       
var
    hMapping: HWND;
begin
    hMapping := CreateFileMapping(HWND($FFFFFFFF), nil, PAGE_READONLY, 0, 32, 'MAIN-PROGRAM');
    if (hMapping <> 0) then
        begin
        if (GetLastError() = ERROR_ALREADY_EXISTS) then
            ShowMessage('Application to update is already running!');
        end;

查看 有关 CreateFileMapping 的 MSDN 文档 了解更多详情。

另请参阅此问题的已接受答案，其中涵盖卢克的回答并提供了额外的解决方案。

Answer 5

我正在输入主单元初始化部分的这些代码。

initialization
mHandle := CreateMutex(nil, True, 'myApp.ts');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
  MessageDlg('Program already running!', mtError, [mbOK], 0);
  Halt;
end;

Answer 6

检查应用程序是否已在运行。 感谢这个 & @RedLEON 用户。

program Project1;

uses
  Vcl.Forms,
  Windows,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

var
  MutexHandle: THandle;
  hPrevInst: Boolean;

begin
  // -== Check to see if the named mutex object existed before this call ==-
  MutexHandle := CreateMutex(nil, True, 'MysampleAppMutex');
  if MutexHandle <> 0 then
  begin
    if GetLastError = ERROR_ALREADY_EXISTS then
    // -== set hPrevInst property and close the mutex handle ==-
    begin
      MessageBox(0, 'Instance of this application is already running.', 'Application already running', mb_IconHand);

      hPrevInst := True;
      CloseHandle(MutexHandle);
      // 'Halt' Is the actual one that prevents a second instance
      Halt;
      // of your app from running.
    end
    else
    begin
      // -== indicate no previous instance was found ==-
      hPrevInst := False;
    end;
  end
  else
  begin
    // -== indicate no previous instance was found ==-
    hPrevInst := False;
  end;
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;

end.