📄 faws.frm
字号:
If ji < 1024 Then
jfns = "已接收:" & ji & "字节 "
ElseIf ji < 1048576 Then
jfns = ji / 1024
jfns = "已接收:" & Round(jfns, 2) & "KB "
ElseIf ji < 1073741824 Then
jfns = ji / 1024 / 1024
jfns = "已接收:" & Round(jfns, 2) & "MB "
ElseIf ji >= 1073741824 Then
jfns = ji / 1024 / 1024 / 1024
jfns = "已接收:" & Round(jfns, 2) & "GB "
End If
'''''''''''''''''''''''''''
If Rnbs < 1024 Then
fns = (ji / filesizes) * 100
Fapt.Label2.Caption = "(" & Filesizedb & jfns & " 剩余:" & Rnbs & "字节" & ")" & " 已完成" & fns & "%"
ElseIf Rnbs < 1048576 Then
fns = (ji / filesizes) * 100
Robs = Rnbs / 1024
Fapt.Label2.Caption = "(" & Filesizedb & jfns & "剩余:" & Round(Robs, 2) & "KB" & ")" & " 已完成:" & fns & "%"
ElseIf Rnbs < 1073741824 Then
fns = (ji / filesizes) * 100
Robs = Rnbs / 1024 / 1024
Fapt.Label2.Caption = "(" & Filesizedb & jfns & "剩余:" & Round(Robs, 2) & "MB" & ")" & " 已完成:" & fns & "%"
ElseIf Rnbs >= 1073741824 Then
fns = (ji / filesizes) * 100
Robs = Rnbs / 1024 / 1024 / 1024
Fapt.Label2.Caption = "(" & Filesizedb & jfns & "剩余:" & Round(Robs, 2) & "GB" & ")" & " 已完成:" & fns & "%"
End If
'''''''''''''''''''''''''''''''''''
If (ji = filesizes) Then
fileput = False
Close #1
'MsgBox "完成" '_______________________________________________
End If
End If
Exit Sub
er:
MsgBox "写入文件出错", 16, "出错"
fileput = False
Exit Sub
er1:
MsgBox "网络出现错误"
End Sub
Public Sub createfs(cfs As String)
On Error Resume Next
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
Dim g1 As Long
Dim g2 As String
Dim g4 As String
'Dim g3 As Long
g1 = 4
g2 = "\"
Do While (g1 <> 1)
g1 = InStr(g1, cfs, g2, 1)
If (g1 = 0) Then Exit Sub
g4 = Left(cfs, g1 - 1)
On Error Resume Next
fs.CreateFolder (g4)
g1 = g1 + 1
Loop
End Sub
Private Function filename(n As String) As String
On Error GoTo er
Dim path1 As String
path1 = Faws.ListView2.SelectedItem.Key
Dim b2 As String
Dim b1 As Long
Dim b3 As Long
Dim name As String
If (Right(path1, 1) = "\") Then
path1 = Left(path1, Len(path1) - 1)
End If
b2 = "\"
b1 = Len(path1)
Do While b1 >= 1
b1 = b1 - 1
b3 = InStr(b1, path1, b2, 1)
If (b3 > 0) Then
Exit Do
End If
Loop
name = Mid(n, b3 + 1)
filename = name
''''''''''''''''
Exit Function
er:
MsgBox "出错号001"
End Function
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)
On Error Resume Next
MsgBox "网络连接出错！", 16
Scmnet3.Close
Scmnet3.Listen
Unload Fapt
'Unload Me
End Sub
Private Sub Scmnet3_SendComplete()
On Error Resume Next
Select Case fileinfo
Case 1
fileinfo = 2
Sleep (100)
Call file2
Case 2
Call file2
Case 5
fileinfo = 0
Close #1
Sleep (100)
Call list1tolist2(0)
Case 6
Sleep (100)
Call list2_list1
End Select
End Sub
Private Sub Scmnet4_DataArrival(ByVal bytesTotal As Long)
On Error GoTo er
Dim b1 As Long
Dim b As Long
Dim b2 As String
Dim b3 As Long
Dim k As String
Scmnet4.GetData k
Dim a1 As String '接收类型 0 为驱动器 1 为文件夹 2 为文件
Dim a2 As String 'a1=0 时为磁盘类型,其它为空
Dim a3 As String 'a1=0 时为盘符 其它为路径
Dim S As String '为磁盘名称
a1 = Left(k, 1)
Select Case a1
Case 0
a2 = Mid(k, 2, 1)
a3 = Right(k, Len(k) - 2)
Select Case a2
Case 0
S = "未知设备(" & a3 & ":)"
ListView2.ListItems.Add , a3 & ":\", S, 7
Combo2.AddItem S
Case 1
S = "移动磁盘(" & a3 & ":)"
ListView2.ListItems.Add , a3 & ":\", S, 8
Combo2.AddItem S
Case 2
S = "本地磁盘(" & a3 & ":)"
ListView2.ListItems.Add , a3 & ":\", S, 2
Combo2.AddItem S
Case 3
S = "网络磁盘(" & a3 & ":)"
ListView2.ListItems.Add , a3 & ":\", S, 7
Combo2.AddItem S
Case 4
S = "光盘驱动器(" & a3 & ":)"
ListView2.ListItems.Add , a3 & ":\", S, 3
Combo2.AddItem S
Case 5
S = "RAM DISK(" & a3 & ":)"
ListView2.ListItems.Add , a3 & ":\", S, 7
Combo2.AddItem S
Case 8
S = "[" & Rcname & "]" & "的文档"
ListView2.ListItems.Add , a3 & "\", S, 1 '已修改 以前没有a3 "\"改为"文档"
Combo2.AddItem S
x文档 = a3 & "\"
Case 9
S = "[" & Rcname & "]" & "的桌面"
ListView2.ListItems.Add , a3 & "\", S, 9 '已修改 以前没有a3 "\"改为"桌面"
Combo2.AddItem S
desktoppath = a3 & "\"
End Select
Case 1
a3 = Right(k, Len(k) - 1)
b2 = "\"
b1 = Len(a3)
Do While b1 >= 1
b1 = b1 - 1
b3 = InStr(b1, a3, b2, 1)
If (b3 > 0) Then
Exit Do
End If
Loop
a2 = Right(a3, Len(a3) - b3)
ListView2.ListItems.Add , a3 & "\", a2, 1
Case 2
a3 = Right(k, Len(k) - 1)
b2 = "\"
b1 = Len(a3)
Do While b1 >= 1
b1 = b1 - 1
b3 = InStr(b1, a3, b2, 1)
If (b3 > 0) Then
Exit Do
End If
Loop
a2 = Right(a3, Len(a3) - b3)
Dim index As Long
index = udpico(a2)
ListView2.ListItems.Add , a3, a2, index
Case 4
ListView2.ListItems.Clear
Case 5
MsgBox "文件或文件夹拒绝访问！", 16, "出错"
Call Toolbar2_ButtonClick(Toolbar2.Buttons(1))
Case 6
MsgBox "已存在一个名为“远程传输-新建文件夹”的文件夹，或其它原因，创建文件夹失败！", 16, "出错"
Case 7
ListView2.ListItems.Clear
Combo2.Clear
Combo2.AddItem "[" & Rcname & "]" & "的电脑"
Combo2.SelText = "[" & Rcname & "]" & "的电脑"
End Select
Exit Sub
er:
MsgBox "未处理"
End Sub
Private Sub Scmnet4_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)
Scmnet4.Close
Scmnet4.Bind Puport1
Call UDP_P
End Sub
Public Sub computer()
On Error Resume Next
StatusBar1.Panels(2).Text = "我的电脑"
StatusBar1.Panels(2).ToolTipText = "我的电脑"
Toolbar1.Buttons(1).Enabled = False
Toolbar1.Buttons(2).Enabled = False
Toolbar1.Buttons(3).Enabled = False
Toolbar1.Buttons(4).Enabled = False
ListView1.ListItems.Clear
Dim index As Long
Dim f
Dim path As String
Dim fc, f1, fs, d, dc
Dim S As String
Set fs = CreateObject("Scripting.FileSystemObject")
Dim pi As String
list1key = ""
Set dc = fs.Drives
For Each d In dc
pi = d.DriveLetter
Select Case d.DriveType
Case 0
S = "未知设备(" & d.DriveLetter & ":)"
ListView1.ListItems.Add , pi & ":\", S, 7
Case 1
S = "移动磁盘(" & d.DriveLetter & ":)"
ListView1.ListItems.Add , pi & ":\", S, 8
Case 2
S = "本地磁盘(" & d.DriveLetter & ":)"
ListView1.ListItems.Add , pi & ":\", S, 2
Case 3
S = "网络磁盘(" & d.DriveLetter & ":)"
ListView1.ListItems.Add , pi & ":\", S, 7
Case 4
S = "光盘驱动器(" & d.DriveLetter & ":)"
ListView1.ListItems.Add , pi & ":\", S, 3
Case 5
S = "RAM DISK(" & d.DriveLetter & ":)"
ListView1.ListItems.Add , pi & ":\", S, 7
End Select
Next
'列出我的文档桌面__________________________________ 后加
ListView1.ListItems.Add , regread("personal") & "\", "我的文档", 1
ListView1.ListItems.Add , regread("desktop") & "\", "桌面", 9
End Sub
Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
mu1 = 1
Dim Ptype As String
If Button = 1 Then ' 检查是否单击了鼠标右键。
'PopupMenu file1, vbPopupMenuLeftAlign ' 把文件菜单显示为一个弹出式菜单。
Else
Sendfile1.Enabled = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Ptype = LCase(Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - InStrRev(ListView1.SelectedItem.Key, ".")))
Cwallpaper.Enabled = False
Select Case Ptype
Case "jpg", "bmp", "gif", "ico", "png"
Cwallpaper.Enabled = True
End Select
''''''''''''''''''''''''''''''''''''''''''''''''''''''
PopupMenu file1, vbPopupMenuLeftAlign ' 把文件菜单显示为一个弹出式菜单。
End If
End Sub
Private Sub ListView2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
mu1 = 2
Dim Ptype As String
If Button = 1 Then ' 检查是否单击了鼠标右键。
'PopupMenu file1, vbPopupMenuLeftAlign ' 把文件菜单显示为一个弹出式菜单。
Else
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Ptype = LCase(Right(ListView2.SelectedItem.Key, Len(ListView2.SelectedItem.Key) - InStrRev(ListView2.SelectedItem.Key, ".")))
Cwallpaper.Enabled = False
Select Case Ptype
Case "jpg", "bmp", "gif", "ico", "png"
Cwallpaper.Enabled = True
End Select
''''''''''''''''''''''''''''''''''''''''''''''''''''''
PopupMenu file1, vbPopupMenuLeftAlign ' 把文件菜单显示为一个弹出式菜单。
End If
End Sub
Private Sub ListView1_keypress(keyascii As Integer)
Select Case keyascii
Case "13"
Call Open1_Click
Case "32"
Call Rfiles_Click
Case "46"
Call Delfiles_Click
Case "27"
Call Exitwin_Click
End Select
End Sub
Private Sub ListView2_KeyPress(keyascii As Integer)
Select Case keyascii
Case "13"
Call Open1_Click
Case "32"
Call Rfiles_Click
Case "46"
Call Delfiles_Click
Case "27"
Call Exitwin_Click
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -