现在的位置: 首页 > 综合 > 正文

实现远程控制鼠标

2014年02月28日 ⁄ 综合 ⁄ 共 6099字 ⁄ 字号 小 中 大 ⁄ 评论关闭
'服务器
''
''程序实现功能：实现远程控制鼠标
'作    者： ssihc0
'联系方式： ssihc0@163.com
'QQ:47400789
'版本：Version 1.0.0
'说明：复制请保留源作者信息，转载请说明，欢迎大家提出意见和建议
  2.   '---
  3.   '模块
  4.   Option Explicit
  7.   Public Const WH_JOURNALRECORD = 0
  8. Type POINTAPI
  9.   x   As Long
  10.   y   As Long
  11.   End Type
  12.   Type MOUSEHOOKSTRUCT
  13.   pt   As POINTAPI
  14.   y  As Long
  15.   wHitTestCode   As Long
  16.   dwExtraInfo   As Long
  17.   End Type
  18.   Type EVENTMSG
  19.                   message   As Long
  20.                   paramL   As Long
  21.                   paramH   As Long
  22.                   time   As Long
  23.                   hwnd   As Long
  24.   End Type
  25.   Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
  26.         ByVal hmod As Long, ByVal dwThreadId As Long) As Long
  27.   Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
  28.   Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
  29.   Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
  31.   Public hHook     As Long         '   handle   of   Hook   Procedure
  32.   Public msg     As EVENTMSG
  33.   Public lHwnd     As Long
  34.   Public lKey     As Long
  35. Public s_msg As String
  36.   '消息
  37.     Public Const HC_ACTION = 0
  38.     Public Const WM_KEYDOWN = 
  39.     Public Const WM_MOUSEMOVE = 
  40.     Public Const WM_LBUTTONDBLCLK = 
  41.     Public Const WM_MBUTTONUP = 
  42.     Public Const WM_MBUTTONDOWN = 
  43.     Public Const WM_MBUTTONDBLCLK = 
  44.     Public Const WM_LBUTTONUP = 
  45.     Public Const WM_LBUTTONDOWN = 
  46.   Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  47.   Public Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
  48.   Public strKeyName     As String * 255
  49. Public c(1, 1) As Double
  51.   Sub EnableHook()
  52.         hHook = SetWindowsHookEx(0, AddressOf HookProc, App.hInstance, 0)
  53.   End Sub
  55.   Sub FreeHook()
  56.           Dim ret     As Long
  57.           ret = UnhookWindowsHookEx(hHook)
  58.   End Sub
  59.   Function HookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  60.           If code = HC_ACTION Then
  61.                   CopyMemory msg, lParam, LenB(msg)
  62.                   If msg.message <> &H200 Then
  63.                    Debug.Print msg.message
  64.                   End If
  65.                   Select Case msg.message
  66.                     Case &H204, &H205, &H201, &H202, &H203, &H207, &H208, &H209, 
  67.                         Dim x, y As Long
  68.                         Dim ms1 As MOUSEHOOKSTRUCT
  69.                         Dim c_9 As Long
  70.                         CopyMemory ms1, lParam, LenB(ms1)
  71.                         x = ms1.pt.y
  72.                         y = ms1.y
  73.                         If s_msg = "!" & msg.message & "," & x & "," & y & "!" Then
  74.                         
  75.                         Else
  76.                           mainform.scksever.SendData "!" & msg.message & "," & x & "," & y & "!"
  77.                           s_msg = "!" & msg.message & "," & x & "," & y & "!"
  78.                         End If
  79.                       
  80.                     End Select
  81.                   End If
  82.           HookProc = CallNextHookEx(hHook, code, wParam, lParam)
  83.   End Function
    1. 'form
    5. Private Sub Command1_Click()
    6. Call FreeHook
    7. Command2.Enabled = True
    8. End Sub
    10. Private Sub Command2_Click()
    11. Command2.Enabled = False
    12. Call EnableHook
    13. End Sub
    15. Private Sub Command3_Click()
    16.  scksever.LocalPort = 1007
    17.     scksever.RemotePort = 1008
    18.     scksever.Listen
    19.     MsgBox "设本机为服务器成功！", vbInformation, "提示"
    20. End Sub
    23. Private Sub Form_Load()
    24. Me.Left = (Screen.Width - Me.Width) / 2
    25. Me.Top = (Screen.Height - Me.Height) / 2
    26. 'SetWindowPos hwnd, -1, 0, 0, 0, 0, 3
    27. Text2.Text = scksever.LocalIP
    29. End Sub
    32. Private Sub scksever_ConnectionRequest(ByVal requestID As Long)
    33. If scksever.State <> 0 Then scksever.Close
    34. scksever.Accept requestID
    35. Text1.Text = scksever.RemoteHostIP
    36. End Sub

    客户端

    1. 'Module
    2. Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
    4. Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    5. Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    7. Public 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)
    10. Public Const MOUSEEVENTF_ABSOLUTE = &H8000 '  absolute move
    11. Public Const MOUSEEVENTF_LEFTDOWN = &H2 '  left button down
    12. Public Const MOUSEEVENTF_LEFTUP = &H4 '  left button up
    13. Public Const MOUSEEVENTF_MIDDLEDOWN = &H20 '  middle button down
    14. Public Const MOUSEEVENTF_MIDDLEUP = &H40 '  middle button up
    15. Public Const MOUSEEVENTF_RIGHTDOWN = &H8 '  right button down
    16. '  mouse move
    17. Public Const MOUSEEVENTF_RIGHTUP = &H10 '  right button up
    19. Public Const MOUSEEVENTF_MOVE = 
    22. 'form
    23. Private Sub Command1_Click()
    24. If txtip.Text = "" Then
    25. MsgBox "请输入IP，后连接", vbInformation, "提示"
    26. Exit Sub
    27. Else
    28. Command1.Enabled = False
    29. sckclient.RemoteHost = txtip.Text
    30. sckclient.LocalPort = 1008
    31. sckclient.RemotePort = 1007
    32. sckclient.Connect
    34. End If
    36. End Sub
    40. Private Sub Form_Load()
    41. Me.Left = (Screen.Width - Me.Width) / 2
    42. Me.Top = (Screen.Height - Me.Height) / 2
    44. End Sub
    47. Private Sub sckclient_Connect()
    48. MsgBox "连接成功", vbInformation, "OK"
    49.     
    50. End Sub
    52. Private Sub sckclient_DataArrival(ByVal bytesTotal As Long)
    53. Dim sdata As String
    54. Dim strdata As String
    55. Dim mycommand As String
    56. Dim sb As Long
    57. Dim s() As String
    58. sckclient.GetData sdata
    59. If Left$(sdata, 1) = "!" And Right$(sdata, 1) = "!" Then
    60. Dim s1 As String
    61. s1 = Mid$(sdata, 2, InStr(2, sdata, "!"))
    62. s = Split(s1, ",")
    63. Select Case Val(s(0))
    64. Case 
    66. mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0&, 0
    67. Case 
    69. mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0&, 0
    70. Case 
    71. mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0&, 0
    72. 'mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0&, 0&
    73. Case 
    75. 'mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0&, 0&
    76. mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0&, 0
    79. Case 
    80. Case 
    81. Case 
    82. Case 
    83. Case 
    84. Dim x As Long
    85. Dim y As Long
    86. x = Val(s(1))
    87. y = Val(s(2))
    88. SetCursorPos x, y
    89. End Select
    90. Debug.Print
    91. End If
    93. End Sub

返回
【上篇】
【下篇】

作者:

抱歉!评论已关闭.

返回首页

Copyright © 2013-2018 学步园  保留所有权利.
软文销售 QQ客服：2265327166 点击这里给我发消息（其他合作也可洽谈）
必威体育
必威电竞