远程控制
收藏
远程控制键盘和鼠标:
Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey 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 Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Const filename = "c:\temp.bmp"
Const blocksize = 4340
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal Y As Long) As Long
Private Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long '互换左右键的功能
Private Type POINTAPI
x As Long
Y As Long
End Type
Dim xx As Long
Dim yy As Long
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 '是否获得绝对位置
Private Const MOUSEEVENTF_MOVE = &H1 '移动鼠标
Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' 左键按下
Private Const MOUSEEVENTF_LEFTUP = &H4 ' 左键弹起
Private Const MOUSEEVENTF_RIGHTDOWN = &H8 ' 右键按下
Private Const MOUSEEVENTF_RIGHTUP = &H10 ' 右键弹起
Private Const KEYEVENTF_KEYUP = &H2
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 ' 中键按下
Private Const MOUSEEVENTF_MIDDLEUP = &H40 ' 在键弹起
Private Const WM_LBUTTONDBLCLK = &H203
Private Sub Form_Load()
tcpServer.LocalPort = 1336
tcpServer.Listen
App.TaskVisible = False
If App.PrevInstance Then '如果已经运行就退出。
End
End If
End Sub
Private Sub tcpServer_Close()
If tcpServer.State <> sckClosed Then tcpServer.Close
tcpServer.Listen '关闭连接后继续监听"
End Sub
Private Sub tcpServer_ConnectionRequest(ByVal requestID As Long)
If tcpServer.State <> sckClosed Then tcpServer.Close
tcpServer.Accept requestID '请求到达时，接受连接
End Sub
Private Sub tcpServer_DataArrival(ByVal bytesTotal As Long)
Dim strData As String, j, x
tcpServer.GetData strData
Select Case strData
Case "Close" ' 接到“Disconnect”命令后，关闭当前连接，并继续监听
tcpServer.Close
tcpServer.LocalPort = 1001
tcpServer.Listen
Case "sbdj" '鼠标单击
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Case "sbsj" '鼠标双击
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Case "sbyj" '鼠标右键
mouse_event MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
Case "65"
keybd_event 65, 0, 0, 0 '模拟按下"A"键
Case "66"
keybd_event 66, 0, 0, 0 '模拟按下"B"键
Case "67"
keybd_event 67, 0, 0, 0 '模拟按下"C"键
Case "68"
keybd_event 68, 0, 0, 0 '模拟按下"D"键
Case "69"
keybd_event 69, 0, 0, 0 '模拟按下"E"键
Case "70"
keybd_event 70, 0, 0, 0 '模拟按下"F"键
Case "71"
keybd_event 71, 0, 0, 0 '模拟按下"G"键
Case "72"
keybd_event 72, 0, 0, 0 '模拟按下"H"键
Case "73"
keybd_event 73, 0, 0, 0 '模拟按下"I"键
Case "74"
keybd_event 74, 0, 0, 0 '模拟按下"J"键
Case "75"
keybd_event 75, 0, 0, 0 '模拟按下"K"键
Case "76"
keybd_event 76, 0, 0, 0 '模拟按下"L"键
Case "77"
keybd_event 77, 0, 0, 0 '模拟按下"M"键
Case "78"
keybd_event 78, 0, 0, 0 '模拟按下"N"键
Case "79"
keybd_event 79, 0, 0, 0 '模拟按下"O"键
Case "80"
keybd_event 80, 0, 0, 0 '模拟按下"P"键
Case "81"
keybd_event 81, 0, 0, 0 '模拟按下"Q"键
Case "82"
keybd_event 82, 0, 0, 0 '模拟按下"R"键
Case "83"
keybd_event 83, 0, 0, 0 '模拟按下"S"键
Case "84"
keybd_event 84, 0, 0, 0 '模拟按下"T"键
Case "85"
keybd_event 85, 0, 0, 0 '模拟按下"U"键
Case "86"
keybd_event 86, 0, 0, 0 '模拟按下"V"键
Case "87"
keybd_event 87, 0, 0, 0 '模拟按下"W"键
Case "88"
keybd_event 88, 0, 0, 0 '模拟按下"X"键
Case "89"
keybd_event 89, 0, 0, 0 '模拟按下"Y"键
Case "90"
keybd_event 90, 0, 0, 0 '模拟按下"Z"键
Case "96"
keybd_event 96, 0, 0, 0 '模拟按下"0"键
Case "97"
keybd_event 97, 0, 0, 0 '模拟按下"1"键
Case "98"
keybd_event 98, 0, 0, 0 '模拟按下"2"键
Case "99"
keybd_event 99, 0, 0, 0 '模拟按下"3"键
Case "100"
keybd_event 100, 0, 0, 0 '模拟按下"4"键
Case "101"
keybd_event 101, 0, 0, 0 '模拟按下"5"键
Case "102"
keybd_event 102, 0, 0, 0 '模拟按下"6"键
Case "103"
keybd_event 103, 0, 0, 0 '模拟按下"7"键
Case "104"
keybd_event 104, 0, 0, 0 '模拟按下"8"键
Case "105"
keybd_event 105, 0, 0, 0 '模拟按下"9"键
Case "8"
keybd_event 8, 0, 0, 0 '模拟按下"Backspace"键
Case "9"
keybd_event 9, 0, 0, 0 '模拟按下"Tab"键
Case "13"
keybd_event 13, 0, 0, 0 '模拟按下"Enter"键
Case "16"
keybd_event 16, 0, 0, 0 '模拟按下"Shift"键
Case "17"
keybd_event 17, 0, 0, 0 '模拟按下"Ctrl"键
Case "18"
keybd_event 18, 0, 0, 0 '模拟按下"Alt"键
Case "20"
keybd_event 20, 0, 0, 0 '模拟按下"Caps Lock"键
Case "27"
keybd_event 27, 0, 0, 0 '模拟按下"Esc"键
Case "32"
keybd_event 32, 0, 0, 0 '模拟按下"空格"键
Case "104"
keybd_event 104, 0, 0, 0 '模拟按下"8"键
Case "105"
keybd_event 105, 0, 0, 0 '模拟按下"9"键
Case Else
If IsNumeric(strData) = True Then
j = InStr(1, strData, ",", 1)
xx = Left(strData, j - 1)
yy = Right(strData, Len(strData) - j)
Label1.Caption = Left(strData, j - 1)
Label2.Caption = Left(strData, Len(strData) - j)
Call SetCursorPos(xx, yy)
End If
End Select
tcpServer.SendData "yd"
End Sub
Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey 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 GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim xx As Long, tt As Long
Dim yy As Long
Dim zz As String, bz As String
Const filename = "C:\sys1.tmp"
Private UnusedField As Integer
Private X As Integer
Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' 左键按下
Private Const MOUSEEVENTF_LEFTUP = &H4 ' 左键弹起
Private Const MOUSEEVENTF_RIGHTDOWN = &H8 ' 右键按下
Private Const MOUSEEVENTF_RIGHTUP = &H10 ' 右键弹起
Private Const KEYEVENTF_KEYUP = &H2 '鼠标移动
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 ' 中键按下
Private Const MOUSEEVENTF_MIDDLEUP = &H40 ' 中键弹起
Private Const WM_LBUTTONDBLCLK = &H203
Public fssbyd As String
Private Sub Form_Click()
tcpClient.SendData "sbdj"
'fssbyd = "byd" '鼠标移动
End Sub
Private Sub Form_DblClick()
tcpClient.SendData "sbsj" '鼠标双击
'fssbyd = "byd" '鼠标移动
End Sub
Private Sub Form_Load()
txtIP.Text = tcpClient.LocalIP
UnusedField = 1
tcpClient.LocalPort = 0 '本地端口可任选，只要不冲突且小于65535，用0可产生一个随机的的端口
tcpClient.RemotePort = 1336 '对应服务器端的localport
state_lab = "未建立连接."
Timer1.Enabled = False
Timer1.Interval = 0
End Sub
Private Sub CmdConnect_Click()
On Error GoTo skip
tcpClient.RemoteHost = txtIP.Text
If tcpClient.State = sckConnected Then
state_lab = "已建立连接了"
Else
tcpClient.Connect
End If
Exit Sub
skip: '用netstat命令看到状态为Time_wait则
If Err.Number = 10048 Then '须等待一段时间才可连接，也可换另一端口，可加快连接速度
MsgBox "端口正在使用，请稍后再试！", vbOKOnly, "注意！"
End
End If
End Sub
Private Sub cmdDisconnect_Click()
tcpClient.SendData "Close" ' 断开连接
CmdConnect.Enabled = True
cmdGet_Pic.Enabled = False
cmdDisconnect.Enabled = False
End Sub
Private Sub cmdGet_Pic_Click()
tcpClient.SendData "100,100" ' 请求状态返回
frmClient.MousePointer = 11
Timer1.Enabled = True
Timer1.Interval = 100
fssbyd = "yd"
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
tcpClient.SendData "sbyj" '鼠标右键被按下
End If
'fssbyd = "yd" '鼠标移动
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim rc As Long
Dim lpPoint As POINTAPI
rc = GetCursorPos(lpPoint)
xx = lpPoint.X
yy = lpPoint.Y
zz = xx & "," & yy
tt = InStr(1, zz, ",", 1)
Label4.Caption = zz
Label2.Caption = Left(zz, tt - 1)
Label3.Caption = Right(zz, Len(zz) - tt)
Label5.Caption = "长度：" & tt
If fssbyd = "yd" Then
Sleep (5)
tcpClient.SendData zz
End If
Label1.Caption = IsNumeric(zz)
End Sub
Private Sub tcpClient_Connect()
state_lab = "已经建立了连接"
End Sub
Private Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
Dim strdata1 As String
tcpClient.GetData strdata1
fssbyd = strdata1
End Sub
Private Sub Timer1_Timer()
If GetAsyncKeyState(65) = -32767 Then
tcpClient.SendData "65" 'A被按下
End If
If GetAsyncKeyState(66) = -32767 Then
tcpClient.SendData "66" 'B被按下
End If
If GetAsyncKeyState(67) = -32767 Then
tcpClient.SendData "67" 'C被按下
End If
If GetAsyncKeyState(68) = -32767 Then
tcpClient.SendData "68" 'D被按下
End If
If GetAsyncKeyState(69) = -32767 Then
tcpClient.SendData "69" 'E被按下
End If
If GetAsyncKeyState(70) = -32767 Then
tcpClient.SendData "70" 'F被按下
End If
If GetAsyncKeyState(71) = -32767 Then
tcpClient.SendData "71" 'G被按下
End If
If GetAsyncKeyState(72) = -32767 Then
tcpClient.SendData "72" 'H被按下
End If
If GetAsyncKeyState(73) = -32767 Then
tcpClient.SendData "73" 'I被按下
End If
If GetAsyncKeyState(74) = -32767 Then
tcpClient.SendData "74" 'J被按下
End If
If GetAsyncKeyState(75) = -32767 Then
tcpClient.SendData "75" 'K被按下
End If
If GetAsyncKeyState(76) = -32767 Then
tcpClient.SendData "76" 'L被按下
End If
If GetAsyncKeyState(77) = -32767 Then
tcpClient.SendData "77" 'M被按下
End If
If GetAsyncKeyState(78) = -32767 Then
tcpClient.SendData "78" 'N被按下
End If
If GetAsyncKeyState(79) = -32767 Then
tcpClient.SendData "79" 'O被按下
End If
If GetAsyncKeyState(80) = -32767 Then
tcpClient.SendData "80" 'P被按下
End If
If GetAsyncKeyState(81) = -32767 Then
tcpClient.SendData "81" 'Q被按下
End If
If GetAsyncKeyState(82) = -32767 Then
tcpClient.SendData "82" 'R被按下
End If
If GetAsyncKeyState(83) = -32767 Then
tcpClient.SendData "83" 'S被按下
End If
If GetAsyncKeyState(84) = -32767 Then
tcpClient.SendData "84" 'T被按下
End If
If GetAsyncKeyState(85) = -32767 Then
tcpClient.SendData "85" 'U被按下
End If
If GetAsyncKeyState(86) = -32767 Then
tcpClient.SendData "86" 'V被按下
End If
If GetAsyncKeyState(87) = -32767 Then
tcpClient.SendData "87" 'W被按下
End If
If GetAsyncKeyState(88) = -32767 Then
tcpClient.SendData "88" 'X被按下
End If
If GetAsyncKeyState(89) = -32767 Then
tcpClient.SendData "89" 'Y被按下
End If
If GetAsyncKeyState(90) = -32767 Then
tcpClient.SendData "90" 'Z被按下
End If
If GetAsyncKeyState(96) = -32767 Then
tcpClient.SendData "96" '0被按下
End If
If GetAsyncKeyState(97) = -32767 Then
tcpClient.SendData "97" '1被按下
End If
If GetAsyncKeyState(98) = -32767 Then
tcpClient.SendData "98" '2被按下
End If
If GetAsyncKeyState(99) = -32767 Then
tcpClient.SendData "99" '3被按下
End If
If GetAsyncKeyState(100) = -32767 Then
tcpClient.SendData "100" '4被按下
End If
If GetAsyncKeyState(101) = -32767 Then
tcpClient.SendData "101" '5被按下
End If
If GetAsyncKeyState(102) = -32767 Then
tcpClient.SendData "102" '6被按下
End If
If GetAsyncKeyState(103) = -32767 Then
tcpClient.SendData "103" '7被按下
End If
If GetAsyncKeyState(104) = -32767 Then
tcpClient.SendData "104" '8被按下
End If
If GetAsyncKeyState(105) = -32767 Then
tcpClient.SendData "105" '9被按下
End If
If GetAsyncKeyState(87) = -32767 Then
tcpClient.SendData "87" 'W被按下
End If
If GetAsyncKeyState(88) = -32767 Then
tcpClient.SendData "88" 'X被按下
End If
If GetAsyncKeyState(89) = -32767 Then
tcpClient.SendData "89" 'Y被按下
End If
If GetAsyncKeyState(90) = -32767 Then
tcpClient.SendData "90" 'Z被按下
End If
If GetAsyncKeyState(8) = -32767 Then
tcpClient.SendData "8" 'Backspace被按下
End If
If GetAsyncKeyState(9) = -32767 Then
tcpClient.SendData "9" 'Tab被按下
End If
If GetAsyncKeyState(13) = -32767 Then
tcpClient.SendData "13" '回车键被按下
End If
If GetAsyncKeyState(16) = -32767 Then
tcpClient.SendData "16" 'Shift被按下
End If
If GetAsyncKeyState(17) = -32767 Then
tcpClient.SendData "17" 'CTRL被按下
End If
If GetAsyncKeyState(18) = -32767 Then
tcpClient.SendData "18" 'ALT被按下
End If
If GetAsyncKeyState(20) = -32767 Then
tcpClient.SendData "17" 'Caps Lock被按下
End If
If GetAsyncKeyState(27) = -32767 Then
tcpClient.SendData "27" 'ESC被按下
End If
If GetAsyncKeyState(32) = -32767 Then
tcpClient.SendData "32" '空格被按下
End If
End Sub
发表于 @ 2008年04月18日 23:25:00 | 评论( loading... ) | 举报| 收藏
新一篇:远程控制
- 查看最新精华文章 请访问博客首页相关文章
-
- 发表评论
-
- 表 情：
-
- 评论内容：
- 用 户 名：