来自: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;
如果您正在编写一些自动更新代码,您还可以考虑与您的应用程序建立某种连接并告诉它自行关闭。
这可以例如涉及向应用程序的主窗口发布一条消息,告诉它自行关闭。或者打开IPC管道等。
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;
如果您可以控制应用程序(正如您的问题所暗示的那样),一个很好的方法是在进程开始的早期创建一个命名文件映射对象。这类似于从 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;
查看有关 CreateFileMapping 的 MSDN 文档以了解更多详细信息。
另请参阅此问题的已接受答案,其中涵盖了卢克的答案并提供了其他解决方案。
我正在输入这些代码,主要单元的初始化部分。
initialization
mHandle := CreateMutex(nil, True, 'myApp.ts');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
MessageDlg('Program already running!', mtError, [mbOK], 0);
Halt;
end;
这是我的 LightSaber 库中的 ProcessRunning:https://github.com/GabrielOnDelphi/Delphi-LightSaber
{ Returns True if the specified process if found running
Drawnbacks: The process name does not contain the full path! }
function ProcessRunning(ExeFileName: string): Boolean;
var
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
ExeFileName:= LowerCase(ExeFileName);
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
TRY
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
Result := Process32First(FSnapshotHandle, FProcessEntry32);
if Result then
REPEAT
VAR LowProcName:= LowerCase(FProcessEntry32.szExeFile);
if (LowProcName = ExeFileName)
OR (LowProcName = ExtractFileName(ExeFileName))
then EXIT(True);
UNTIL NOT Process32Next(FSnapshotHandle, FProcessEntry32);
FINALLY
CloseHandle(FSnapshotHandle);
END;
end;