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

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

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

http://www.cnblogs.com/smallmuda/archive/2009/07/24/1529845.html

 

 今天在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:[email protected],   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(2)——Matlab基本通用操作发布时间:2022-07-18
下一篇:
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