本文整理自网络，侵删。
delphi 监控其它进程
program Monitor;
// {$APPTYPE CONSOLE}
uses
Winapi.Windows,
System.SysUtils,
ProcLib in 'ProcLib.pas';
var
Mutex: HWND;
const
c_AppName = 'server.exe';
begin
Mutex := Winapi.Windows.CreateMutex(nil, False, 'Monitor');
if (GetLastError = ERROR_ALREADY_EXISTS) or (Mutex = 0) then
Exit;
G_ExeFile := ExtractFilePath(ParamStr(0)) + c_AppName;
while True do
begin
Sleep(2000);
if ProcessRunning(c_AppName) then
Continue;
if G_ExeFile = '' then
Continue;
Exec(G_ExeFile);
end;
end.
unit ProcLib;
interface
uses
Winapi.Windows, System.SysUtils, Winapi.PsAPI,
Winapi.TlHelp32, Winapi.ShellAPI;
function ProcessRunning(ExeName: string): Boolean;
procedure Exec(FileName: string);
var
G_ExeFile: string = '';
implementation
function ProcessFileName(PID: DWORD): string;
var
Handle: THandle;
begin
Result := '';
Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
False, PID);
if Handle <> 0 then
try
SetLength(Result, MAX_PATH);
if GetModuleFileNameEx(Handle, 0, PChar(Result), MAX_PATH) > 0 then
SetLength(Result, StrLen(PChar(Result)))
else
Result := '';
finally
CloseHandle(Handle);
end;
end;
function ProcessRunning(ExeName: string): Boolean;
var
SnapProcHandle: THandle;
NextProc: Boolean;
ProcEntry: TProcessEntry32;
ProcFileName: string;
begin
Result := False;
SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if SnapProcHandle = INVALID_HANDLE_VALUE then
Exit;
try
ProcEntry.dwSize := SizeOf(ProcEntry);
NextProc := Process32First(SnapProcHandle, ProcEntry);
while NextProc do
begin
if ProcEntry.th32ProcessID <> 0 then
begin
ProcFileName := ProcessFileName(ProcEntry.th32ProcessID);
if ProcFileName = '' then
ProcFileName := ProcEntry.szExeFile;
if SameText(ExtractFileName(ProcFileName), ExeName) then
begin
Result := True;
Break;
end;
end;
NextProc := Process32Next(SnapProcHandle, ProcEntry);
end;
finally
CloseHandle(SnapProcHandle);
end;
end;
procedure Exec(FileName: string);
var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
begin
FillChar(StartupInfo, SizeOf(StartupInfo), #0);
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_SHOWDEFAULT;
if not CreateProcess(PChar(FileName), nil, nil, nil, False,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,
PChar(ExtractFilePath(FileName)), StartupInfo, ProcessInfo) then
Exit;
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
end;
end.
相关阅读 >>
Delphi idtcpclient和idtcpserver主要属性
Delphi xe 利用fmx控件的makescreenshot过程实现wait效果
Delphi ini 文件操作记要: 使用 tmeminifile
Delphi xe 使用savestate保存firemonkey状态的示例
更多相关阅读请进入《Delphi》频道 >>
