怎么实现实时监控另一进程的某一窗体是否打开

如是，谢谢了！
这段代码能实现监控，但不知道怎么样改能实时监控
function ExeSniffer( // 执行嗅探
  AHandle: THandle; // 窗体句柄
  AParam: Integer // 附加参数
): BOOL; stdcall;
begin
  vSnifferInfo^.rHandle := AHandle;
  vSnifferInfo^.rParam := AParam;
  vSnifferInfo^.rHOOK := SetWindowsHookEx(
    WH_CALLWNDPROC, SnifferProc, HInstance, GetWindowThreadProcessId(AHandle));
  Result := SendMessageTimeout(AHandle, WM_SNIFFWINDOW, 0, 0,
    SMTO_NORMAL, 3000, THandle(Result)) = 0;
  UnhookWindowsHookEx(vSnifferInfo^.rHOOK);
end;

function SnifferProc(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT; stdcall;
var
  vWinControl: TWinControl;
  vCopyDataStruct: TCopyDataStruct;
  I: Integer;
  S: string;
begin
  case code of
    HC_ACTION:
      begin
        if PCWPStruct(lParam)^.message = WM_SNIFFWINDOW then
        begin
          if ControlAtomString = '' then
          begin
            ControlAtomString := Format('ControlOfs%.8X%.8X', [
              GetWindowLong(vSnifferInfo^.rHandle, GWL_HINSTANCE),
              GetWindowThreadProcessId(vSnifferInfo^.rHandle)]);
            ControlAtom := GlobalAddAtom(PChar(ControlAtomString));
            RM_GetObjectInstance := RegisterWindowMessage(PChar(ControlAtomString));
          end;
          vWinControl := FindControl(vSnifferInfo^.rHandle);
          if Assigned(vWinControl) then
          begin
            for I := 0 to vWinControl.ComponentCount - 1 do
            begin
              S := '';
              if SameText(vWinControl.Components[I].ClassName, 'TLabel') then
              begin
               TLabel(vWinControl.Components[I]).Visible:=false;
                S := Format('%s: %s', [vWinControl.Components[I].Name,
                  QuotedStr(TLabel(vWinControl.Components[I]).Caption)]);
              end else if SameText(vWinControl.Components[I].ClassName, 'TMemo')
                or SameText(vWinControl.Components[I].ClassName, 'TEdit') then
              begin
                S := Format('%s: %s', [vWinControl.Components[I].Name,
                  QuotedStr(TLabel(vWinControl.Components[I]).Caption)]);
              end;
              vCopyDataStruct.cbData := Length(S);
              vCopyDataStruct.dwData := 0;
              vCopyDataStruct.lpData := @S[1];
              SendMessage(vSnifferInfo^.rParam, WM_COPYDATA,
                vSnifferInfo^.rHandle, Integer(@vCopyDataStruct));
            end;
          end;
        end;
      end;
  end;
  Result := CallNextHookEx(vSnifferInfo^.rHOOK, code, wParam, lParam);
end;

14 个解决方案

#1

找他的句柄在不在。

#2

仅仅是监控另一进程的某一窗体是否打开的话肯定判断句柄最快，用钩子反倒麻烦了，非要用钩子的话你可以看看SetWindowsHookEx的帮助，选个合适的类型

#3

引用 2 楼 xstdljj 的回复:

仅仅是监控另一进程的某一窗体是否打开的话肯定判断句柄最快，用钩子反倒麻烦了，非要用钩子的话你可以看看SetWindowsHookEx的帮助，选个合适的类型

判读句柄不太合适，另一进程一打开窗体，就通知本程序，应改用hook来监控窗体打开的消息比较合适吧！
想知道delphi打开一个窗体会发出一个什么消息

#4

尝试用WH_CBT这个钩子?

#5

引用 4 楼 smhilyyan 的回复:

尝试用WH_CBT这个钩子?

可以试试监控WH_CBT类型钩子HCBT_CREATEWND消息

#6

引用 5 楼 xstdljj 的回复:

Quote: 引用 4 楼 smhilyyan 的回复:

尝试用WH_CBT这个钩子?

可以试试监控WH_CBT类型钩子HCBT_CREATEWND消息

请指导下具体怎么做

#7

你不是都写好钩子了吗??
直接改钩子的回调函数啊.

#8

直接放个Timer 查找窗体的句柄不就得了 

#9

郁闷，DELPHI 搞这样的程序，特别是在WIN64位系统下，很容易崩掉！

#10

问题是你这个实时的要求精确到多少。如果是0.1秒或者更长一点1秒都没有问题，我觉得从编程的角度来说，检查句柄是非常简单实用的一种方案。如果要精确到工业级，那……首先考虑Delphi合适不合适。然后考虑用消息。

检查句柄如果过于频繁，资源消耗很高。消息则几乎没有资源消耗。当然也看编程人员的水平。

#11

引用 9 楼 danny_2020 的回复:

郁闷，DELPHI 搞这样的程序，特别是在WIN64位系统下，很容易崩掉！

对，崩掉了N次了，做个简单的试验，就
function ExeSniffer( // 执行嗅探
  AHandle: THandle; // 窗体句柄
  AParam: Integer // 附加参数
): BOOL; stdcall;
begin
  vSnifferInfo^.rHandle := AHandle;
  vSnifferInfo^.rParam := AParam;
  vSnifferInfo^.rHOOK := setwindowshookex(WH_CBT, @lpfn,hinstance,0);
end;
  function lpfn(code:integer;wparam :integer;lparam:integer):LRESULT;stdcall;
  var
    msg:Tmsg;
    vHandle: THandle;

  begin
  if(code=HCBT_CREATEWND)then
  begin
    if (FindWindow(nil, PChar(’窗体名称’))>0) and (not flag) then       //HCBT_CREATEWND    WM_KEYUP
    begin
      showmessage('ok') ;
      flag:=true
    end;

  end;
  Result := CallNextHookEx(VWindowHookInfo^.rhook, code, wParam, lParam);
 end;
这样一个最简单的钩子过程都不成功！是DELPHI太烂了，还是技术太烂了。

#12

加上初始化和结束
initialization
  WM_GETWINDOW := RegisterWindowMessage('SnifferLib.SniffWindow2');
  vMapFile := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, '~Sniffer2');
  if vMapFile = 0 then
    vMapFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
      SizeOf(TWindowHookInfo), '~Sniffer2');
  vWindowHookInfo := MapViewOfFile(vMapFile, FILE_MAP_ALL_ACCESS, 0, 0, 0);

finalization
  UnhookWindowsHookEx(VWindowHookInfo^.rhook);
  UnmapViewOfFile(vWindowHookInfo);
  CloseHandle(vMapFile);

#13

还没解决，继续求助！！！

#14

exe file
//////////////////////////////////////////////////////////////////////
unit m_unit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TMainFrm = class(TForm)
    btn_install: TButton;
    btn_uninstall: TButton;
    procedure btn_installClick(Sender: TObject);
    procedure btn_uninstallClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainFrm: TMainFrm;

  function InstHook32: Boolean; external 'h_calc.dll';
  function UnInstHook32: Boolean; external 'h_calc.dll';

implementation

{$R *.dfm}

procedure TMainFrm.btn_installClick(Sender: TObject);
begin
  if InstHook32 then
  begin
    btn_install.Enabled:= False;
    btn_uninstall.Enabled:= True;
  end;
end;

procedure TMainFrm.btn_uninstallClick(Sender: TObject);
begin
  if UnInstHook32 then
  begin
    btn_install.Enabled:= True;
    btn_uninstall.Enabled:= False;
  end;
end;

end.

//--------------------------------------------------------------------------------

dll file
////////////////////////////////////////////////////////////////////////////////////

unit m_unit;

interface

uses
  Windows, ShellAPI;

var
  hhk: HHOOK;

  function HookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  function InstHook32: Boolean; stdcall; export;
  function UnInstHook32: Boolean; stdcall; export;

implementation

function HookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  hnd: HWND;
begin
  if nCode = HSHELL_WINDOWCREATED then
  begin
    hnd:= FindWindow(nil, '计算器');
    if hnd <> 0 then
    begin
      MessageBox(hnd, '计算器窗体已经运行', '提示', MB_OK + MB_ICONEXCLAMATION);
    end;
  end;
  Result:= CallNextHookEx(hHk, nCode, WParam, LParam);
end;

function InstHook32: Boolean; stdcall; export;
begin
  if hhk <> 0 then
  begin
    Result:= False;
    Exit;
  end;
  hhk:= SetWindowsHookEx(WH_SHELL, @HookProc, HINSTANCE, 0);
  Result:= hhk  <> 0;
end;

function UnInstHook32: Boolean; stdcall; export;
begin
  if hhk  <> 0 then
  begin
    UnhookWindowshookEx(hhk);
    hhk:= 0;
  end;
  Result:= hhk = 0;
end;

end.

//----------------------------------------------------------------------------

大致上是这个意思，程序在 MessageBox 的窗体依存句柄那里有点问题，闪人了，嘿嘿！