| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 6361 人关注过本帖, 2 人收藏
标题:一个全局键盘、鼠标HOOK的DLL源码
只看楼主 加入收藏
griefforyou
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:3336
专家分:0
注 册:2004-4-15
收藏(2)
 问题点数:0 回复次数:14 
一个全局键盘、鼠标HOOK的DLL源码

做这个东西很容易引导“犯罪”,我今天提供的源码希望不要用于“木马”之类的用途。

一、新建一个ActiveX Dll工程,名字栏里取名为SysHook

二、添加一个模块,取名为mHook,添加代码如下:

Option Explicit Type POINTAPI x As Long y As Long End Type

Type TMSG hwnd As Long message As Long wParam As Long lParam As Long time As Long pt As POINTAPI End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long) Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public hJournalHook As Long, hAppHook As Long Public SHptr As Long Public Const WM_CANCELJOURNAL = &H4B

Public Function JournalRecordProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If nCode < 0 Then JournalRecordProc = CallNextHookEx(hJournalHook, nCode, wParam, lParam) Exit Function End If ResolvePointer(SHptr).FireEvent lParam Call CallNextHookEx(hJournalHook, nCode, wParam, lParam) End Function

Public Function AppHookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If nCode < 0 Then AppHookProc = CallNextHookEx(hAppHook, nCode, wParam, lParam) Exit Function End If Dim msg As TMSG CopyMemory msg, ByVal lParam, Len(msg) Select Case msg.message Case WM_CANCELJOURNAL If wParam = 1 Then ResolvePointer(SHptr).FireEvent WM_CANCELJOURNAL End Select Call CallNextHookEx(hAppHook, nCode, wParam, ByVal lParam) End Function

Private Function ResolvePointer(ByVal lpObj&) As cSystemHook Dim oSH As cSystemHook CopyMemory oSH, lpObj, 4& Set ResolvePointer = oSH CopyMemory oSH, 0&, 4& End Function

三、把工程自动建立的Class1类模块改名为cSystemHook,添加代码如下:

Option Explicit Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Public Event KeyDown(KeyCode As Integer, Shift As Integer) Public Event KeyUp(KeyCode As Integer, Shift As Integer) Public Event SystemKeyDown(KeyCode As Integer) Public Event SystemKeyUp(KeyCode As Integer)

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey As Long)

Private Const WM_KEYDOWN = &H100 Private Const WM_KEYUP = &H101 Private Const WM_MOUSEMOVE = &H200 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_RBUTTONDOWN = &H204 Private Const WM_RBUTTONUP = &H205 Private Const WM_RBUTTONDBLCLK = &H206 Private Const WM_MBUTTONDOWN = &H207 Private Const WM_MBUTTONUP = &H208 Private Const WM_MBUTTONDBLCLK = &H209 Private Const WM_MOUSEWHEEL = &H20A Private Const WM_SYSTEMKEYDOWN = &H104 Private Const WM_SYSTEMKEYUP = &H105

Private Const WH_JOURNALRECORD = 0 Private Const WH_GETMESSAGE = 3

Private Type EVENTMSG wMsg As Long lParamLow As Long lParamHigh As Long msgTime As Long hWndMsg As Long End Type

Dim EMSG As EVENTMSG

Public Function SetHook() As Boolean If hJournalHook = 0 Then hJournalHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JournalRecordProc, App.hInstance, 0) If hAppHook = 0 Then hAppHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf AppHookProc, App.hInstance, App.ThreadID) SetHook = True End Function

Public Sub RemoveHook() UnhookWindowsHookEx hAppHook UnhookWindowsHookEx hJournalHook End Sub

Private Sub Class_Initialize() SHptr = ObjPtr(Me) End Sub

Private Sub Class_Terminate() If hJournalHook Or hAppHook Then RemoveHook End Sub

Friend Function FireEvent(ByVal lParam As Long) Dim i%, j%, k% Dim s As String If lParam = WM_CANCELJOURNAL Then hJournalHook = 0 SetHook Exit Function End If CopyMemory EMSG, ByVal lParam, Len(EMSG) Select Case EMSG.wMsg Case WM_KEYDOWN j = 0 If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4) 'fixed by JJ s = Hex(EMSG.lParamLow) k = (EMSG.lParamLow And &HFF) RaiseEvent KeyDown(k, j) s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ EMSG.lParamLow = CLng("&h" & s) CopyMemory ByVal lParam, EMSG, Len(EMSG) Case WM_KEYUP j = 0 'fixed by JJ If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4) 'fixed by JJ s = Hex(EMSG.lParamLow) k = (EMSG.lParamLow And &HFF) RaiseEvent KeyUp(k, j) s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ EMSG.lParamLow = CLng("&h" & s) CopyMemory ByVal lParam, EMSG, Len(EMSG) Case WM_MOUSEMOVE i = 0 'fixed by JJ If GetAsyncKeyState(vbKeyLButton) Then i = (i Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyRButton) Then i = (i Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMButton) Then i = (i Or 4) 'fixed by JJ j = 0 'fixed by JJ If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4) 'fixed by JJ RaiseEvent MouseMove(i, j, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)) Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN i = 0 'fixed by JJ If GetAsyncKeyState(vbKeyShift) Then i = (i Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then i = (i Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then i = (i Or 4) 'fixed by JJ RaiseEvent MouseDown(2 ^ ((EMSG.wMsg - 513) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)) Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP i = 0 'fixed by JJ If GetAsyncKeyState(vbKeyShift) Then i = (i Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then i = (i Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then i = (i Or 4) 'fixed by JJ RaiseEvent MouseUp(2 ^ ((EMSG.wMsg - 514) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)) Case WM_SYSTEMKEYDOWN s = Hex(EMSG.lParamLow) k = (EMSG.lParamLow And &HFF) If k <> vbKeyMenu Then RaiseEvent SystemKeyDown(k) s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ EMSG.lParamLow = CLng("&h" & s) CopyMemory ByVal lParam, EMSG, Len(EMSG) Case WM_SYSTEMKEYUP s = Hex(EMSG.lParamLow) k = (EMSG.lParamLow And &HFF) If k <> vbKeyMenu Then RaiseEvent SystemKeyUp(k) s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ EMSG.lParamLow = CLng("&h" & s) CopyMemory ByVal lParam, EMSG, Len(EMSG) Case Else End Select End Function

四、千万别望了保存(否则你要后悔的),编译生成DLL,然后可以测试了,做一个普通的工程,添加引用SysHook,在窗体中添加测试代码(嘿嘿,可能你会吃点苦头):

Option Explicit Dim WithEvents sh As cSystemHook

Private Sub Form_Load() Set sh = New cSystemHook sh.SetHook End Sub

Private Sub Form_Unload(Cancel As Integer) sh.RemoveHook Set sh = Nothing End Sub

Private Sub sh_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = 1 Then MsgBox "你按了左键" End If If Button = 2 Then MsgBox "你按了右键" End If End Sub

五、接着你可以试试全局的下列事件(记住刚才的教训,可要小心哦):

Private Sub sh_KeyDown(KeyCode As Integer, Shift As Integer)

End Sub

Private Sub sh_KeyUp(KeyCode As Integer, Shift As Integer)

End Sub

MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

End Sub

Private Sub sh_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

End Sub

Private Sub sh_SystemKeyDown(KeyCode As Integer)

End Sub

Private Sub sh_SystemKeyUp(KeyCode As Integer)

End Sub

搜索更多相关主题的帖子: HOOK 鼠标 源码 DLL 全局 
2004-11-10 10:03
griefforyou
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:3336
专家分:0
注 册:2004-4-15
收藏
得分:0 

上面的测试例子有没有吃苦头?就是:

四、千万别望了保存(否则你要后悔的),编译生成DLL,然后可以测试了,做一个普通的工程,添加引用SysHook,在窗体中添加测试代码(嘿嘿,可能你会吃点苦头):

Option Explicit Dim WithEvents sh As cSystemHook

Private Sub Form_Load() Set sh = New cSystemHook sh.SetHook End Sub

Private Sub Form_Unload(Cancel As Integer) sh.RemoveHook Set sh = Nothing End Sub

Private Sub sh_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = 1 Then MsgBox "你按了左键" End If If Button = 2 Then MsgBox "你按了右键" End If End Sub

正确的写法可以该成

Option Explicit

Dim WithEvents sh As cSystemHook

Private Sub Form_Load() Set sh = CreateObject("syshook.cSystemHook") sh.SetHook End Sub

Private Sub Form_Unload(Cancel As Integer) sh.RemoveHook Set sh = Nothing End Sub

Private Sub sh_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = 1 Then Text1 = "你按了左键,在坐标:X=" & x & " Y=" & y End If If Button = 2 Then Text1 = "你按了右键,在坐标:X=" & x & " Y=" & y End If End Sub


天津网站建设 http://www./
2004-11-10 10:07
griefforyou
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:3336
专家分:0
注 册:2004-4-15
收藏
得分:0 

改正了原来:停止Hook方法RemoveHook执行后,不能重新Hook(即再SetHook方法不再HOOK了),同时增加了一个只读属性HookState,当当前是SetHook状态则HookState为True,否则为False。修改的内容只涉及类模块部分,所以把类模块部分修改后的代码贴在以下:

三、把工程自动建立的Class1类模块改名为cSystemHook,添加代码如下:

Option Explicit Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Public Event KeyDown(KeyCode As Integer, Shift As Integer) Public Event KeyUp(KeyCode As Integer, Shift As Integer) Public Event SystemKeyDown(KeyCode As Integer) Public Event SystemKeyUp(KeyCode As Integer)

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey As Long)

Private Const WM_KEYDOWN = &H100 Private Const WM_KEYUP = &H101 Private Const WM_MOUSEMOVE = &H200 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_RBUTTONDOWN = &H204 Private Const WM_RBUTTONUP = &H205 Private Const WM_RBUTTONDBLCLK = &H206 Private Const WM_MBUTTONDOWN = &H207 Private Const WM_MBUTTONUP = &H208 Private Const WM_MBUTTONDBLCLK = &H209 Private Const WM_MOUSEWHEEL = &H20A Private Const WM_SYSTEMKEYDOWN = &H104 Private Const WM_SYSTEMKEYUP = &H105

Private Const WH_JOURNALRECORD = 0 Private Const WH_GETMESSAGE = 3

Private Type EVENTMSG wMsg As Long lParamLow As Long lParamHigh As Long msgTime As Long hWndMsg As Long End Type

Dim EMSG As EVENTMSG

Public Function SetHook() As Boolean If hJournalHook = 0 Then hJournalHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JournalRecordProc, App.hInstance, 0) If hAppHook = 0 Then hAppHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf AppHookProc, App.hInstance, App.ThreadID) SetHook = True End Function

Public Sub RemoveHook() UnhookWindowsHookEx hAppHook UnhookWindowsHookEx hJournalHook hAppHook = 0 hJournalHook = 0 End Sub

Private Sub Class_Initialize() SHptr = ObjPtr(Me) End Sub

Private Sub Class_Terminate() If hJournalHook Or hAppHook Then RemoveHook End Sub

Friend Function FireEvent(ByVal lParam As Long) Dim i%, j%, k% Dim s As String If lParam = WM_CANCELJOURNAL Then hJournalHook = 0 SetHook Exit Function End If CopyMemory EMSG, ByVal lParam, Len(EMSG) Select Case EMSG.wMsg Case WM_KEYDOWN j = 0 If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4) 'fixed by JJ s = Hex(EMSG.lParamLow) k = (EMSG.lParamLow And &HFF) RaiseEvent KeyDown(k, j) s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ EMSG.lParamLow = CLng("&h" & s) CopyMemory ByVal lParam, EMSG, Len(EMSG) Case WM_KEYUP j = 0 'fixed by JJ If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4) 'fixed by JJ s = Hex(EMSG.lParamLow) k = (EMSG.lParamLow And &HFF) RaiseEvent KeyUp(k, j) s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ EMSG.lParamLow = CLng("&h" & s) CopyMemory ByVal lParam, EMSG, Len(EMSG) Case WM_MOUSEMOVE i = 0 'fixed by JJ If GetAsyncKeyState(vbKeyLButton) Then i = (i Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyRButton) Then i = (i Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMButton) Then i = (i Or 4) 'fixed by JJ j = 0 'fixed by JJ If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4) 'fixed by JJ RaiseEvent MouseMove(i, j, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)) Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN i = 0 'fixed by JJ If GetAsyncKeyState(vbKeyShift) Then i = (i Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then i = (i Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then i = (i Or 4) 'fixed by JJ RaiseEvent MouseDown(2 ^ ((EMSG.wMsg - 513) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)) Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP i = 0 'fixed by JJ If GetAsyncKeyState(vbKeyShift) Then i = (i Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then i = (i Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then i = (i Or 4) 'fixed by JJ RaiseEvent MouseUp(2 ^ ((EMSG.wMsg - 514) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)) Case WM_SYSTEMKEYDOWN s = Hex(EMSG.lParamLow) k = (EMSG.lParamLow And &HFF) If k <> vbKeyMenu Then RaiseEvent SystemKeyDown(k) s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ EMSG.lParamLow = CLng("&h" & s) CopyMemory ByVal lParam, EMSG, Len(EMSG) Case WM_SYSTEMKEYUP s = Hex(EMSG.lParamLow) k = (EMSG.lParamLow And &HFF) If k <> vbKeyMenu Then RaiseEvent SystemKeyUp(k) s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ EMSG.lParamLow = CLng("&h" & s) CopyMemory ByVal lParam, EMSG, Len(EMSG) Case Else End Select End Function

Public Property Get HookState() As Boolean If hAppHook = 0 Then HookState = False Else HookState = True End If End Property


天津网站建设 http://www./
2004-11-10 10:09
gfengfu
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2006-2-16
收藏
得分:0 

问个问题,我按照搂主说的做了。
可是如果打开这个程序就没办法打字了

2006-02-16 14:30
kfp_kaka
Rank: 4
等 级:贵宾
威 望:13
帖 子:353
专家分:0
注 册:2006-1-12
收藏
得分:0 
强,看不懂那些代码

爱一个人不一定要拥有她 拥有一个人就一定要好好的爱她
2006-02-16 14:47
辉少
Rank: 1
等 级:新手上路
威 望:2
帖 子:147
专家分:7
注 册:2005-8-25
收藏
得分:0 
也支持一下,希望版主多些发文章啊

辉少QQ:469781880 博客:http:///bbs/boke.asp?25189.index.html
2006-02-18 21:31
VB爱上我
Rank: 6Rank: 6
等 级:贵宾
威 望:25
帖 子:478
专家分:52
注 册:2005-10-14
收藏
得分:0 
呵呵,大开眼界呀.

IT618资讯网 提供服务端开发,前端开发,网页特效,热门开源系统研究,软件下载,站长建站,淘宝开店等学习资料.
2006-02-20 17:25
清洁工
Rank: 1
等 级:新手上路
帖 子:21
专家分:0
注 册:2005-4-12
收藏
得分:0 
2004-11-10 10:09:00 发的帖 2006-2-16 14:30:00 才第一次有人顶

版主一再追问大家测试例子有没有吃苦头?

试过的能不能说一下是什么苦头?


2006-02-21 15:30
辉少
Rank: 1
等 级:新手上路
威 望:2
帖 子:147
专家分:7
注 册:2005-8-25
收藏
得分:0 
不能停止应用程序挂,除了用ctrl+break

辉少QQ:469781880 博客:http:///bbs/boke.asp?25189.index.html
2006-02-21 22:18
BetDeity
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2006-4-21
收藏
得分:0 
我发现有些网站的密码输入框应用的时候就不起作用了,为什么了,可以截取到用户名,但是密码处就没有反应了,为什么这样的?
2006-04-21 16:31
快速回复:一个全局键盘、鼠标HOOK的DLL源码
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.017760 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved