Delphi监控指定进程自动守护错误中间件

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

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

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.