请教VB 如何实现按键精灵的功能?

鼠标可以使用mouse_event 的API函数完成(声明如下)

Declare Sub mouse_event Lib "user32" Alias "mouse_event" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

键盘操作用Sendkeys "{(功能键)}"、Sendkeys "文字" 完成，转移焦点可以用AppActivate完成。

例如：按下Command1,打开记事本，在记事本中输入一段字符：

Private Sub Command1_Click()

Shell "notepadexe", vbNormalFocus

AppActivate "无标题 - 记事本"

SendKeys "这是一个示例。"

End Sub

只要

我从来没有认为这将是永远，

我从来不知道，我们必须通过，一个人去，

害怕，是不是这样，

我们属于一起，

在我看来，前面一个小的黑色

我必须，其他人，这么多年，

我看不到的悲剧，在存储对我来说，

不要害怕，站起来，说：

我们共同的，

在我看来，一个小步骤，未来

这么长时间，我一直在等待这一刻，

等待你的爱，

这么长时间，我已经在这里等候过境，

等待挂

只要

我曾经的梦想，我们可以一起，

有趣的场景，在aedy，共同主演我，

不要害怕，站起来说，

我们共同强烈，

在我看来，有点清淡

这么长时间，我一直在等待这一刻，

等待你的爱，

这么长时间，我已经在这里等候过境，

等待挂

只要

等待你的爱，

这么长时间，我已经在这里等候过境，

等待挂

只要

只要

复制代码就可以了

'WebBrowser1,Command1,Command2

Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long

Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Const MOUSEEVENTF_LEFTDOWN = &H2

Const MOUSEEVENTF_LEFTUP = &H4

Const MOUSEEVENTF_MIDDLEDOWN = &H20

Const MOUSEEVENTF_MIDDLEUP = &H40

Const MOUSEEVENTF_MOVE = &H1

Const MOUSEEVENTF_ABSOLUTE = &H8000

Const MOUSEEVENTF_RIGHTDOWN = &H8

Const MOUSEEVENTF_RIGHTUP = &H10

Private Type POINTAPI

x As Long

y As Long

End Type

不用那么啰嗦。

○在窗体中输入以下代码：

Private Sub Command1_Click()

lHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, ApphInstance, 0)

End Sub

Private Sub Command2_Click()

UnhookWindowsHookEx lHook

End Sub

○新建一个模块，输入以下代码：

Option Explicit

Public 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

Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)

Public Type MOUSEMSGS

X As Long 'x座标

Y As Long 'y座标

a As Long

b As Long

time As Long 'Window运行时间

End Type

Public Type POINTAPI

X As Long

Y As Long

End Type

Public Const WH_MOUSE_LL = 14

Public Const HC_ACTION = 0

'鼠标消息

Public Const WM_LBUTTONDOWN = &H201

Public Const WM_LBUTTONUP = &H202

Public Const WM_RBUTTONDOWN = &H204

Public Const WM_RBUTTONUP = &H205

Public MouseMsg As MOUSEMSGS

Public lHook As Long

'----------------------------------------

'模拟鼠标

Private Const MOUSEEVENTF_LEFTDOWN = &H2

Private Const MOUSEEVENTF_LEFTUP = &H4

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

'鼠标钩子

Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim pt As POINTAPI

If code = HC_ACTION Then

CopyMemory MouseMsg, lParam, LenB(MouseMsg)

If wParam = WM_RBUTTONDOWN Then '把中键改为左键

mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0

CallMouseHookProc = 1

End If

If wParam = WM_RBUTTONUP Then

mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

CallMouseHookProc = 1

End If

End If

If code <> 0 Then

CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam)

End If

End Function

曲名：Journey 歌手：张韶涵 专辑：Over The Rainbow

It\'s a long long journey

Till I know whera I\'m supposed to be

It\'s a long long journey

And I don\'t know if I can believe

When shadows fall and block my eyes

I am lost and know that I must hide

It\'s a long long journey

Till I find my way home to you

Many days I\'ve spent

Drifting on through empty shores

Wondering what\'s my purpose

Wondering how to make me strong

I know I will falter I know I will cry

I know you\'ll be standing by my side

It\'s a long long journey

And I need to be close to you

Sometimes it feels no one understands

I don\'t even know why

I do the things I do

When pride builds me up till I can\'t see my soul

Will you break down these walls and pull me through

Cause It\'s a long long journey

Till I feel that I am worth the price

You paid for me on calvary

Beneath those stormy skies

When Satan mocks and friends turn to foes

It feel like everything is out to make me lose control

It\'s a long long journey

Till I find my way home to youto you

是这个吗？是的话给我加加！！！

在屏幕下点击的话可以用鼠标全局键盘钩子。参考代码如下：

首先用建立一个标准Exe程序'把窗体名称，设定为frmMain'在窗体上建立一组文本框数组，名称为txtMsg'txtMsg(0) -- 显示鼠标左键按下的次数'txtMsg(1) -- 显示鼠标中键按下的次数'txtMsg(2) -- 显示鼠标右键按下的次数'txtMsg(3) -- 显示鼠标按下的总次数 '然后建立一个Module,并输入以下代码 Public 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

Public Declare Function UnhookWindowsHookEx Lib "user32"(ByVal hHook As Long) As LongPublic Declare Function CallNextHookEx Lib "user32"(ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)Public Type MOUSEMSGS

X As Long 'x座标

Y As Long 'y座标

a As Long

b As Long

time As Long 'Window运行时间

End Type Public Const WH_MOUSE_LL = 14'-----------------------------------------

'消息

Public Const HC_ACTION = 0'鼠标消息

Public Const WM_MOUSEMOVE = &H200

Public Const WM_LBUTTONDOWN = &H201

Public Const WM_LBUTTONUP = &H202

Public Const WM_LBUTTONDBLCLK = &H203

Public Const WM_RBUTTONDOWN = &H204

Public Const WM_RBUTTONUP = &H205

Public Const WM_RBUTTONDBLCLK = &H206

Public Const WM_MBUTTONDOWN = &H207

Public Const WM_MBUTTONUP = &H208

Public Const WM_MBUTTONDBLCLK = &H209

Public Const WM_MOUSEACTIVATE = &H21

Public Const WM_MOUSEFIRST = &H200

Public Const WM_MOUSELAST = &H209

Public Const WM_MOUSEWHEEL = &H20APublic MouseMsg As MOUSEMSGS

Public lHook As Long '记录Hook的值，以便退出程序的时候销毁Hook

Public lClick As Long, mClick As Long, rClick As Long, tClick As Long '用来统计鼠标各个键的按下次数

'鼠标钩子

Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long)As Long If code = HC_ACTION Then

CopyMemory MouseMsg, lParam, LenB(MouseMsg) frmMainCaption = "X=" + Str(MouseMsgX) + " Y=" + Str(MouseMsgY)'在主窗口上显示鼠标的当前位置 Select Case wParam'根据不同鼠标动作进行处理，在这里只处理了鼠标按下的动作

Case WM_LBUTTONDOWN'左键按下

lClick = lClick + 1 '进行统计，并显示在住窗体的文本框上

tClick = tClick + 1

frmMaintxtMsg(0)Text = lClick

frmMaintxtMsg(3)Text = tClick

CallMouseHookProc = 0'这里把返回值设定为0，保证鼠标动作正常完成

Case WM_MBUTTONDOWN '中键按下

mClick = mClick + 1

tClick = tClick + 1

frmMaintxtMsg(1)Text = mClick

frmMaintxtMsg(3)Text = tClick

CallMouseHookProc = 0

Case WM_RBUTTONDOWN '右键按下

rClick = rClick + 1

tClick = tClick + 1

frmMaintxtMsg(2)Text = rClick

frmMaintxtMsg(3)Text = tClick

CallMouseHookProc = 0

End Select

End IfIf code <> 0 Then

CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam)'使用CallNextHookEx，来保证鼠标钩子能够被其它程序使用

End If

End Function '接下来，我们再给窗体里面添加代码 Private Sub AddHook() '安装鼠标钩子

lHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, ApphInstance, 0)

End Sub

Private Sub DelHook()'卸除鼠标钩子 UnhookWindowsHookEx lHook

End SubPrivate Sub Form_Load() '窗体载入的时候，安装鼠标钩子

AddHook

End SubPrivate Sub Form_Unload(Cancel As Integer)'窗体卸载的时候，卸除鼠标钩子

DelHook

End Sub

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long

Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down

Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up

Dim key1 As Integer

Dim key2 As Integer

Dim bolStage As Boolean

Dim lngTimer As Long

Private Sub Form_Load()

Timer1Interval = 10

Timer1Enabled = True

'MeVisible = False

key1 = GetKeyState(vbKeyF11)

key2 = GetKeyState(vbKeyF12)

lngTimer = GetTickCount

End Sub

Private Sub Timer1_Timer()

If GetKeyState(vbKeyF11) <> key1 Then key1 = GetKeyState(vbKeyF11): bolStage = True: Beep

If GetKeyState(vbKeyF12) <> key2 Then key2 = GetKeyState(vbKeyF12): bolStage = False: Beep

If bolStage And (GetTickCount - lngTimer) >= 1000 Then

lngTimer = GetTickCount

SendKeys ","

'SetCursorPos 288, 718 '设置鼠标位置(1024X768)

mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 '单击时用左按键下or左按键上，双击时写两句

End If

End Sub