delphi 监控进程exe

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  g_uMyAppMonitor, ExtCtrls;

type
  TForm1 = class(TForm)
    lbl1: TLabel;
    btn4: TButton;
    procedure btn4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn4Click(Sender: TObject);
var
  i: Integer;
  bRet: Boolean;
  sAppPath,sHintMsg: string;
  MyHwnd: THandle;
  th32ProcessID: DWORD;
begin
  while True do begin
    bRet := MyAppIsRunIng('Prj.exe', th32ProcessID, MyHwnd, sHintMsg);
    lbl1.Caption := sHintMsg;
    ifDelay(ifTime(1));
    if not bRet then begin
      sAppPath := GetAppPahtByProcessId(th32ProcessID);
      i := 3;
      while i > 0 do begin
        lbl1.Caption := '结束进程前的等待：' + IntToStr(i) + ' 秒';
        ifDelay(ifTime(1));
        i := i - 1;
      end;
      if KillProcessByProcessID(th32ProcessID) then begin
        lbl1.Caption := '已经结束掉进程（processId：' + IntToStr(th32ProcessID) + '）';
        if (Trim(sAppPath) <> '') and FileExists(sAppPath) then begin
          OpenExeByAppPath(sAppPath);
          lbl1.Caption := '已经启动程序：' + ExtractFileName(sAppPath);
          ifDelay(ifTime(5));
        end;
        bRet := MyAppIsRunIng('Prj.exe', th32ProcessID, MyHwnd, sHintMsg)
      end else
        lbl1.Caption := '未结束掉进程（processId：' + IntToStr(th32ProcessID) + '）';
    end;
  end;
end;

end.

unit g_uMyAppMonitor;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, TLHelp32, ShellAPI, Psapi;

type
  PEnumInfo = ^TEnumInfo;

  TEnumInfo = record
    ProcessID: DWORD;
    HWND: THandle;
  end;

function ifTime(ifKillWaitSecond: Integer): Longint;

procedure ifDelay(MSecs: Longint);

function GetAppPahtByProcessId(th32ProcessID: DWORD): string;

function KillProcessByProcessID(th32ProcessID: DWORD): Boolean;

procedure OpenExeByAppPath(sAppPath: string);

function MyAppIsRunIng(ProcessName: string;  var th32ProcessID: DWORD; var MyHwnd: THandle; var sHintMsg: string): Boolean;

var
  FSnapshotHandle: THandle; //进程快照句柄
  FProcessEntry32: TProcessEntry32; //进程入口的结构体信息

implementation

function EnumWindowsProc(Wnd: DWORD; var EI: TEnumInfo): Bool; stdcall;
var
  PID: DWORD;
  lv_b0, lv_b1, lv_b2: Boolean;
  lv_s0, lv_s1, lv_s2: string;
begin
  GetWindowThreadProcessID(Wnd, @PID);
  Result := (PID <> EI.ProcessID) or (not IsWindowVisible(Wnd)) or (not
    IsWindowEnabled(Wnd));
  if not Result then
  begin
    EI.HWND := Wnd;
  end;
end;

function FindMainWindow(PID: DWORD): DWORD;
var
  EI: TEnumInfo;
begin
  EI.ProcessID := PID;
  EI.HWND := 0;
  EnumWindows(@EnumWindowsProc, Integer(@EI));
  Result := EI.HWND;
end;

function GetHWndByPID(const hPID: THandle): THandle;
begin
  if hPID <> 0 then
    Result := FindMainWindow(hPID)
  else
    Result := 0;
end;

function GetHandleCaption(nHandle: THandle): string;
var
  buffer: array[0..255] of char;
begin
  GetClassName(nHandle, buffer, 256);
  SendMessage(nHandle, WM_GETTEXT, 256, Integer(@buffer[0]));
  Result := StrPas(buffer);
end;

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 IsWindow(Wnd) then
  begin
    if Win32Platform = VER_PLATFORM_WIN32_NT then
      Result := IsAppRespondigNT(Wnd)
    else
      Result := IsAppRespondig9X(GetWindowThreadProcessId(Wnd, nil));
  end;
end;

function MyAppMonitor_Project(sProcessName: string; var th32ProcessID: DWORD; var MyHwnd: THandle; var
  sErrorMsg: string): Boolean;
var
  sName, sCaption: string; //进程名
  ContinueLoop: BOOL;
begin
  Result := False;
  sErrorMsg := '程序未启动！';
  th32ProcessID := 0;
  MyHwnd := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  while ContinueLoop do
  begin
    sName := FProcessEntry32.szExeFile;
    if (UpperCase(sName) = UpperCase(sProcessName)) then
    begin
      th32ProcessID := FProcessEntry32.th32ProcessID;
      MyHwnd := GetHWndByPID(FProcessEntry32.th32ProcessID);
//      sCaption := GetHandleCaption(MyHwnd);
//      sErrorMsg := '窗口标题-' + sCaption;
      if IsAppRespondig(MyHwnd) then
      begin
        sErrorMsg := '程序正常，有响应（' + sProcessName + '）！';
        Result := True;
      end
      else
        sErrorMsg := '程序异常，没响应，可能卡死状态（' + sProcessName + '）！';
      Break;
    end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

function KillProcessByProcessID(th32ProcessID: DWORD): Boolean;
var
  processHandle: THandle;
begin
  Result := False;
  processHandle := OpenProcess(PROCESS_TERMINATE, False, th32ProcessID);
  if processHandle <> 0 then
  begin
    TerminateProcess(processHandle, 0);
    CloseHandle(processHandle);
    Result := True;
  end;
end;

function GetAppPahtByProcessId(th32ProcessID: DWORD): string;
var
  Hand: THandle;
  hMod: HModule;
  n: DWORD;
  buf: Array[0..Max_Path-1] of Char;
begin
  Result := '';
  Hand := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, th32ProcessID);
  if Hand > 0 then begin
    FillChar(buf, SizeOf(buf), #0);
    ENumProcessModules(Hand, @hMod, Sizeof(hMod), n);
    if GetModuleFileNameEx(Hand, hMod, buf, Sizeof(buf)) > 0 then
      Result := StrPas(@buf[0]);
  end;
end;

procedure OpenExeByAppPath(sAppPath: string);
begin
  if Trim(sAppPath) <> '' then
    ShellExecute(0, nil, PChar(sAppPath), nil, nil, SW_SHOWNORMAL);
end;

function ifTime(ifKillWaitSecond: Integer): Longint;
begin
  if (ifKillWaitSecond <=0) and (ifKillWaitSecond > 10*60) then
    Result := 3*60*1000
  else
    Result := ifKillWaitSecond*1000;
end;

procedure ifDelay(MSecs: Longint);   //延时函数，MSecs单位为毫秒(千分之1秒)
var
  FirstTickCount, Now: Longint;
begin
  FirstTickCount := GetTickCount();
  repeat
    Application.ProcessMessages;
    Now := GetTickCount();
  until (Now - FirstTickCount >= MSecs) or (Now < FirstTickCount);
end;

function MyAppIsRunIng(ProcessName: string;  var th32ProcessID: DWORD; var MyHwnd: THandle; var sHintMsg: string): Boolean;
var
  bRet: Boolean;
  sAppPath: string;
begin
  sHintMsg := '默认提示消息！';
  bRet := MyAppMonitor_Project(ProcessName, th32ProcessID, MyHwnd, sHintMsg);
  Result := bRet and (th32ProcessID > 0);
end;

end.