200分真的不想麻烦大家，其实就是为了getmsgproc ，我到处找资料，大多是C的，我东转西拼的，结果可以用但却没效果。(200分)

telliu · 2003-05-29

本来是想做一个全局的钩子检测close这个消息的。下面是我的程序,我东拼西拼的，就是变量都搞乱了 ，麻烦大家帮帮我 unit liu; interface uses Windows,Messages,Dialogs; var   hHk: HHOOK;     function GetMsgProc(nCode: Integer;WParam: WPARAM;LParam: LPARAM):LRESULT;stdcall;   function Enablegetmsgproc:Boolean; stdcall; export;   function Disablegetmsgproc:Boolean; stdcall; export; implementation function GetMsgProc(nCode: Integer;WParam: WPARAM;LParam: LPARAM):LRESULT;stdcall; begin Result := 0;   if Lparam = WM_CLOSE then showmessage('要关闭了') //在这里，如果自己弹出来的这个窗口又关闭，就是永远不会结束了，是吗？其实我只是想知道我收到了消息没有,先不管它。 else    CallNextHookEx(hhk, nCode, wParam, lParam ); end; function Enablegetmsgproc:Boolean; stdcall; export; begin   if hHk = 0 then //为了安全，必须判断一下再设置钩子。   begin     hHk := SetWindowsHookEx(WH_GETMESSAGE,@GetMsgProc,hInstance,0);     Result := True;   end   else     Result := False; end; function Disablegetmsgproc:Boolean; stdcall; export; begin   if hHk <> 0 then //如果有钩子就卸掉他。   begin     UnHookWindowsHookEx(hHk);     hHk := 0;     Result := True;   end   else     Result := False; end; end.

quejian · 2003-05-29

var   MsgStruct: ^CWPSTRUCT;//再增加个变量 function GetMsgProc(nCode: Integer;WParam: WPARAM;LParam: LPARAM):LRESULT;stdcall; begin   if nCode >= 0 then begin     MsgStruct := pointer(lParam);     case MsgStruct^.message of         wm_close:begin          showmessage('关闭了'); //在这里做相应的操作           end;     end;   end;   Result := CallNextHookEx(hhk, nCode, wParam, lParam ); end; 好了，你试试看吧！

telliu · 2003-05-29

to:quejian    好惨啊。。运行后 我电脑死--》我就反它重起了5次  发现下面特征..（非典，，：( ） 我的程序放在E：/get目录下。 按照你的指点，我改了，把dll又放回到system里去了。 我从文件夹下面双击调用钩子的程序,运行  if Enablegetmsgproc then    ShowMessage('启动钩子成功');  这段代码(难道这句会是错的） 这时我关闭任何窗口都没反应。（不会弹出窗口，说明没收到！） 除了E:/get这个文件夹窗口---------->这个窗口一关就会非法操作，然后就死机 再提一句，我在win98..... 是哪里出错昵。。。 我不清楚我是否还要提示些什么，，请富翁们指点

wbtvc · 2003-05-29

case MsgStruct^.message of        wm_close:begin         showmessage('关闭了');        end; 错误在showmessage('关闭了'); 不要在hook里用showmessage，否则很惨 你可以使用sendmessage发消息 看看下面的代码： function GetMsgProc(nCode: integer; wParam, lParam: longint): LRESULT;   stdcall; var   pInfo: TMsg; begin   if nCode < 0 then   begin     Result := CallNextHookEx(hhk, nCode, wParam, lParam);     exit;   end;   if (nCode = HC_ACTION) and (wParam = PM_REMOVE) then    begin     pInfo := TMsg(PMsg(lparam)^);       if pInfo.message = WM_CLOSE then       begin         //做你想做的，不过一般是使用sendmessage来发送消息的       end;     end;   Result := CallNextHookEx(hhk, nCode, wParam, lParam); end;

telliu · 2003-05-29

to: 我试过了，还是非法操作内容如下： EXPLORER 在 0167:bff9dfc5 的模块  KERNEL32.DLL 中导致无效页错误。 Registers: EAX=c00309f4 CS=0167 EIP=bff9dfc5 EFLGS=00010216 EBX=0124f9ac SS=016f ESP=0120fe5c EBP=012100f8 ECX=00000000 DS=016f ESI=817ac4e0 FS=5e47 EDX=bff768d5 ES=016f EDI=012101d0 GS=0000 Bytes at CS:EIP: 53 8b 15 e4 ad fc bf 56 89 4d e4 57 89 4d dc 89 Stack dump:

telliu · 2003-05-29

原码改成如下： unit liu; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, StdCtrls; var   hHk: HHOOK;   MsgStruct: ^CWPSTRUCT;//再增加个变量   function GetMsgProc(nCode: Integer;WParam: WPARAM;LParam: LPARAM):LRESULT;stdcall;   function Enablegetmsgproc:Boolean; stdcall; export;   function Disablegetmsgproc:Boolean; stdcall; export; implementation function GetMsgProc(nCode: Integer;WParam: WPARAM;LParam: LPARAM):LRESULT;stdcall; begin Result := 0;  if nCode >= 0 then begin    MsgStruct := pointer(lParam);    case MsgStruct^.message of        wm_close:begin         //showmessage('关闭了'); //在这里做相应的操作        SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);//我在调用钩子的地方，把SetFocus传给了下一个解黑屏的，只要回车就能解了。         end;    end;  end;  Result := CallNextHookEx(hhk, nCode, wParam, lParam ); end; function Enablegetmsgproc:Boolean; stdcall; export; begin   if hHk = 0 then //为了安全，必须判断一下再设置钩子。   begin     hHk := SetWindowsHookEx(WH_GETMESSAGE,@GetMsgProc,hInstance,0);     Result := True;   end   else     Result := False; end; function Disablegetmsgproc:Boolean; stdcall; export; begin   if hHk <> 0 then //如果有钩子就卸掉他。   begin     UnHookWindowsHookEx(hHk);     hHk := 0;     Result := True;   end   else     Result := False; end; end.

wbtvc · 2003-05-29

什么啊： SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0); 怎么能这样用 看看这个： http://www.delphibbs.com/delphibbs/dispq.asp?lid=1893890

telliu · 2003-05-29

好的，马上去看，就是不能解决问题也散分，感谢你们的回答

telliu · 2003-05-29

系统核心方面的没看过书。看了你的讲解，头晕中。 你能否直接说出我的错误在哪，你的讲解，我要慢慢看：（ 拜托你了

telliu · 2003-05-29

to:wbtvc 老大不是哪个的错。 我试过就是得到关闭消息什么事也不做。也照样出错。

wbtvc · 2003-05-29

function GetMsgProc(nCode: Integer;WParam: WPARAM;LParam: LPARAM):LRESULT;stdcall; 里的代码改成我上面我写的看看

telliu · 2003-05-29

对啊，，我copy过去的，一个标点都没错 unit liu; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, StdCtrls; var   hHk: HHOOK;   MsgStruct: ^CWPSTRUCT;//再增加个变量   function GetMsgProc(nCode: Integer;WParam: WPARAM;LParam: LPARAM):LRESULT;stdcall;   function Enablegetmsgproc:Boolean; stdcall; export;   function Disablegetmsgproc:Boolean; stdcall; export; implementation function GetMsgProc(nCode: integer; wParam, lParam: longint): LRESULT;  stdcall; var  pInfo: TMsg; begin  if nCode < 0 then  begin    Result := CallNextHookEx(hhk, nCode, wParam, lParam);    exit;  end;  if (nCode = HC_ACTION) and (wParam = PM_REMOVE) then   begin    pInfo := TMsg(PMsg(lparam)^);      if pInfo.message = WM_CLOSE then      begin        //做你想做的，不过一般是使用sendmessage来发送消息的      end;    end;  Result := CallNextHookEx(hhk, nCode, wParam, lParam); end; function Enablegetmsgproc:Boolean; stdcall; export; begin   if hHk = 0 then //为了安全，必须判断一下再设置钩子。   begin     hHk := SetWindowsHookEx(WH_GETMESSAGE,@GetMsgProc,hInstance,0);     Result := True;   end   else     Result := False; end; function Disablegetmsgproc:Boolean; stdcall; export; begin   if hHk <> 0 then //如果有钩子就卸掉他。   begin     UnHookWindowsHookEx(hHk);     hHk := 0;     Result := True;   end   else     Result := False;     end; end.

Pipi. · 2003-05-29

不要显示窗口了，可以使用 windows.Beep(1000,500) 来听声音就可以了 （win9x不能听到你设置的1000hz500毫秒，只能听到普通的beep一声，nt/win2000/xp就可以） CallNextHookEx应该这样： if nCode<0 then   result:=CallNextHookEx(hhk, nCode, wParam, lParam )  else   result:=0

wbtvc · 2003-05-29

DLL 代码： library Mhook; uses Main in 'Main.pas', windows, messages, Classes, sysutils; procedure DLLEntryPoint(dwReason: DWORD); begin case dwReason of   DLL_PROCESS_ATTACH: OpenShareData;   DLL_PROCESS_DETACH: CloseShareData; end; end; exports EnableHook, DisableHook; begin procExit := ExitProc; ExitProc := @HookExit; DLLProc := @DLLEntryPoint; DLLEntryPoint(DLL_PROCESS_ATTACH); end. ======================================================================= unit Main; interface uses windows, messages, Classes, sysutils; type PServerData = ^ServerData; ServerData = record   Wnd: HWND;   UniqueMsgID: Cardinal;   hHk: HHOOK; end; var procExit: pointer; SData: PServerData; MapServerHandle: THandle; const cMMServerData: PChar = 'ServerMapData'; function EnableHook(h: HWND): Boolean; stdcall; function DisableHook(): Boolean; stdcall; procedure HookExit; far; procedure OpenShareData(); procedure CloseShareData(); function GetMsgProc(nCode: integer; wParam, lParam: longint): LRESULT; stdcall; implementation procedure OpenShareData(); var Size: integer; begin Size := Sizeof(SData); MapServerHandle := CreateFileMapping(DWORD(-1), nil, PAGE_READWRITE, 0, Size,   cMMServerData); SData := MapViewOfFile(MapServerHandle, FILE_MAP_ALL_ACCESS, 0, 0, Size); end; procedure CloseShareData(); begin UnmapViewOfFile(SData); CloseHandle(MapServerHandle); end; function EnableHook(h: HWND): Boolean; stdcall; begin if SData.hHk <> 0 then begin   Result := false;   exit; end; SData.Wnd := h; SData.UniqueMsgID := RegisterWindowMessage('RWM1'); SData.hHk := SetWindowsHookEx(WH_GETMESSAGE, @GetMsgProc, hInstance, 0); Result := SData.hHk <> 0; end; function DisableHook(): Boolean; stdcall; begin //注销挂钩 Result := false; if UnhookWindowsHookEx(SData.hHk) then begin   SData.hHk := 0;   Result := true; end; end; procedure HookExit; begin if SData.hHk <> 0 then   DisableHook; ExitProc := procExit; end; function GetMsgProc(nCode: integer; wParam, lParam: longint): LRESULT; stdcall; var pInfo: TMsg; begin if nCode < 0 then begin   Result := CallNextHookEx(hhk, nCode, wParam, lParam);   exit; end; if (nCode = HC_ACTION) and (wParam = PM_REMOVE) then  begin   pInfo := TMsg(PMsg(lparam)^);     if pInfo.message = WM_CLOSE then     begin       //做你想做的，不过一般是使用sendmessage来发送消息的      SendMessage(SData.Wnd, SData.UniqueMsgID, 0, 0);       end;   end; Result := CallNextHookEx(hhk, nCode, wParam, lParam); end; ======================================================================= 主程序： unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm)   Label1: TLabel;   Button1: TButton;   Edit1: TEdit;   procedure FormCreate(Sender: TObject);   procedure FormDestroy(Sender: TObject); private   { Private declarations }   procedure WndProc(var Msg: TMessage); override; public   { Public declarations } end; function EnableHook(h: HWND): Boolean; stdcall; function DisableHook(): Boolean; stdcall; var Form1: TForm1; UniqueMsgID: Cardinal; implementation function EnableHook; external 'MHook.dll' name 'EnableHook'; function DisableHook; external 'MHook.dll' name 'DisableHook'; {$R *.dfm} procedure TForm1.WndProc(var Msg: TMessage); var ptMousePos: Tpoint; begin if Msg.msg = UniqueMsgID then begin   GetCursorPos(ptMousePos);   label1.Caption := 'X:' + inttostr(ptMousePos.X) + '  Y:' + inttostr(ptMousePos.Y); end; inherited WndProc(Msg); ; end; procedure TForm1.FormCreate(Sender: TObject); var h: HWND; begin UniqueMsgID := RegisterWindowMessage('RWM1'); EnableHook(Handle); end; procedure TForm1.FormDestroy(Sender: TObject); begin DisableHook; end; end.

telliu · 2003-05-29

谢谢各位。我先给分。不行再来。反正还有分。

Pipi. · 2003-05-29

hHk 不能保存于一般的全局变量，应该放在共享的空间 见：http://www.delphibbs.com/delphibbs/dispq.asp?lid=635375

200分真的不想麻烦大家，其实就是为了getmsgproc ，我到处找资料，大多是C的，我东转西拼的，结果可以用但却没效果。(200分)

telliu

Unregistered / Unconfirmed

quejian

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

wbtvc

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

wbtvc

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

wbtvc

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

Pipi.

Unregistered / Unconfirmed

wbtvc

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

Pipi.

Unregistered / Unconfirmed

Similar threads

200分 真的不想麻烦大家，其实就是为了getmsgproc ，我到处找资料，大多是C的，我东转西拼的，结果可以用但却没效果。(200分)

telliu

Unregistered / Unconfirmed

quejian

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

wbtvc

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

wbtvc

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

wbtvc

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

Pipi.

Unregistered / Unconfirmed

wbtvc

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

Pipi.

Unregistered / Unconfirmed

Similar threads

200分真的不想麻烦大家，其实就是为了getmsgproc ，我到处找资料，大多是C的，我东转西拼的，结果可以用但却没效果。(200分)