¿Cómo verificar si un proceso se está ejecutando con Delphi?

Question

similares a esta pregunta, pero en Delphi:

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

Tengo un programa de actualización, lo quiero para comprobar el programa de su punto de actualizar actualmente no se está ejecutando, preferiblemente hará la verificación de todos los usuarios, no solo usuario actual.

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 va a escribir un poco de código de actualización automática, también se puede considerar la posibilidad de una conexión de algún tipo para su aplicación y diciéndole que cerrarse a sí mismo.

Esto podría, p. Ej. implican publicar un mensaje en la ventana principal de su aplicación diciéndole que se apague solo. O abriendo una tubería IPC, etc.

Answer 3

Estoy escribiendo estos códigos de la parte de inicialización de la unidad principal.

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 usted tiene control sobre la aplicación (como se infiere de la pregunta), una buena manera de hacer esto es crear un objeto de asignación de archivo llamado temprano en el proceso comienza. Esto es similar a la sugerencia de crear un mutex 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; 

Consulte la MSDN documentation on CreateFileMapping para obtener más información.

Consulte también la respuesta aceptada al this question que cubre la respuesta de Luke y proporciona soluciones adicionales.