• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    迪恩网络公众号

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

原作者: [db:作者] 来自: [db:来源] 收藏 邀请
 今天在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;     
 

鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
matlab 常用函数发布时间:2022-07-18
下一篇:
信号与系统实验序章0——MATLAB基础命令入门发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap