Làm thế nào để kiểm tra xem một tiến trình đang chạy bằng Delphi?

Question

Tương tự như câu hỏi này, nhưng trong Delphi:

How do I find out if a process is already running using c#?

Tôi có một chương trình updater, tôi muốn nó để kiểm tra các chương trình về nó để cập nhật hiện không chạy, tốt nhất là nó sẽ rà soát tất cả người sử dụng, không chỉ người dùng hiện tại.

Answer 1

từ: 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

Nếu bạn đang viết một chút mã tự động cập nhật, bạn cũng có thể xem xét thực hiện kết nối của một số loại ứng dụng của bạn và nói cho nó để đóng chính nó xuống.

Điều này có thể, ví dụ: liên quan đến việc đăng một tin nhắn đến cửa sổ chính của ứng dụng của bạn để nó tự tắt. Hoặc mở ống IPC, v.v.

Answer 3

Tôi đang nhập một phần khởi tạo mã của đơn vị chính.

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

Nếu bạn có quyền kiểm soát các ứng dụng (như là ngụ ý từ câu hỏi của bạn), một cách tốt đẹp để làm điều này là để tạo ra một tập tin đối tượng lập bản đồ tên sớm trong tiến trình khởi động. Điều này tương tự như gợi ý tạo một mutex từ 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; 

Kiểm tra MSDN documentation on CreateFileMapping để biết thêm chi tiết.

Xem thêm câu trả lời được chấp nhận cho this question bao gồm câu trả lời của Luke và cung cấp các giải pháp bổ sung.