Comment vérifier si un processus est en cours d'exécution en utilisant Delphi?

Question

similaires à cette question, mais à Delphes:

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

J'ai un programme d'updater, je veux vérifier le programme de son sur le point de mettre à jour ne sont pas en cours d'exécution, de préférence il vérifiait tous les utilisateurs, et non juste l'utilisateur actuel.

Answer 1

de: 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

Si vous écrivez un peu de code mise à jour automatique, vous pouvez aussi envisager de faire une connexion de quelque sorte à votre application et lui disant de se fermer.

Ceci pourrait être par ex. impliquez poster un message à la fenêtre principale de votre application en lui disant de se fermer. Ou ouverture d'un tuyau IPC, etc.

Answer 3

Je suis en train de taper ces codes d'initialisation de l'unité principale.

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

Si vous avez le contrôle sur l'application (comme le laisse entendre de votre question), une belle façon de le faire est de créer un objet de mappage de fichier nommé au début du processus commence. Ceci est similaire à la suggestion de créer un mutex à partir de 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; 

Consultez le MSDN documentation on CreateFileMapping pour plus de détails.

Voir également la réponse acceptée à this question qui couvre la réponse de Luke et fournit des solutions supplémentaires.