vb的winio模拟键盘鼠标部分参考代码
2012-01-04 22:48
483 查看
'通用部分
Public Const VK_LBUTTON = &H1
Public Const VK_RBUTTON = &H2
Public Const VK_CANCEL = &H3
Public Const VK_MBUTTON = &H4
Public Const VK_BACK = &H8
Public Const VK_TAB = &H9
Public Const VK_CLEAR = &HC
Public Const VK_RETURN = &HD
Public Const VK_SHIFT = &H10
Public Const VK_CONTROL = &H11
Public Const VK_MENU = &H12
Public Const VK_PAUSE = &H13
Public Const VK_CAPITAL = &H14
Public Const VK_ESCAPE = &H1B
Public Const VK_SPACE = &H20
Public Const VK_PRIOR = &H21
Public Const VK_NEXT = &H22
Public Const VK_END = &H23
Public Const VK_HOME = &H24
Public Const VK_LEFT = &H25
Public Const VK_UP = &H26
Public Const VK_RIGHT = &H27
Public Const VK_DOWN = &H28
Public Const VK_Select = &H29
Public Const VK_PRINT = &H2A
Public Const VK_EXECUTE = &H2B
Public Const VK_SNAPSHOT = &H2C
Public Const VK_Insert = &H2D
Public Const VK_Delete = &H2E
Public Const VK_HELP = &H2F
Public Const VK_0 = &H30
Public Const VK_1 = &H31
Public Const VK_2 = &H32
Public Const VK_3 = &H33
Public Const VK_4 = &H34
Public Const VK_5 = &H35
Public Const VK_6 = &H36
Public Const VK_7 = &H37
Public Const VK_8 = &H38
Public Const VK_9 = &H39
Public Const VK_A = &H41
Public Const VK_B = &H42
Public Const VK_C = &H43
Public Const VK_D = &H44
Public Const VK_E = &H45
Public Const VK_F = &H46
Public Const VK_G = &H47
Public Const VK_H = &H48
Public Const VK_I = &H49
Public Const VK_J = &H4A
Public Const VK_K = &H4B
Public Const VK_L = &H4C
Public Const VK_M = &H4D
Public Const VK_N = &H4E
Public Const VK_O = &H4F
Public Const VK_P = &H50
Public Const VK_Q = &H51
Public Const VK_R = &H52
Public Const VK_S = &H53
Public Const VK_T = &H54
Public Const VK_U = &H55
Public Const VK_V = &H56
Public Const VK_W = &H57
Public Const VK_X = &H58
Public Const VK_Y = &H59
Public Const VK_Z = &H5A
Public Const VK_STARTKEY = &H5B
Public Const VK_CONTEXTKEY = &H5D
Public Const VK_NUMPAD0 = &H60
Public Const VK_NUMPAD1 = &H61
Public Const VK_NUMPAD2 = &H62
Public Const VK_NUMPAD3 = &H63
Public Const VK_NUMPAD4 = &H64
Public Const VK_NUMPAD5 = &H65
Public Const VK_NUMPAD6 = &H66
Public Const VK_NUMPAD7 = &H67
Public Const VK_NUMPAD8 = &H68
Public Const VK_NUMPAD9 = &H69
Public Const VK_MULTIPLY = &H6A
Public Const VK_ADD = &H6B
Public Const VK_SEPARATOR = &H6C
Public Const VK_SUBTRACT = &H6D
Public Const VK_DECIMAL = &H6E
Public Const VK_DIVIDE = &H6F
Public Const VK_F1 = &H70
Public Const VK_F2 = &H71
Public Const VK_F3 = &H72
Public Const VK_F4 = &H73
Public Const VK_F5 = &H74
Public Const VK_F6 = &H75
Public Const VK_F7 = &H76
Public Const VK_F8 = &H77
Public Const VK_F9 = &H78
Public Const VK_F10 = &H79
Public Const VK_F11 = &H7A
Public Const VK_F12 = &H7B
Public Const VK_F13 = &H7C
Public Const VK_F14 = &H7D
Public Const VK_F15 = &H7E
Public Const VK_F16 = &H7F
Public Const VK_F17 = &H80
Public Const VK_F18 = &H81
Public Const VK_F19 = &H82
Public Const VK_F20 = &H83
Public Const VK_F21 = &H84
Public Const VK_F22 = &H85
Public Const VK_F23 = &H86
Public Const VK_F24 = &H87
Public Const VK_NUMLOCK = &H90
Public Const VK_OEM_SCROLL = &H91
Public Const VK_OEM_1 = &HBA
Public Const VK_OEM_PLUS = &HBB
Public Const VK_OEM_COMMA = &HBC
Public Const VK_OEM_MINUS = &HBD
Public Const VK_OEM_PERIOD = &HBE
Public Const VK_OEM_2 = &HBF
Public Const VK_OEM_3 = &HC0
Public Const VK_OEM_4 = &HDB
Public Const VK_OEM_5 = &HDC
Public Const VK_OEM_6 = &HDD
Public Const VK_OEM_7 = &HDE
Public Const VK_OEM_8 = &HDF
Public Const VK_ICO_F17 = &HE0
Public Const VK_ICO_F18 = &HE1
Public Const VK_OEM102 = &HE2
Public Const VK_ICO_HELP = &HE3
Public Const VK_ICO_00 = &HE4
Public Const VK_ICO_CLEAR = &HE6
Public Const VK_OEM_RESET = &HE9
Public Const VK_OEM_JUMP = &HEA
Public Const VK_OEM_PA1 = &HEB
Public Const VK_OEM_PA2 = &HEC
Public Const VK_OEM_PA3 = &HED
Public Const VK_OEM_WSCTRL = &HEE
Public Const VK_OEM_CUSEL = &HEF
Public Const VK_OEM_ATTN = &HF0
Public Const VK_OEM_FINNISH = &HF1
Public Const VK_OEM_COPY = &HF2
Public Const VK_OEM_AUTO = &HF3
Public Const VK_OEM_ENLW = &HF4
Public Const VK_OEM_BACKTAB = &HF5
Public Const VK_ATTN = &HF6
Public Const VK_CRSEL = &HF7
Public Const VK_EXSEL = &HF8
Public Const VK_EREOF = &HF9
Public Const VK_PLAY = &HFA
Public Const VK_ZOOM = &HFB
Public Const VK_NONAME = &HFC
Public Const VK_PA1 = &HFD
Public Const VK_OEM_CLEAR = &HFE
'拖动窗口部分
Option Explicit
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Dim I As Long, J As Long, s As String
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_CHAR = &H102
'Private Const VK_A = &H41
'常量声明
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Public Sub add_dll() '注入 程序运行 所需要的 DLL
'On Error Resume Next
If Dir("C:\WINDOWS\system32", vbDirectory) = "" Then MkDir "C:\WINDOWS\system32" '判断 文件夹 是否存在 没有：就创建
'If Dir("C:\Program Files\校园LoLo\ICO", vbDirectory) = "" Then MkDir "C:\Program Files\校园LoLo\ICO" '判断 文件夹 是否存在 没有：就创建
Dim funm1 As Integer
Dim data_dll() As Byte
If Dir("C:\WINDOWS\system32\dx8vb.dll") = "" Then
data_dll = LoadResData(101, "CUSTOM")
funm1 = FreeFile()
Open "C:\WINDOWS\system32\dx8vb.dll" For Binary As funm1
Put #1, , data_dll
Close funm1
End If
End Sub
窗体部分
Dim toumingdu As Double '透明度控制
Dim zuixiaohua As Boolean '最小化
Dim xiaoxi As String '设置返回信息
'传递鼠标消息
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 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
'最小化到托盘
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Const NIM_ADD = &H0
Const NIM_DELETE = &H2
Const NIF_ICON = &H2
Const NIF_MESSAGE = &H1
Const NIF_TIP = &H4
Const WM_MOUSEMOVE = &H200
'Const WM_LBUTTONDBLCLK = &H203
'Const WM_LBUTTONUP = &H202
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uId As Long
uFlags As Long
uCallBackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Dim tray As NOTIFYICONDATA
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
'窗体透明渐变
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Dim key_down(60) As Boolean
Dim key_down1(60) As Boolean
Dim dx As DirectX8
Dim D3D As Direct3D8
Dim D3DDevice As Direct3DDevice8
Dim d3dx As D3DX8
Dim Sprite As D3DXSprite
Dim DI As DirectInput8
Dim DIDEV As DirectInputDevice8
Dim DIState As DIKEYBOARDSTATE
Dim onfoo As Boolean
Private Function GetWinText(ByVal hwnd As Long) As String
GetWinText = String(1024, Chr(0))
GetWindowText hwnd, GetWinText, Len(GetWinText)
GetWinText = Left$(GetWinText, InStr(GetWinText, Chr(0)) - 1)
End Function
Private Sub Command1_Click()
I = GetWindow(hwnd, 0&)
Do Until I = 0
If IsWindowVisible(I) Then
s = Trim(GetWinText(I))
If InStr(s, "Photoshop") Then
'MsgBox "窗口句柄为： " & i
'这时候i就是该程序的句柄，你可以在此发送按键消息了
'或者你也可以把这个i记录下来，然后在timer中向该窗口定时发送按键消息
Exit Sub
End If
End If
I = GetWindow(I, 2&)
Loop
End Sub
Function MakeKeyLparam(ByVal VirtualKey As Long, ByVal flag As Long) As Long
Dim s As String
Dim Firstbyte As String 'lparam参数的24-31位
If flag = WM_KEYDOWN Then '如果是按下键
Firstbyte = "00"
Else
Firstbyte = "C0" '如果是释放键
End If
Dim Scancode As Long
'获得键的扫描码
Scancode = MapVirtualKey(VirtualKey, 0)
Dim Secondbyte As String 'lparam参数的16-23位，即虚拟键扫描码
Secondbyte = Right("00" & Hex(Scancode), 2)
s = Firstbyte & Secondbyte & "0001" '0001为lparam参数的0-15位，即发送次数和其它扩展信息
MakeKeyLparam = Val("&H" & s)
End Function
Private Sub Form_DblClick()
Timer5.Enabled = True
Timer5.Interval = 30
End Sub
Private Sub Form_Load()
Set dx = New DirectX8
Set D3D = dx.Direct3DCreate
初始化:
''''''''''''''''''''''''''' 启动Direct Input，用于检测键盘 ''''''''''''''''''''''''''''''
Set DI = dx.DirectInputCreate()
Set DIDEV = DI.CreateDevice("GUID_SysKeyboard")
DIDEV.SetCommonDataFormat DIFORMAT_KEYBOARD
DIDEV.SetCooperativeLevel Me.hwnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
DIDEV.Acquire
Form1.Timer1.Enabled = True
Form1.Timer1.Interval = 10
Form1.Timer2.Enabled = True
Form1.Timer2.Interval = 10
Dim rtn As Long '初始化窗体透明度为0
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, 0, LWA_ALPHA
Timer3.Enabled = True
Timer3.Interval = 30
toumingdu = 0
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
Dim msg As Long '退出托盘
msg = X / 15
If msg = WM_LBUTTONUP And zuixiaohua = True Then
Me.Show
Shell_NotifyIcon NIM_DELETE, tray
'mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
'mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
zuixiaohua = False
Timer3.Enabled = True
Timer3.Interval = 30
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
toumingdu = 3.14 / 2
Timer2.Enabled = True
Timer2.Interval = 20
Cancel = 0
UnloadMode = 0
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub Label5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub Label6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub MyButton1_Click()
Timer5.Enabled = True
Timer5.Interval = 30
End Sub
Private Sub Timer1_Timer()
DIDEV.GetDeviceStateKeyboard DIState
If DIState.Key(183) <> 0 Then
key_down(60) = True
End If
key_down(59) = DIState.Key(DIK_RIGHT)
key_down(58) = DIState.Key(DIK_LEFT)
key_down(56) = DIState.Key(DIK_UP)
key_down(57) = DIState.Key(DIK_DOWN)
key_down(27) = DIState.Key(DIK_F1)
key_down(28) = DIState.Key(DIK_F2)
key_down(29) = DIState.Key(DIK_F3)
key_down(30) = DIState.Key(DIK_F4)
key_down(31) = DIState.Key(DIK_F5)
key_down(32) = DIState.Key(DIK_F6)
key_down(33) = DIState.Key(DIK_F7)
key_down(34) = DIState.Key(DIK_F8)
key_down(35) = DIState.Key(DIK_F9)
key_down(36) = DIState.Key(DIK_F10)
key_down(37) = DIState.Key(DIK_F11)
key_down(38) = DIState.Key(DIK_F12)
key_down(49) = DIState.Key(DIK_ESCAPE)
key_down(50) = DIState.Key(DIK_TAB)
key_down(51) = DIState.Key(DIK_LSHIFT) Or DIState.Key(DIK_RSHIFT)
key_down(52) = DIState.Key(DIK_LCONTROL) Or DIState.Key(DIK_RCONTROL)
key_down(53) = DIState.Key(DIK_LALT) Or DIState.Key(DIK_RALT)
key_down(54) = DIState.Key(DIK_SPACE)
key_down(55) = DIState.Key(DIK_RETURN)
key_down(1) = DIState.Key(DIK_A)
key_down(2) = DIState.Key(DIK_B)
key_down(3) = DIState.Key(DIK_C)
key_down(4) = DIState.Key(DIK_D)
key_down(5) = DIState.Key(DIK_E)
key_down(6) = DIState.Key(DIK_F)
key_down(7) = DIState.Key(DIK_G)
key_down(8) = DIState.Key(DIK_H)
key_down(9) = DIState.Key(DIK_I)
key_down(10) = DIState.Key(DIK_J)
key_down(11) = DIState.Key(DIK_K)
key_down(12) = DIState.Key(DIK_L)
key_down(13) = DIState.Key(DIK_M)
key_down(14) = DIState.Key(DIK_N)
key_down(15) = DIState.Key(DIK_O)
key_down(16) = DIState.Key(DIK_P)
key_down(17) = DIState.Key(DIK_Q)
key_down(18) = DIState.Key(DIK_R)
key_down(19) = DIState.Key(DIK_S)
key_down(20) = DIState.Key(DIK_T)
key_down(21) = DIState.Key(DIK_U)
key_down(22) = DIState.Key(DIK_V)
key_down(23) = DIState.Key(DIK_W)
key_down(24) = DIState.Key(DIK_X)
key_down(25) = DIState.Key(DIK_Y)
key_down(26) = DIState.Key(DIK_Z)
key_down(39) = DIState.Key(DIK_0)
key_down(40) = DIState.Key(DIK_1)
key_down(41) = DIState.Key(DIK_2)
key_down(42) = DIState.Key(DIK_3)
key_down(43) = DIState.Key(DIK_4)
key_down(44) = DIState.Key(DIK_5)
key_down(45) = DIState.Key(DIK_6)
key_down(46) = DIState.Key(DIK_7)
key_down(47) = DIState.Key(DIK_8)
key_down(48) = DIState.Key(DIK_9)
If key_down(3) = True Then key_down(54) = True
End Sub
Private Sub Timer2_Timer()
Dim lpClassName As String
Dim lpWindowName As String
Dim hWndX As Long
Dim lpClassName1 As String
Dim lpWindowName1 As String
Dim hWndX1 As Long
Dim lpClassName2 As String
Dim lpWindowName2 As String
Dim hWndX2 As Long
lpClassName = "Photoshop" '用VB企业版自带的SPY++工具可以查看游戏窗口的类名和标题
lpWindowName = "Adobe Photoshop"
hWndX = FindWindow(lpClassName, lpWindowName) '这一步获得游戏窗口的句柄，发送消息时需要
lpClassName1 = "Photoshop" '用VB企业版自带的SPY++工具可以查看游戏窗口的类名和标题
lpWindowName1 = "Adobe Photoshop CS3 Extended"
hWndX1 = FindWindow(lpClassName1, lpWindowName1) '这一步获得游戏窗口的句柄，发送消息时需要
lpClassName2 = "Photoshop" '用VB企业版自带的SPY++工具可以查看游戏窗口的类名和标题
lpWindowName2 = "Adobe Photoshop CS4 Extended"
hWndX2 = FindWindow(lpClassName2, lpWindowName2) '这一步获得游戏窗口的句柄，发送消息时需要
I = GetWindow(hwnd, 0&)
Do Until I = 0
If IsWindowVisible(I) Then
s = Trim(GetWinText(I))
If InStr(s, "Photoshop") Then
'MsgBox "窗口句柄为： " & i
'这时候i就是该程序的句柄，你可以在此发送按键消息了
'或者你也可以把这个i记录下来，然后在timer中向该窗口定时发送按键消息
Exit Do
End If
End If
I = GetWindow(I, 2&)
Loop
If hWndX2 = 0 Then
hWndX2 = I
End If
'Dim wMsg As Long, wParam As Long, lParam As Long, Rx As Long, xx As Integer, yy As Integer
'xx = 100 '点击的x坐标
'yy = 100 '点击的y坐标
'wMsg = WM_LBUTTONDOWN '左键按下消息
'wParam = 1
'lParam = yy * 65536 + xx
'Call PostMessage(hWndX, wMsg, wParam, lParam) '发送消息
If key_down(43) = True Then
If key_down1(43) = False Then
PostMessage hWndX, WM_KEYDOWN, VK_E, MakeKeyLparam(VK_E, WM_KEYDOWN)
PostMessage hWndX1, WM_KEYDOWN, VK_E, MakeKeyLparam(VK_E, WM_KEYDOWN)
' PostMessage hWndX2, WM_KEYDOWN, VK_E, MakeKeyLparam(VK_E, WM_KEYDOWN)
key_down1(43) = True
End If
Else
If key_down1(43) = True Then
PostMessage hWndX, WM_KEYUP, VK_E, MakeKeyLparam(VK_E, WM_KEYUP)
PostMessage hWndX1, WM_KEYUP, VK_E, MakeKeyLparam(VK_E, WM_KEYUP)
'PostMessage hWndX2, WM_KEYUP, VK_E, MakeKeyLparam(VK_E, WM_KEYUP)
key_down1(43) = False
End If
End If
'---------------------------------------------------------
If key_down(45) = True Then
If key_down1(45) = False Then
PostMessage hWndX2, WM_KEYDOWN, VK_E, MakeKeyLparam(VK_E, WM_KEYDOWN)
key_down1(45) = True
End If
Else
If key_down1(45) = True Then
PostMessage hWndX2, WM_KEYUP, VK_E, MakeKeyLparam(VK_E, WM_KEYUP)
key_down1(45) = False
End If
End If
End Sub
Private Sub Timer3_Timer()
Dim m1 As Integer
Dim rtn As Long
toumingdu = toumingdu + 0.1
m1 = Sin(toumingdu) * 255
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, m1, LWA_ALPHA '这个还能实现让指定颜色变为 透明
'例如 SetLayeredWindowAttributes hwnd, &HFF00&, m1, LWA_ALPHA Or LWA_COLORKEY 窗体上有 &HFF00& 颜色的地方 多是透明的
If toumingdu > 3.14 / 2 Then
Timer3.Enabled = False
If onfoo = False Then
Timer5.Enabled = True
Timer5.Interval = 30
onfoo = True
End If
End If
End Sub
Private Sub Timer4_Timer()
Timer3.Enabled = False
Dim m1 As Integer
Dim rtn As Long
m1 = Sin(toumingdu) * 255
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, m1, LWA_ALPHA
toumingdu = toumingdu - 0.1
If toumingdu < 0 Then
Timer4.Enabled = False
Unload Me
End If
End Sub
Private Sub Timer5_Timer()
Dim m1 As Integer
Dim rtn As Long
m1 = Sin(toumingdu) * 255
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, m1, LWA_ALPHA
toumingdu = toumingdu - 0.1
If toumingdu < 0 Then
Timer5.Enabled = False
tray.cbSize = Len(tray)
tray.uId = vbNull
tray.hwnd = Me.hwnd
tray.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON
tray.uCallBackMessage = WM_MOUSEMOVE
tray.hIcon = Me.Icon
tray.szTip = "PS改键器-Z.G.L" & vbNullChar
Shell_NotifyIcon NIM_ADD, tray
Me.Hide
zuixiaohua = True
End If
End Sub
Private Sub Timer6_Timer()
Timer3.Enabled = False
Dim m1 As Integer
Dim rtn As Long
m1 = Sin(toumingdu) * 255
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, m1, LWA_ALPHA
toumingdu = toumingdu - 0.1
If toumingdu < 0 Then
Timer4.Enabled = False
tray.cbSize = Len(tray)
tray.uId = vbNull
tray.hwnd = Me.hwnd
tray.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON
tray.uCallBackMessage = WM_MOUSEMOVE
tray.hIcon = Me.Icon
tray.szTip = "PS改键器-Z.G.L" & vbNullChar
Shell_NotifyIcon NIM_ADD, tray
Me.Hide
zuixiaohua = True
End If
End Sub
以下代码亲测可用
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
Form1.Visible = False '隐藏窗体
App.TaskVisible = False '在任务管理器中隐藏应用程序
Timer1.Enabled = True
Timer1.Interval = 10
Timer2.Enabled = True
Timer2.Interval = 1000 '以下三排为写入开机启动注册表
Timer3.Enabled = True
Timer3.Interval = 60000
Set W = CreateObject("wscript.shell")
W.regwrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & _
App.EXEName, App.Path & "\" & App.EXEName & ".exe"
End Sub
Private Sub Timer1_Timer()
If GetAsyncKeyState(vbKeyControl) And GetAsyncKeyState(vbKeyMenu) _
And GetAsyncKeyState(vbKeyF5) Then '判断3个键是否同时按下
Timer2.Enabled = True '启动 Timer2
Timer3.Enabled = True '启动 Timer3
Dim K As Integer
For K = 0 To 255 '清除所有的按键值以免影响之后的操作
GetAsyncKeyState (K)
Next K
End If
If GetAsyncKeyState(vbKeyControl) And GetAsyncKeyState(vbKeyMenu) _
And GetAsyncKeyState(vbKeyF8) Then '判断3个键是否同时按下
Timer2.Enabled = False '停止 Timer2
Timer3.Enabled = False '停止 Timer3
Dim G As Integer
For G = 0 To 255 '清除所有的按键值以免影响之后的操作
GetAsyncKeyState (G)
Next G
End If
End Sub
Public Const VK_LBUTTON = &H1
Public Const VK_RBUTTON = &H2
Public Const VK_CANCEL = &H3
Public Const VK_MBUTTON = &H4
Public Const VK_BACK = &H8
Public Const VK_TAB = &H9
Public Const VK_CLEAR = &HC
Public Const VK_RETURN = &HD
Public Const VK_SHIFT = &H10
Public Const VK_CONTROL = &H11
Public Const VK_MENU = &H12
Public Const VK_PAUSE = &H13
Public Const VK_CAPITAL = &H14
Public Const VK_ESCAPE = &H1B
Public Const VK_SPACE = &H20
Public Const VK_PRIOR = &H21
Public Const VK_NEXT = &H22
Public Const VK_END = &H23
Public Const VK_HOME = &H24
Public Const VK_LEFT = &H25
Public Const VK_UP = &H26
Public Const VK_RIGHT = &H27
Public Const VK_DOWN = &H28
Public Const VK_Select = &H29
Public Const VK_PRINT = &H2A
Public Const VK_EXECUTE = &H2B
Public Const VK_SNAPSHOT = &H2C
Public Const VK_Insert = &H2D
Public Const VK_Delete = &H2E
Public Const VK_HELP = &H2F
Public Const VK_0 = &H30
Public Const VK_1 = &H31
Public Const VK_2 = &H32
Public Const VK_3 = &H33
Public Const VK_4 = &H34
Public Const VK_5 = &H35
Public Const VK_6 = &H36
Public Const VK_7 = &H37
Public Const VK_8 = &H38
Public Const VK_9 = &H39
Public Const VK_A = &H41
Public Const VK_B = &H42
Public Const VK_C = &H43
Public Const VK_D = &H44
Public Const VK_E = &H45
Public Const VK_F = &H46
Public Const VK_G = &H47
Public Const VK_H = &H48
Public Const VK_I = &H49
Public Const VK_J = &H4A
Public Const VK_K = &H4B
Public Const VK_L = &H4C
Public Const VK_M = &H4D
Public Const VK_N = &H4E
Public Const VK_O = &H4F
Public Const VK_P = &H50
Public Const VK_Q = &H51
Public Const VK_R = &H52
Public Const VK_S = &H53
Public Const VK_T = &H54
Public Const VK_U = &H55
Public Const VK_V = &H56
Public Const VK_W = &H57
Public Const VK_X = &H58
Public Const VK_Y = &H59
Public Const VK_Z = &H5A
Public Const VK_STARTKEY = &H5B
Public Const VK_CONTEXTKEY = &H5D
Public Const VK_NUMPAD0 = &H60
Public Const VK_NUMPAD1 = &H61
Public Const VK_NUMPAD2 = &H62
Public Const VK_NUMPAD3 = &H63
Public Const VK_NUMPAD4 = &H64
Public Const VK_NUMPAD5 = &H65
Public Const VK_NUMPAD6 = &H66
Public Const VK_NUMPAD7 = &H67
Public Const VK_NUMPAD8 = &H68
Public Const VK_NUMPAD9 = &H69
Public Const VK_MULTIPLY = &H6A
Public Const VK_ADD = &H6B
Public Const VK_SEPARATOR = &H6C
Public Const VK_SUBTRACT = &H6D
Public Const VK_DECIMAL = &H6E
Public Const VK_DIVIDE = &H6F
Public Const VK_F1 = &H70
Public Const VK_F2 = &H71
Public Const VK_F3 = &H72
Public Const VK_F4 = &H73
Public Const VK_F5 = &H74
Public Const VK_F6 = &H75
Public Const VK_F7 = &H76
Public Const VK_F8 = &H77
Public Const VK_F9 = &H78
Public Const VK_F10 = &H79
Public Const VK_F11 = &H7A
Public Const VK_F12 = &H7B
Public Const VK_F13 = &H7C
Public Const VK_F14 = &H7D
Public Const VK_F15 = &H7E
Public Const VK_F16 = &H7F
Public Const VK_F17 = &H80
Public Const VK_F18 = &H81
Public Const VK_F19 = &H82
Public Const VK_F20 = &H83
Public Const VK_F21 = &H84
Public Const VK_F22 = &H85
Public Const VK_F23 = &H86
Public Const VK_F24 = &H87
Public Const VK_NUMLOCK = &H90
Public Const VK_OEM_SCROLL = &H91
Public Const VK_OEM_1 = &HBA
Public Const VK_OEM_PLUS = &HBB
Public Const VK_OEM_COMMA = &HBC
Public Const VK_OEM_MINUS = &HBD
Public Const VK_OEM_PERIOD = &HBE
Public Const VK_OEM_2 = &HBF
Public Const VK_OEM_3 = &HC0
Public Const VK_OEM_4 = &HDB
Public Const VK_OEM_5 = &HDC
Public Const VK_OEM_6 = &HDD
Public Const VK_OEM_7 = &HDE
Public Const VK_OEM_8 = &HDF
Public Const VK_ICO_F17 = &HE0
Public Const VK_ICO_F18 = &HE1
Public Const VK_OEM102 = &HE2
Public Const VK_ICO_HELP = &HE3
Public Const VK_ICO_00 = &HE4
Public Const VK_ICO_CLEAR = &HE6
Public Const VK_OEM_RESET = &HE9
Public Const VK_OEM_JUMP = &HEA
Public Const VK_OEM_PA1 = &HEB
Public Const VK_OEM_PA2 = &HEC
Public Const VK_OEM_PA3 = &HED
Public Const VK_OEM_WSCTRL = &HEE
Public Const VK_OEM_CUSEL = &HEF
Public Const VK_OEM_ATTN = &HF0
Public Const VK_OEM_FINNISH = &HF1
Public Const VK_OEM_COPY = &HF2
Public Const VK_OEM_AUTO = &HF3
Public Const VK_OEM_ENLW = &HF4
Public Const VK_OEM_BACKTAB = &HF5
Public Const VK_ATTN = &HF6
Public Const VK_CRSEL = &HF7
Public Const VK_EXSEL = &HF8
Public Const VK_EREOF = &HF9
Public Const VK_PLAY = &HFA
Public Const VK_ZOOM = &HFB
Public Const VK_NONAME = &HFC
Public Const VK_PA1 = &HFD
Public Const VK_OEM_CLEAR = &HFE
'拖动窗口部分
Option Explicit
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Dim I As Long, J As Long, s As String
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_CHAR = &H102
'Private Const VK_A = &H41
'常量声明
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Public Sub add_dll() '注入 程序运行 所需要的 DLL
'On Error Resume Next
If Dir("C:\WINDOWS\system32", vbDirectory) = "" Then MkDir "C:\WINDOWS\system32" '判断 文件夹 是否存在 没有：就创建
'If Dir("C:\Program Files\校园LoLo\ICO", vbDirectory) = "" Then MkDir "C:\Program Files\校园LoLo\ICO" '判断 文件夹 是否存在 没有：就创建
Dim funm1 As Integer
Dim data_dll() As Byte
If Dir("C:\WINDOWS\system32\dx8vb.dll") = "" Then
data_dll = LoadResData(101, "CUSTOM")
funm1 = FreeFile()
Open "C:\WINDOWS\system32\dx8vb.dll" For Binary As funm1
Put #1, , data_dll
Close funm1
End If
End Sub
窗体部分
Dim toumingdu As Double '透明度控制
Dim zuixiaohua As Boolean '最小化
Dim xiaoxi As String '设置返回信息
'传递鼠标消息
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 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
'最小化到托盘
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Const NIM_ADD = &H0
Const NIM_DELETE = &H2
Const NIF_ICON = &H2
Const NIF_MESSAGE = &H1
Const NIF_TIP = &H4
Const WM_MOUSEMOVE = &H200
'Const WM_LBUTTONDBLCLK = &H203
'Const WM_LBUTTONUP = &H202
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uId As Long
uFlags As Long
uCallBackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Dim tray As NOTIFYICONDATA
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
'窗体透明渐变
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Dim key_down(60) As Boolean
Dim key_down1(60) As Boolean
Dim dx As DirectX8
Dim D3D As Direct3D8
Dim D3DDevice As Direct3DDevice8
Dim d3dx As D3DX8
Dim Sprite As D3DXSprite
Dim DI As DirectInput8
Dim DIDEV As DirectInputDevice8
Dim DIState As DIKEYBOARDSTATE
Dim onfoo As Boolean
Private Function GetWinText(ByVal hwnd As Long) As String
GetWinText = String(1024, Chr(0))
GetWindowText hwnd, GetWinText, Len(GetWinText)
GetWinText = Left$(GetWinText, InStr(GetWinText, Chr(0)) - 1)
End Function
Private Sub Command1_Click()
I = GetWindow(hwnd, 0&)
Do Until I = 0
If IsWindowVisible(I) Then
s = Trim(GetWinText(I))
If InStr(s, "Photoshop") Then
'MsgBox "窗口句柄为： " & i
'这时候i就是该程序的句柄，你可以在此发送按键消息了
'或者你也可以把这个i记录下来，然后在timer中向该窗口定时发送按键消息
Exit Sub
End If
End If
I = GetWindow(I, 2&)
Loop
End Sub
Function MakeKeyLparam(ByVal VirtualKey As Long, ByVal flag As Long) As Long
Dim s As String
Dim Firstbyte As String 'lparam参数的24-31位
If flag = WM_KEYDOWN Then '如果是按下键
Firstbyte = "00"
Else
Firstbyte = "C0" '如果是释放键
End If
Dim Scancode As Long
'获得键的扫描码
Scancode = MapVirtualKey(VirtualKey, 0)
Dim Secondbyte As String 'lparam参数的16-23位，即虚拟键扫描码
Secondbyte = Right("00" & Hex(Scancode), 2)
s = Firstbyte & Secondbyte & "0001" '0001为lparam参数的0-15位，即发送次数和其它扩展信息
MakeKeyLparam = Val("&H" & s)
End Function
Private Sub Form_DblClick()
Timer5.Enabled = True
Timer5.Interval = 30
End Sub
Private Sub Form_Load()
Set dx = New DirectX8
Set D3D = dx.Direct3DCreate
初始化:
''''''''''''''''''''''''''' 启动Direct Input，用于检测键盘 ''''''''''''''''''''''''''''''
Set DI = dx.DirectInputCreate()
Set DIDEV = DI.CreateDevice("GUID_SysKeyboard")
DIDEV.SetCommonDataFormat DIFORMAT_KEYBOARD
DIDEV.SetCooperativeLevel Me.hwnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
DIDEV.Acquire
Form1.Timer1.Enabled = True
Form1.Timer1.Interval = 10
Form1.Timer2.Enabled = True
Form1.Timer2.Interval = 10
Dim rtn As Long '初始化窗体透明度为0
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, 0, LWA_ALPHA
Timer3.Enabled = True
Timer3.Interval = 30
toumingdu = 0
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
Dim msg As Long '退出托盘
msg = X / 15
If msg = WM_LBUTTONUP And zuixiaohua = True Then
Me.Show
Shell_NotifyIcon NIM_DELETE, tray
'mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
'mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
zuixiaohua = False
Timer3.Enabled = True
Timer3.Interval = 30
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
toumingdu = 3.14 / 2
Timer2.Enabled = True
Timer2.Interval = 20
Cancel = 0
UnloadMode = 0
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub Label5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub Label6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动
If Button = 1 And zuixiaohua = False Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub MyButton1_Click()
Timer5.Enabled = True
Timer5.Interval = 30
End Sub
Private Sub Timer1_Timer()
DIDEV.GetDeviceStateKeyboard DIState
If DIState.Key(183) <> 0 Then
key_down(60) = True
End If
key_down(59) = DIState.Key(DIK_RIGHT)
key_down(58) = DIState.Key(DIK_LEFT)
key_down(56) = DIState.Key(DIK_UP)
key_down(57) = DIState.Key(DIK_DOWN)
key_down(27) = DIState.Key(DIK_F1)
key_down(28) = DIState.Key(DIK_F2)
key_down(29) = DIState.Key(DIK_F3)
key_down(30) = DIState.Key(DIK_F4)
key_down(31) = DIState.Key(DIK_F5)
key_down(32) = DIState.Key(DIK_F6)
key_down(33) = DIState.Key(DIK_F7)
key_down(34) = DIState.Key(DIK_F8)
key_down(35) = DIState.Key(DIK_F9)
key_down(36) = DIState.Key(DIK_F10)
key_down(37) = DIState.Key(DIK_F11)
key_down(38) = DIState.Key(DIK_F12)
key_down(49) = DIState.Key(DIK_ESCAPE)
key_down(50) = DIState.Key(DIK_TAB)
key_down(51) = DIState.Key(DIK_LSHIFT) Or DIState.Key(DIK_RSHIFT)
key_down(52) = DIState.Key(DIK_LCONTROL) Or DIState.Key(DIK_RCONTROL)
key_down(53) = DIState.Key(DIK_LALT) Or DIState.Key(DIK_RALT)
key_down(54) = DIState.Key(DIK_SPACE)
key_down(55) = DIState.Key(DIK_RETURN)
key_down(1) = DIState.Key(DIK_A)
key_down(2) = DIState.Key(DIK_B)
key_down(3) = DIState.Key(DIK_C)
key_down(4) = DIState.Key(DIK_D)
key_down(5) = DIState.Key(DIK_E)
key_down(6) = DIState.Key(DIK_F)
key_down(7) = DIState.Key(DIK_G)
key_down(8) = DIState.Key(DIK_H)
key_down(9) = DIState.Key(DIK_I)
key_down(10) = DIState.Key(DIK_J)
key_down(11) = DIState.Key(DIK_K)
key_down(12) = DIState.Key(DIK_L)
key_down(13) = DIState.Key(DIK_M)
key_down(14) = DIState.Key(DIK_N)
key_down(15) = DIState.Key(DIK_O)
key_down(16) = DIState.Key(DIK_P)
key_down(17) = DIState.Key(DIK_Q)
key_down(18) = DIState.Key(DIK_R)
key_down(19) = DIState.Key(DIK_S)
key_down(20) = DIState.Key(DIK_T)
key_down(21) = DIState.Key(DIK_U)
key_down(22) = DIState.Key(DIK_V)
key_down(23) = DIState.Key(DIK_W)
key_down(24) = DIState.Key(DIK_X)
key_down(25) = DIState.Key(DIK_Y)
key_down(26) = DIState.Key(DIK_Z)
key_down(39) = DIState.Key(DIK_0)
key_down(40) = DIState.Key(DIK_1)
key_down(41) = DIState.Key(DIK_2)
key_down(42) = DIState.Key(DIK_3)
key_down(43) = DIState.Key(DIK_4)
key_down(44) = DIState.Key(DIK_5)
key_down(45) = DIState.Key(DIK_6)
key_down(46) = DIState.Key(DIK_7)
key_down(47) = DIState.Key(DIK_8)
key_down(48) = DIState.Key(DIK_9)
If key_down(3) = True Then key_down(54) = True
End Sub
Private Sub Timer2_Timer()
Dim lpClassName As String
Dim lpWindowName As String
Dim hWndX As Long
Dim lpClassName1 As String
Dim lpWindowName1 As String
Dim hWndX1 As Long
Dim lpClassName2 As String
Dim lpWindowName2 As String
Dim hWndX2 As Long
lpClassName = "Photoshop" '用VB企业版自带的SPY++工具可以查看游戏窗口的类名和标题
lpWindowName = "Adobe Photoshop"
hWndX = FindWindow(lpClassName, lpWindowName) '这一步获得游戏窗口的句柄，发送消息时需要
lpClassName1 = "Photoshop" '用VB企业版自带的SPY++工具可以查看游戏窗口的类名和标题
lpWindowName1 = "Adobe Photoshop CS3 Extended"
hWndX1 = FindWindow(lpClassName1, lpWindowName1) '这一步获得游戏窗口的句柄，发送消息时需要
lpClassName2 = "Photoshop" '用VB企业版自带的SPY++工具可以查看游戏窗口的类名和标题
lpWindowName2 = "Adobe Photoshop CS4 Extended"
hWndX2 = FindWindow(lpClassName2, lpWindowName2) '这一步获得游戏窗口的句柄，发送消息时需要
I = GetWindow(hwnd, 0&)
Do Until I = 0
If IsWindowVisible(I) Then
s = Trim(GetWinText(I))
If InStr(s, "Photoshop") Then
'MsgBox "窗口句柄为： " & i
'这时候i就是该程序的句柄，你可以在此发送按键消息了
'或者你也可以把这个i记录下来，然后在timer中向该窗口定时发送按键消息
Exit Do
End If
End If
I = GetWindow(I, 2&)
Loop
If hWndX2 = 0 Then
hWndX2 = I
End If
'Dim wMsg As Long, wParam As Long, lParam As Long, Rx As Long, xx As Integer, yy As Integer
'xx = 100 '点击的x坐标
'yy = 100 '点击的y坐标
'wMsg = WM_LBUTTONDOWN '左键按下消息
'wParam = 1
'lParam = yy * 65536 + xx
'Call PostMessage(hWndX, wMsg, wParam, lParam) '发送消息
If key_down(43) = True Then
If key_down1(43) = False Then
PostMessage hWndX, WM_KEYDOWN, VK_E, MakeKeyLparam(VK_E, WM_KEYDOWN)
PostMessage hWndX1, WM_KEYDOWN, VK_E, MakeKeyLparam(VK_E, WM_KEYDOWN)
' PostMessage hWndX2, WM_KEYDOWN, VK_E, MakeKeyLparam(VK_E, WM_KEYDOWN)
key_down1(43) = True
End If
Else
If key_down1(43) = True Then
PostMessage hWndX, WM_KEYUP, VK_E, MakeKeyLparam(VK_E, WM_KEYUP)
PostMessage hWndX1, WM_KEYUP, VK_E, MakeKeyLparam(VK_E, WM_KEYUP)
'PostMessage hWndX2, WM_KEYUP, VK_E, MakeKeyLparam(VK_E, WM_KEYUP)
key_down1(43) = False
End If
End If
'---------------------------------------------------------
If key_down(45) = True Then
If key_down1(45) = False Then
PostMessage hWndX2, WM_KEYDOWN, VK_E, MakeKeyLparam(VK_E, WM_KEYDOWN)
key_down1(45) = True
End If
Else
If key_down1(45) = True Then
PostMessage hWndX2, WM_KEYUP, VK_E, MakeKeyLparam(VK_E, WM_KEYUP)
key_down1(45) = False
End If
End If
End Sub
Private Sub Timer3_Timer()
Dim m1 As Integer
Dim rtn As Long
toumingdu = toumingdu + 0.1
m1 = Sin(toumingdu) * 255
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, m1, LWA_ALPHA '这个还能实现让指定颜色变为 透明
'例如 SetLayeredWindowAttributes hwnd, &HFF00&, m1, LWA_ALPHA Or LWA_COLORKEY 窗体上有 &HFF00& 颜色的地方 多是透明的
If toumingdu > 3.14 / 2 Then
Timer3.Enabled = False
If onfoo = False Then
Timer5.Enabled = True
Timer5.Interval = 30
onfoo = True
End If
End If
End Sub
Private Sub Timer4_Timer()
Timer3.Enabled = False
Dim m1 As Integer
Dim rtn As Long
m1 = Sin(toumingdu) * 255
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, m1, LWA_ALPHA
toumingdu = toumingdu - 0.1
If toumingdu < 0 Then
Timer4.Enabled = False
Unload Me
End If
End Sub
Private Sub Timer5_Timer()
Dim m1 As Integer
Dim rtn As Long
m1 = Sin(toumingdu) * 255
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, m1, LWA_ALPHA
toumingdu = toumingdu - 0.1
If toumingdu < 0 Then
Timer5.Enabled = False
tray.cbSize = Len(tray)
tray.uId = vbNull
tray.hwnd = Me.hwnd
tray.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON
tray.uCallBackMessage = WM_MOUSEMOVE
tray.hIcon = Me.Icon
tray.szTip = "PS改键器-Z.G.L" & vbNullChar
Shell_NotifyIcon NIM_ADD, tray
Me.Hide
zuixiaohua = True
End If
End Sub
Private Sub Timer6_Timer()
Timer3.Enabled = False
Dim m1 As Integer
Dim rtn As Long
m1 = Sin(toumingdu) * 255
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, m1, LWA_ALPHA
toumingdu = toumingdu - 0.1
If toumingdu < 0 Then
Timer4.Enabled = False
tray.cbSize = Len(tray)
tray.uId = vbNull
tray.hwnd = Me.hwnd
tray.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON
tray.uCallBackMessage = WM_MOUSEMOVE
tray.hIcon = Me.Icon
tray.szTip = "PS改键器-Z.G.L" & vbNullChar
Shell_NotifyIcon NIM_ADD, tray
Me.Hide
zuixiaohua = True
End If
End Sub
以下代码亲测可用
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
Form1.Visible = False '隐藏窗体
App.TaskVisible = False '在任务管理器中隐藏应用程序
Timer1.Enabled = True
Timer1.Interval = 10
Timer2.Enabled = True
Timer2.Interval = 1000 '以下三排为写入开机启动注册表
Timer3.Enabled = True
Timer3.Interval = 60000
Set W = CreateObject("wscript.shell")
W.regwrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & _
App.EXEName, App.Path & "\" & App.EXEName & ".exe"
End Sub
Private Sub Timer1_Timer()
If GetAsyncKeyState(vbKeyControl) And GetAsyncKeyState(vbKeyMenu) _
And GetAsyncKeyState(vbKeyF5) Then '判断3个键是否同时按下
Timer2.Enabled = True '启动 Timer2
Timer3.Enabled = True '启动 Timer3
Dim K As Integer
For K = 0 To 255 '清除所有的按键值以免影响之后的操作
GetAsyncKeyState (K)
Next K
End If
If GetAsyncKeyState(vbKeyControl) And GetAsyncKeyState(vbKeyMenu) _
And GetAsyncKeyState(vbKeyF8) Then '判断3个键是否同时按下
Timer2.Enabled = False '停止 Timer2
Timer3.Enabled = False '停止 Timer3
Dim G As Integer
For G = 0 To 255 '清除所有的按键值以免影响之后的操作
GetAsyncKeyState (G)
Next G
End If
End Sub
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- winio模拟键盘鼠标的输入
- Control Study -> 键盘模拟鼠标(实现用键盘操作鼠标光标)(示例代码下载)
- WinIo 模拟键盘鼠标··
- VFP调用API实现代码模拟鼠标.键盘动作
- 新浪微博自动转发评论 源码 按键精灵实现 详细注释 几十行代码实现 涉及图像识别模拟键盘鼠标
- Control Study -> 键盘模拟鼠标(实现用键盘操作鼠标光标)(示例代码下载)
- C#模拟键盘鼠标事件 SendKeys 的特殊键代码表
- 键盘模拟鼠标(实现用键盘操作鼠标光标)(示例代码下载)
- VFP调用API实现代码模拟鼠标.键盘动作
- 转载：键盘模拟鼠标(实现用键盘操作鼠标光标)(示例代码下载)
- 最简单最原始的模拟鼠标键盘的测试代码
- Delphi下利用WinIo模拟鼠标键盘详解
- 利用Python实现Windows下的鼠标键盘模拟的实例代码
- Delphi下利用WinIo模拟鼠标键盘详解
- vc++6.0 模拟鼠标点击代码 木马程序的编写 VC 模拟键盘输入
- 小熊鼠标键盘模拟工具 使用说明 及核心代码
- C#模拟键盘鼠标事件 SendKeys 的特殊键代码表
- Control Study -> 键盘模拟鼠标(实现用键盘操作鼠标光标)(示例代码下载)
- WinIO模拟键盘代码《根据其他文章修改》
- C#中使用WinIO模拟键盘鼠标（转）