DLL内事件如何才能返回主程序?

Question

小弟用VB做了个有输出函数的DLL,在里面加入了鼠标钩子.目前鼠标钩工作还算正常,但是,做键盘钩子时就遇到了问题:键盘钩子在按下按键时就被钩子函数截取,但是有一个问题.我不想像鼠标钩子那样用个时钟去返回数值,而是想,在安装钩子后,一有按键按下,DLL就传回一个事件,而不是由一个时钟不断地来查看缓冲区里有没有数据.那样工作起来的效率实在是不高.而我所知,控件是可以有事件产生的.但是,DLL里产生的事件要怎样才能返回主程序呢?

Answer 1

http://community.csdn.net/Expert/topic/3291/3291578.xml?temp=.502041
'VB Module Code:
Option Explicit
Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202Public Const LBDOWN = WM_USER + WM_LBUTTONDOWN
Public Const LBUP = WM_USER + WM_LBUTTONUPDim Str As String
Dim WinProc As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic Function MyFun(ByVal con As String, ByVal hwnd As Long) As Long
    Str = con & "==" & hwnd
    Main.Text2.Text = Str & vbCrLf & vbCrLf & Main.Text2.Text
    MyFun = True
End FunctionPublic Sub SetSubClass(ByVal Wnd As Long)
    On Error Resume Next
    WinProc = GetWindowLong(Wnd, GWL_WNDPROC)
    SetWindowLong Wnd, GWL_WNDPROC, AddressOf WndProc
End SubPublic Sub UnSubClass(ByVal Wnd As Long)
    On Error Resume Next
    SetWindowLong Wnd, GWL_WNDPROC, WinProc
End SubPublic Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    Select Case Msg
        Case LBDOWN: Call MyFun("WM_LBUTTONDOWN", wParam)
        Case LBUP: Call MyFun("WM_LBUTTONUP", wParam)
    End Select
    WndProc = CallWindowProc(WinProc, hwnd, Msg, wParam, lParam)
End Function
---------------------------------------------
VB Form Code:
Option ExplicitPrivate Declare Function RegHook Lib "SetMouseHook.dll" (ByVal hwnd As Long) As Boolean
Private Declare Function RemoveHook Lib "SetMouseHook.dll" () As Boolean
Private Sub Command1_Click()
    SetSubClass Me.hwnd
    Text1.Text = "R=" & CStr(RegHook(Text1.hwnd))
    
End SubPrivate Sub Command2_Click()
    Text1.Text = "U=" & CStr(RemoveHook)
    UnSubClass Text1.hwnd
End SubPrivate Sub Form_Load()
    SetMouseIn Me.hwnd, 255, True, False
    SetSubClass Text1.hwnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Command2_Click
End Sub
-------------------------------------------------
Delphi Code:
library MouseHook;uses
  SysUtils,
  WinTypes,
  WinProcs,
  Messages;{$R *.res}
const
  LBDOWN=WM_USER+WM_LBUTTONDOWN;
  LBUP=WM_USER+WM_LBUTTONUP;
var
  IsHooked:boolean;
  HookHandle:hhook;
  DesktopWin:hwnd;
  hWndLong:longint;
function HookProc(Code:integer;wParam:wparam;lParam:lparam):LRESULT;stdcall;
var
  cur:TPoint;
begin
  if(Code=HC_Action)then
  if(wParam=WM_LBUTTONDOWN)then
    begin
      //MessageBeep(MB_ICONASTERISK);
      GetCursorPos(Cur);
      SendMessage(hWndLong,LBDOWN,WindowFromPoint(Cur),lParam);
    end;  if(Code=HC_Action)then
  if(wParam=WM_LBUTTONUP)then
    begin
      //MessageBeep(MB_ICONASTERISK);
      GetCursorPos(Cur);
      SendMessage(hWndLong,LBUP,WindowFromPoint(Cur),lParam);
    end;    Result:=CallNextHookEx(HookHandle,Code,wParam,lParam);
end;function RegHook(FunCallEx:longint):boolean;stdcall;//********************************
begin
  Result:=false;
  if ishooked then
    exit;
    hWndLong:=FunCallEx;
    Desktopwin:=GetDesktopWindow;
    HookHandle:=SetWindowsHookEx(WH_MOUSE,HookProc,HInstance,0);
    Result:=HookHandle<>0;
end;function RemoveHook:boolean;stdcall;//***************************
begin
  Result:=false;
  if(not IsHooked)and(HookHandle<>0)then
    Result:=UnhookWindowsHookEx(HookHandle);
    IsHooked:=false;
end;exports
  RegHook,RemoveHook,HookProc;begin
  IsHooked:=false
end.

Answer 2

窗体中的《SetMouseIn》是置顶函数'SetMouseIn 窗体的句柄,透明度（可选）,是否置顶（可选）,是否鼠标穿透（可选）
Option Explicit
Public Const LWA_ALPHA = &H2
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const WS_EX_TRANSPARENT As Long = &H20&
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const HWND_TOPMOST = -1Public Function SetMouseIn(ByVal hwnd As Long, Optional TouMing As Long = 200, Optional Top As Boolean = True, Optional cMouse As Boolean = True) As Long
    Dim Ret As Long
    Ret = GetWindowLong(hwnd, GWL_EXSTYLE)
    Ret = Ret Or WS_EX_LAYERED
    If cMouse Then Ret = Ret Or WS_EX_TRANSPARENT
    SetWindowLong hwnd, GWL_EXSTYLE, Ret
    SetLayeredWindowAttributes hwnd, 0, TouMing, LWA_ALPHA
    If Top Then SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Function

Answer 3

//A:向主窗口发消息
//B:用事件、管道实现线程同步，只不过该线程会堵塞，不能做界面我对A方法有点兴趣,不知具体是怎样的?

Answer 4

我上面贴的不就是吗？不过是DELPHI的。
发的消息是：<WM_USER+原本的消息>给调用的窗体，然后用子类分析消息。

Answer 5

DLL也可以Raiseevent,调用时用Withevents声明。

Answer 6

哈哈,各位,我用一个偏方实现了这个功能!!!是这样的,先贴代码吧:DLL内: Public hHook As Long
 Public hHwnd As Long Public Sub UnHookKBD()
 If hnexthookproc <> 0 Then
    UnhookWindowsHookEx hHook
    hHook = 0
 End If
 End Sub Public Function EnableKBDHook(ByVal Hwnd As Long)
 
 If hHook <> 0 Then
    Exit Function
 End If
 
 hHwnd = Hwnd
 
 hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf _
             MyKBHFunc, App.hInstance, App.ThreadID)
 End Function Public Function MyKBHFunc(ByVal iCode As Long, _
     ByVal wParam As Long, ByVal lParam As Long) As Long
   MyKBHFunc = 0
   
   SendMessage hHwnd, WM_KEYDOWN, 8052 + wParam, 1
   
   Call CallNextHookEx(hHook, iCode, wParam, lParam) '传给下一个Hook
 End Function窗体内:Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim K As LongK = KeyCode - 8052If K > 0 Then    '这里是处理函数
    
End IfEnd SubPrivate Sub Form_Load()EnableKBDHook Me.HwndEnd Sub*************************************************************嘿嘿,我用WM_KEYDOWN来代替了.......结果,功能上目前是正常的,还没有发现什么问题......只是,不知道那个wParam的值会不会真的有8052那么大呀??(8052是我QQ的前四位..)

Answer 7

呵呵，你看看这个：
http://community.csdn.net/Expert/topic/3285/3285492.xml?temp=.7137873

Answer 8

谢谢~~看是看过了,但是......你还不明白我的水平... 我目前为止还不知道"类模块"概念,当然就更别说使用了....(菜啊.....)说真的,我手头的书与资料里都没有提到过这个"类模块"."类模块"是个什么东东,有什么用,怎样使用,我一概不知......目前我所做的程序里,最多就是使用一个模块(.bas那种),然后就是API,其他的就不会了看来我还要多充充电,呵呵哦,还有,我是做电工的,所以......别笑我的菜呀-_-b.....