作者:admin 来源: 日期:2015/4/27 19:51:41 人气:获取失败 标签: 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.
|