【问题标题】:How to check if a process is running using Delphi?如何使用Delphi检查进程是否正在运行?
【发布时间】:2009-05-18 04:12:03
【问题描述】:

与这个问题类似,但在 Delphi 中:

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

我有一个更新程序,我希望它检查即将更新的程序当前没有运行,最好它会检查所有用户,而不仅仅是当前用户。

【问题讨论】:

    标签: delphi process


    【解决方案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;
    

    【讨论】:

      【解决方案2】:

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

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

      【讨论】:

        【解决方案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;
        

        【讨论】:

          【解决方案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;
          

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

          另请参阅this question 的已接受答案,其中涵盖了 Luke 的答案并提供了其他解决方案。

          【讨论】:

            【解决方案5】:

            我正在键入这些代码初始化部分的主机。

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

            【讨论】:

              猜你喜欢
              • 1970-01-01
              • 1970-01-01
              • 2014-03-06
              • 1970-01-01
              • 1970-01-01
              • 2015-05-28
              • 1970-01-01
              • 1970-01-01
              • 2011-06-30
              相关资源
              最近更新 更多