'通用部分

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