如何检查一个进程是否使用Delphi运行？

Question

这个问题类似，但在德尔福：

How do I find out if a process is already running using 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

我打字这些代码初始化主要单元的一部分。

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

Answer 4

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 5

如果你有过应用控制（如从你的问题暗示），一个很好的办法做到这一点是尽早建立一个命名的文件映射对象的过程中开始。这与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; 

查看MSDN documentation on CreateFileMapping了解更多详情。

另请参阅接受的回答this question其中涵盖卢克的答案，并提供其他解决方案。