监控指定进程

对于守护中间件是非常有用的。中间件不可能绝对的稳定而不出问题，中间件有可能因比较严重的错误导致当机或者进程被人为地错误地关闭了中间件。

有了这个自动守护进程的存在，这一切的问题都可以迎刃而解。

program Monitor;

// {$APPTYPE CONSOLE}

uses
Winapi.Windows,
System.SysUtils,
ProcLib in 'ProcLib.pas';

var
Mutex, h: HWND;

const
c_AppName = 'server.exe';
c_ClassName = 'Tf_MainForm';

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
begin
h := FindWindow(PChar(c_ClassName), nil);
if (not IsAppRespondig(h)) and (h <> 0) then
begin
KillTask(c_AppName);
Continue;
end
else
Continue;
end;

if G_ExeFile = '' then
Continue;

Exec(G_ExeFile);
end;

end.

unit ProcLib;

interface

uses
Winapi.Windows, System.SysUtils, Winapi.PsAPI,
Winapi.TlHelp32, Winapi.ShellAPI, Winapi.Messages, Vcl.Dialogs;

function ProcessRunning(ExeName: string): Boolean; // 指定进程是否正在运行
procedure Exec(FileName: string); // 开启指定进程
function KillTask(ExeFileName: String): Integer; // 关闭进程
function IsAppRespondig(wnd: HWND): Boolean; // 进程是否有反应

var
G_ExeFile: string = '';

implementation

function IsAppRespondig9X(dwThreadId: DWORD): Boolean;
type
TIsHungThread = function(dwThreadId: DWORD): BOOL; stdcall;
var
hUser32: THandle;
IsHungThread: TIsHungThread;
begin
Result := True;
hUser32 := GetModuleHandle('user32.dll');
if (hUser32 > 0) then
begin
@IsHungThread := GetProcAddress(hUser32, 'IsHungThread');
if Assigned(IsHungThread) then
begin
Result := not IsHungThread(dwThreadId);
end;
end;
end;

function IsAppRespondigNT(wnd: HWND): Boolean;
type
TIsHungAppWindow = function(wnd: HWND): BOOL; stdcall;
var
hUser32: THandle;
IsHungAppWindow: TIsHungAppWindow;
begin
Result := True;
hUser32 := GetModuleHandle('user32.dll');
if (hUser32 > 0) then
begin
@IsHungAppWindow := GetProcAddress(hUser32, 'IsHungAppWindow');
if Assigned(IsHungAppWindow) then
begin
Result := not IsHungAppWindow(wnd);
end;
end;
end;

function IsAppRespondig(wnd: HWND): Boolean;
begin
Result := False;
if not IsWindow(wnd) then
begin
ShowMessage('Incorrect window handle!');
Exit;
end;
if Win32Platform = VER_PLATFORM_WIN32_NT then
Result := IsAppRespondigNT(wnd)
else
Result := IsAppRespondig9X(GetWindowThreadProcessId(wnd, nil));
end;

function KillTask(ExeFileName: String): Integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: Boolean;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

while Integer(ContinueLoop) <> 0 do
begin
If ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile))
= UpperCase(ExeFileName)) Or (UpperCase(FProcessEntry32.szExeFile)
= UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),
FProcessEntry32.th32ProcessID), 0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;

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.