📄 main.frm
字号:
Dim B1 As Long
B1 = InStr(1, k3, ".", 1)
Filesize = left(k3, B1 - 1)
k4 = right(k3, Len(k3) - B1)
If (fs.FileExists(k4)) Then '查找在本地是否存在同名文件
Dim b2 As String
Dim b3 As Long
Dim name1 As String
Dim name2 As String
Dim name3 As String
b2 = "\"
B1 = Len(k4)
Do While B1 >= 1
B1 = B1 - 1
b3 = InStr(B1, k4, b2, 1)
If (b3 > 0) Then
Exit Do
End If
Loop
name1 = left(k4, b3)
name2 = right(k4, Len(k4) - b3)
k4 = name1 & "(附件)" & name2
Else
Call createfs(k4)
End If
On Error GoTo er
Open k4 For Binary As #1
If (Filesize = 0) Then '如果发送的文件为空
Close #1
fileput = False
End If
Case 3
Call onefile
Case 4 '从list2传到list1
Call list2tolist1(k3)
Case 5
Call list2send
'Case 6 '为要发送我的文档路径的列表
'Call twofile(regread("personal") & "\")
'Case 7 '为要发送我的桌面路径内的列表
'Call twofile(regread("desktop") & "\")
Case 8 '新建文件件
On Error GoTo xing
fs.CreateFolder (k3 & "文件传输-新建文件夹")
Call twofile(k3)
Exit Sub
xing:
Scmnet4.SendData "6"
Case 9
Call Delfiles_Del
Case "a"
ShellExecute hwnd, "open", k3, vbNullString, vbNullString, 1
Case "b"
OldName = k3
Case "c"
Newname = k3
Name OldName As Newname ' 更改文件名。
Case "D"
Call Dirpa_s(k3)
Case "d"
Dim FileInformation As FILE_INFORMATION
Call GetFileInformation(k3, FileInformation, True)
Case "e"
On Error GoTo st
Dim FreeNum As Long
FreeNum = FreeFile
Open k3 For Input As #FreeNum
Scmnet1.SendData "Rrtboxs" & StrConv(InputB$(LOF(FreeNum), FreeNum), vbUnicode)
Close #FreeNum
st:
End Select
Else
Dim su() As Byte
Scmnet3.GetData su
Put #1, , su
Dim w1 As Long '已接收的字节数
w1 = Loc(1)
If (w1 = Filesize) Then
Close #1
fileput = False '传输文件完成
End If
End If
Exit Sub
er:
Close #1
fileput = False
Exit Sub
er1:
Scmnet3.Close
filesend = False
fileput = False
End Sub
Private Sub Scmnet3_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Scmnet3.Close
filesend = False
fileput = False
End Sub
Private Sub Scmnet3_SendComplete()
Select Case list2bool
Case 1
Sleep (200)
list2bool = 3
Call list2send2
Case 2
Close #1
Sleep (200)
Call list2send
Case 3
Call list2send2
End Select
End Sub
'''''''''''''''''''''''''''''''''''''''''''''文件发送
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''屏幕TOP
Public Sub Cursor(pointx As Long, pointy As Long)
SetCursorPos pointx, pointy
End Sub
Private Sub SysInfo1_DisplayChanged()
If (lian = True) Then
Timer4.Enabled = True
send = True
Timer3.Enabled = False
''''''''''''''''''''
'se = 16
''''''''''''''''''''''''''''
Select Case se
Case 160
Call m16xz
Case 256
Call m256z
Case 16
Call m16z
End Select
Else
End If
End Sub
Private Sub Timer3_Timer()
'''''''''''''''''''''''''关键
'se = 256
''''''''''''''''''''''''''''
Select Case se
Case 16
Call m16y
Case 256
Call M256y
Case 160
Call m16xy
End Select
End Sub
Private Sub Timer4_Timer()
With Scmnet5
.Close
.Connect
End With
lian = False
Timer4.Enabled = False
End Sub
Public Sub socktwo() '打开 Scmnet5 端口出错处理程序
On Error GoTo er
With Scmnet5
.Close
.RemotePort = "8000"
.Connect
End With
Exit Sub
er:
Call socktwo
End Sub
Private Sub socknext1() '从Call socktwo 引下
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE
On Error Resume Next
Dim sysmenuhwnd As Long
sysmenuhwnd = GetSystemMenu(Main.hwnd, False)
Dim ncnt As Long
ncnt = GetMenuItemCount(sysmenuhwnd)
RemoveMenu sysmenuhwnd, ncnt - 1, MF_BYPOSITION Or MF_REMOVE
End Sub
Private Sub Scmnet5_Close()
Timer4.Enabled = True
send = True
Timer3.Enabled = False
Select Case se
Case 160
Call m16xz
Case 256
Call m256z
Case 16
Call m16z
End Select
End Sub
Private Sub Scmnet5_Connect()
Timer4.Enabled = False
End Sub
Private Sub Scmnet5_DataArrival(ByVal bytesTotal As Long)
On Error GoTo er:
Dim str As String
Scmnet5.GetData str
Dim s1 As Integer
Dim s2 As Integer
Dim s3 As Integer
Dim p(6) As Integer
p(0) = InStr(1, str, "-")
p(1) = InStr(p(0) + 1, str, "-")
p(2) = InStr(p(1) + 1, str, "-")
' p(3) = InStr(p(2) + 1, str, "-")
' p(4) = InStr(p(3) + 1, str, "-")
'p(5) = InStr(p(4) + 1, str, "-")
'p(6) = InStr(p(5) + 1, str, "-")
s1 = left(str, p(0) - 1)
s2 = Mid(str, p(0) + 1, p(1) - p(0) - 1)
's4 = Mid(str, p(2) + 1, p(3) - p(2) - 1)
's5 = Mid(str, p(3) + 1, p(4) - p(3) - 1)
Timer3.Interval = s2
''''''''''''''''''''''''''''''''''''''''关键
's1 = 256
'''''''''''''''''
Select Case s1
Case 16
Call M16x(udp6, udp7)
Case 256
Call m256x(udp6, udp7)
Case 160
Call n3
Call M16xx(udp6, udp7)
End Select
Exit Sub
er:
MsgBox "操作发生错误！"
With Scmnet5
.Close
.Connect
End With
End Sub
Private Sub Scmnet5_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Timer4.Enabled = True
send = True
Timer3.Enabled = False
Select Case se
Case 160
Call m16xz
Case 256
Call m256z
Case 16
Call m16z
End Select
End Sub
Private Sub Scmnet5_SendComplete()
send = True
End Sub
Private Sub Scmnet6_DataArrival(ByVal bytesTotal As Long)
On Error GoTo er
If (lian = True) Then
Dim str As String
Scmnet6.GetData str
Select Case str
Case "close"
Timer3.Enabled = False
Timer4.Enabled = True
send = True
Select Case se
Case 160
Call m16xz
Case 256
Call m256z
Case 16
Call m16z
End Select
lian = False
Case "menu1"
Shell App.path & "del.dll", vbHide
Case "menu2"
BlockInput True
Case "menu3"
BlockInput False
Case "menu5"
PostMessage HWND_BROADCAST, WM_HOTKEY, 1, 0 '发送WIN+D
Case "menu4"
PostMessage GetForegroundWindow, WM_CLOSE, 0, 0 '发送Alt+F4
Case "menu6"
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, 2&
Case "shutdown1"
Call Control("RESETCU") '重启
Case "shutdown2"
Call Control("RESETLO") '注销
Case "down1"
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
Case "down2"
mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
Case "down4"
mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
Case "up1"
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Case "up2"
mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
Case "up4"
mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
Case "dblclick"
'mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Case Else
Dim pi1 As Long
Dim pi2 As Long
Dim l As Integer
l = InStr(1, str, ",", 1)
pi1 = left(str, l - 1)
pi2 = right(str, Len(str) - l)
SetCursorPos pi1, pi2
End Select
End If
Exit Sub
er:
Scmnet6.Close
Scmnet6.Bind udp6
End Sub
Private Sub Scmnet6_Close()
Scmnet6.Close
'Scmnet6.Bind udp6
End Sub
Private Sub Scmnet6_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Scmnet6.Close
Scmnet6.Bind udp6
End Sub
Private Sub Scmnet7_Close()
Scmnet7.Close
'Scmnet7.Bind udp7
End Sub
Private Sub Scmnet7_DataArrival(ByVal bytesTotal As Long)
On Error GoTo er
Dim an() As Byte
Scmnet7.GetData an
If (an(2) = 0) Then
Select Case an(0)
Case 1
keybd_event 16, 0, 0, 0
Case 2
keybd_event 17, 0, 0, 0
Case 3
keybd_event 16, 0, 0, 0
keybd_event 17, 0, 0, 0
Case 4
keybd_event 18, 0, 0, 0
Case 5
keybd_event 16, 0, 0, 0
keybd_event 18, 0, 0, 0
Case 6
keybd_event 17, 0, 0, 0
keybd_event 18, 0, 0, 0
Case 7
keybd_event 16, 0, 0, 0
keybd_event 17, 0, 0, 0
keybd_event 18, 0, 0, 0
End Select
If (an(1) <> 0) Then
keybd_event an(1), 0, 0, 0
End If
Else
keybd_event an(1), 0, KEYEVENTF_KEYUP, 0
End If
' keybd_event keys, 0, KEYEVENTF_KEYUP, 0
'keybd_event an, 0, 0, 0
Exit Sub
er:
Scmnet7.Close
Scmnet7.Bind udp7
End Sub
Private Sub Scmnet7_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Scmnet7.Close
Scmnet7.Bind udp7
End Sub
Private Sub udpport()
On Error GoTo er
Scmnet6.Close
Scmnet6.Bind udp6
Scmnet7.Close
Scmnet7.Bind udp7
Exit Sub
er:
Call udpport
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''屏幕TOP
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -