delphi 如何判断应用程序未响应

 今天在MSN的核心讨论组上看到两篇文章.讨论的乃是应用程序是否没有响应.原文如下:    
   
  >   How   is   it   possible   to   determine   a   process   is   "not   responding"   like   NT   Task    
  >   Manager   do?    
  The   heuristic   works   only   for   GUI   processes,   and   consists   of   calling    
  SendMessageTimeOut()   with   SMTO_ABORTIFHUNG.    
   
  >There   is   any   API   call   to   do   the   job,   or   this   status   is   simply   a   deduction    
  >based   on   process   counters,   like   that   returned   from   call   to   GetProcessTimes    
  >API   function?    
   
  Use   SendMessageTimeout   with   a   value   of   WM_NULL.   That's   all   Task    
  Manager   does   to   determine   this   AFAIK.    
   
  --    
  有理有理.当然,我这里还有一个UNDOCUMENTED函数,乃是其他的解决方案,NT和9X有个USER32.DLL的函数,IsHungAppWindow(NT)和IsHungThread(9X).使用起来简便无比.下面给出原型.    
  BOOL   IsHungAppWindow   (    
  HWND   hWnd,   //   handle   to   main   app's   window    
  );    
   
  BOOL   IsHungThread   (    
  DWORD   dwThreadId,   //   The   thread's   identifier   of   the   main   app's   window    
  );    
  有了原型,连解释都不需要,好得不的了.:)不过调用时需要GetProcAddress.库里没有该函数.    
  ****************************************  
  check   whether   an   application   (window)   is   not   responding?  
   
  {1.   The   Documented   way}    
   
  {    
      An   application   can   check   if   a   window   is   responding   to   messages   by    
      sending   the   WM_NULL   message   with   the   SendMessageTimeout   function.    
  }    
   
  function   AppIsResponding(ClassName:   string):   Boolean;    
  const    
      {   Specifies   the   duration,   in   milliseconds,   of   the   time-out   period   }    
      TIMEOUT   =   50;    
  var    
      Res:   DWORD;    
      h:   HWND;    
  begin    
      h   :=   FindWindow(PChar(ClassName),   nil);    
      if   h   <>   0   then    
          Result   :=   SendMessageTimeOut(H,    
              WM_NULL,    
              0,    
              0,    
              SMTO_NORMAL   or   SMTO_ABORTIFHUNG,    
              TIMEOUT,    
              Res)   <>   0    
      else    
          ShowMessage(Format('%s   not   found!',   [ClassName]));    
  end;    
   
  procedure   TForm1.Button1Click(Sender:   TObject);    
  begin    
      if   AppIsResponding('OpusApp')   then    
          {   OpusApp   is   the   Class   Name   of   WINWORD.EXE   }    
          ShowMessage('App.   responding');    
  end;    
   
  {2.   The   Undocumented   way}    
   
  {    
      //   Translated   form   C   to   Delphi   by   Thomas   Stutz    
      //   Original   Code:    
      //   (c)1999   Ashot   Oganesyan   K,   SmartLine,   Inc    
      //   mailto:ashot@aha.ru,   http://www.protect-me.com,   http://www.codepile.com    
   
    The   code   doesn't   use   the   Win32   API   SendMessageTimout   function   to    
    determine   if   the   target   application   is   responding   but   calls    
    undocumented   functions   from   the   User32.dll.    
   
    -->   For   Windows   95/98/ME   we   call   the   IsHungThread()   API    
   
    The   function   IsHungAppWindow   retrieves   the   status   (running   or   not   responding)    
    of   the   specified   application    
   
    IsHungAppWindow(Wnd:   HWND):   //   handle   to   main   app's   window    
    BOOL;    
   
    -->   For   NT/2000/XP   the   IsHungAppWindow()   API:    
   
    The   function   IsHungThread   retrieves   the   status   (running   or   not   responding)   of    
    the   specified   thread    
   
    IsHungThread(DWORD   dwThreadId):   //   The   thread's   identifier   of   the   main   app's   window    
    BOOL;    
   
    Unfortunately,   Microsoft   doesn't   provide   us   with   the   exports   symbols   in   the    
    User32.lib   for   these   functions,   so   we   should   load   them   dynamically   using   the    
    GetModuleHandle   and   GetProcAddress   functions:    
  }    
   
  //   For   Win9X/ME    
  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;    
   
  //   For   Win   NT/2000/XP    
  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    
    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;    
   
  //   Example:   Check   if   Word   is   hung/responding    
   
  procedure   TForm1.Button3Click(Sender:   TObject);    
  var    
      Res:   DWORD;    
      h:   HWND;    
  begin    
      //   Find   Word   by   classname    
      h   :=   FindWindow(PChar('OpusApp'),   nil);    
      if   h   <>   0   then    
      begin    
          if   IsAppRespondig(h)   then    
              ShowMessage('Word   is   responding!')    
          else    
              ShowMessage('Word   is   not   responding!');    
      end    
      else    
          ShowMessage('Word   is   not   open!');    
  end;