导航

心动吧DELPHI网络书

自发研究:须要多维思想而且要想不可能为可能的人才能做到

« Access Violation(非法访问)错误的解决方法

判断程序是否无响应

这段代码将集成在 Rarnu Script 保护线程内,用于监视程序/VM是否无响应

 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     
     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;     
    
   procedure    TForm1.Button1Click(Sender:    TObject);     
   var     
       Res:    DWORD;     
       h:    HWND;     
   begin     
       h    :=    FindWindow(nil,   'notepad');     
       if    h    >    0    then     
       begin     
           if    IsAppRespondig(h)    then     
               ShowMessage('notepad 有响应')     
           else     
               ShowMessage('notepad 无响应');     
       end     
       else     
           ShowMessage('未打开 notepad');     
   end;

 

原创文章如转载,请注明:转载自心动吧DELPHI网络书 [ http://www.abcxd.com/delphi/ ]

本文链接地址:http://www.abcxd.com/delphi/abcxddelphi/DELPHIAPI/panduanchengxushifouwuxiangying.html

  • 相关文章:

发表评论:

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。

搜索内容

日历

Copyright ⊙ 2004-2009 心动吧 UrL:ABCXD.CoM All RiGhts Reserved