📄 faws.frm
字号:
S = f1.name
index = icoindex(f1.path, S)
ListView1.ListItems.Add , f1.path, S, index
Next
list1key = path & "\"
StatusBar1.Panels(2).Text = list1key
StatusBar1.Panels(2).ToolTipText = list1key
Exit Sub
End Select
Dim a2 As String
a2 = "("
Dim b1 As Long
b1 = InStr(1, a1, a2, 1)
path = Mid(a1, b1 + 1, 2)
On Error GoTo er:
Set f = fs.GetFolder(path & "\")
Set fc = f.SubFolders
For Each f1 In fc
S = f1.name
ListView1.ListItems.Add , f1.path & "\", S, 1
Next
Set fc = f.Files
For Each f1 In fc
S = f1.name
index = icoindex(f1.path, S)
ListView1.ListItems.Add , f1.path, S, index
Next
list1key = path & "\"
StatusBar1.Panels(2).Text = list1key
StatusBar1.Panels(2).ToolTipText = list1key
Exit Sub
er:
MsgBox "选择的驱动器没有准备好！", vbOKOnly, "出错"
Toolbar1.Buttons(3).Enabled = False
Call computer
list1key = ""
End Sub
Private Sub Combo2_Click()
On Error GoTo Combo2Err
Toolbar2.Buttons(4).Enabled = True
Toolbar2.Buttons(2).Enabled = True
Dim a1 As String
Dim a2 As String
a2 = "("
a1 = Combo2.Text
Dim b1 As Long
b1 = InStr(1, a1, a2, 1)
Dim path As String
If (b1 > 0) Then
path = Mid(a1, b1 + 1, 2)
list2path = path & "\"
Scmnet3.SendData "1" & path & "\"
Else
a2 = Right(a1, 2)
Select Case a2
Case "电脑"
Toolbar2.Buttons(4).Enabled = False
Toolbar2.Buttons(2).Enabled = False
list2path = ""
Scmnet3.SendData "3"
Case "文档"
list2path = x文档
Scmnet3.SendData "1" & x文档
Case "桌面"
list2path = desktoppath
Scmnet3.SendData "1" & desktoppath
End Select
End If
If (list2path <> "") Then
StatusBar2.Panels(2).Text = Rcname & "\\" & list2path
StatusBar2.Panels(2).ToolTipText = Rcname & "\\" & list2path
Else
StatusBar2.Panels(2).Text = "[" & Rcname & "]" & "的电脑"
End If
Exit Sub
Combo2Err:
MsgBox "网络连接错误", 16, "错误"
End Sub
Private Sub Cwallb_Click()
If mu1 = 1 Then
CWallp = "Cwallpb"
Call Wallpaper_s(ListView1.SelectedItem.Key)
ElseIf mu1 = 2 Then
Call Sendinfor("Cwallpb" & ListView2.SelectedItem.Key)
End If
End Sub
Private Sub Cwallk_Click()
If mu1 = 1 Then
CWallp = "Cwallpk"
Call Wallpaper_s(ListView1.SelectedItem.Key)
ElseIf mu1 = 2 Then
Call Sendinfor("Cwallpk" & ListView2.SelectedItem.Key)
End If
End Sub
Private Sub Cwallm_Click()
If mu1 = 1 Then
CWallp = "Cwallpm"
Call Wallpaper_s(ListView1.SelectedItem.Key)
ElseIf mu1 = 2 Then
Call Sendinfor("Cwallpm" & ListView2.SelectedItem.Key)
End If
End Sub
Private Sub Delfiles_Click()
On Error Resume Next
If mu1 = 1 Then
''''''''''''''''''''''''''''''''''''''''''''''''''''
If MsgBox("你确定要删除“" & ListView1.SelectedItem.Text & "”吗！", vbYesNo, "提示") = vbYes Then
strPathName = ListView1.SelectedItem.Key
Call Delfiles_Del
ListView1.ListItems.Remove (ListView1.SelectedItem.index)
ListView1.Sorted = True
End If
''''''''''''''''''''''''''''''''''''''
ElseIf mu1 = 2 Then
''''''''''''''''''''''''''''''''''''''''''
If MsgBox("你确定要删除“" & ListView2.SelectedItem.Text & "”吗！", vbYesNo, "提示") = vbYes Then
Scmnet3.SendData "9" & ListView2.SelectedItem.Key
ListView2.ListItems.Remove (ListView2.SelectedItem.index)
ListView2.Sorted = True
End If
''''''''''''''''''''''''''''''
End If
End Sub
Private Sub Enews_Click()
On Error Resume Next
Dim path As String
Dim a1 As String
Select Case mu1
Case "1"
l1f2 = list1key
Dim fc, f1, fs, d, dc
Dim S As String
'Dim path As String
path = list1key
'Dim a1 As String
a1 = Right(path, 1)
If (a1 <> "\") Then Exit Sub
Dim f
Set fs = CreateObject("Scripting.FileSystemObject")
ListView1.ListItems.Clear
list1key = path
On Error GoTo er
Set f = fs.GetFolder(path)
Set fc = f.SubFolders
For Each f1 In fc
S = f1.name
ListView1.ListItems.Add , f1.path & "\", S, 1
Next
Set fc = f.Files
For Each f1 In fc
S = f1.name
Dim index As Long
index = icoindex(f1.path, S)
ListView1.ListItems.Add , f1.path, S, index
Next
StatusBar1.Panels(2).Text = list1key
StatusBar1.Panels(2).ToolTipText = list1key
'新加对控制按钮的处理程序
Toolbar1.Buttons(1).Enabled = True
Toolbar1.Buttons(2).Enabled = True
Toolbar1.Buttons(3).Enabled = True
Toolbar1.Buttons(4).Enabled = False
'______________________________结束
Exit Sub
er:
MsgBox "拒绝访问！", vbOKOnly, "出错"
Call Toolbar1_ButtonClick(Toolbar1.Buttons(1))
Toolbar1.Buttons(3).Enabled = False
Case "2"
Toolbar2.Buttons(1).Enabled = True
Toolbar2.Buttons(2).Enabled = True
'Dim path As String
path = list2path
Select Case path
Case "文档"
Scmnet3.SendData "1" & x文档
list2path = x文档
Case "桌面"
Scmnet3.SendData "1" & desktoppath
list2path = desktoppath
Case Else
'Dim a1 As String
a1 = Right(path, 1)
If (a1 <> "\") Then Exit Sub
list2path = path
Scmnet3.SendData "1" & path
End Select
If (list2path <> "") Then
StatusBar2.Panels(2).Text = Rcname & "\\" & list2path
StatusBar2.Panels(2).ToolTipText = Rcname & "\\" & list2path
Else
StatusBar2.Panels(2).Text = "[" & Rcname & "]" & "的电脑"
End If
End Select
End Sub
Private Sub Exitwin_Click()
If MsgBox("你确定要退出吗！", vbYesNo, "提示") = vbYes Then
Scmnet3.Close
Scmnet4.Close
Unload Me
End If
End Sub
Private Sub Form_Load()
'界面设计____________________________________
On Error Resume Next
Frame1.Move 60, 0, Me.ScaleWidth / 2 - Frame3.Width / 2, Me.ScaleHeight
Frame2.Move Me.ScaleWidth / 2 + Frame3.Width / 2.5, 0, Me.ScaleWidth / 2 - Frame3.Width / 2, Me.ScaleHeight
Frame3.Move Frame1.Width * 4
ListView1.Move 100, 1400, Frame1.Width + 50, Frame1.Height - 1600 - StatusBar1.Height
ListView2.Move 100, 1400, Frame2.Width + 50, Frame2.Height - 1600 - StatusBar2.Height
Toolbar1.Width = Frame1.Width + 10
Toolbar2.Width = Frame2.Width + 10
Combo1.Width = Frame2.Width - 1420
Combo2.Width = Frame2.Width - 1548
StatusBar1.Top = Frame1.Height - 100 - StatusBar1.Height
StatusBar2.Top = Frame2.Height - 100 - StatusBar2.Height
StatusBar1.Width = Frame1.Width + 20
StatusBar2.Width = Frame2.Width + 20
StatusBar1.Left = 100
StatusBar2.Left = 100
StatusBar1.Panels(1).Width = 1000
StatusBar1.Panels(2).Width = StatusBar1.Width - 1000
StatusBar2.Panels(1).Width = 1000
StatusBar2.Panels(2).Width = StatusBar2.Width - 1000
StatusBar1.Panels(2).Text = "我的电脑"
Toolbar1.Buttons(1).Enabled = False
Toolbar1.Buttons(2).Enabled = False
Toolbar1.Buttons(3).Enabled = False
Toolbar1.Buttons(4).Enabled = False
Toolbar2.Buttons(1).Enabled = False
Toolbar2.Buttons(2).Enabled = False
Toolbar2.Buttons(3).Enabled = False
Toolbar2.Buttons(4).Enabled = False
Cwallpaper.Enabled = False
On Error Resume Next
imageindex = 9
ReDim imagel(0)
Dim str As String
str = Command
Dim k1 As String
Dim k2 As String
k1 = Left(str, 3)
k2 = Right(str, Len(str) - 3)
'Image1.Picture = LoadResPicture(101, 0)
'Image2.Picture = LoadResPicture(103, 0)
'初始化combo1中的本机驱动器
Dim fs, d, dc, S, n
Dim pi As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
pi = d.DriveLetter
Select Case d.DriveType
Case 0
S = "未知设备(" & d.DriveLetter & ":)"
Combo1.AddItem S
ListView1.ListItems.Add , pi & ":\", S, 7
Case 1
S = "移动磁盘(" & d.DriveLetter & ":)"
Combo1.AddItem S
ListView1.ListItems.Add , pi & ":\", S, 8
Case 2
S = "本地磁盘(" & d.DriveLetter & ":)"
Combo1.AddItem S
ListView1.ListItems.Add , pi & ":\", S, 2
Case 3
S = "网络磁盘(" & d.DriveLetter & ":)"
Combo1.AddItem S
ListView1.ListItems.Add , pi & ":\", S, 7
Case 4
S = "光盘驱动器(" & d.DriveLetter & ":)"
Combo1.AddItem S
ListView1.ListItems.Add , pi & ":\", S, 3
Case 5
S = "RAM DISK(" & d.DriveLetter & ":)"
Combo1.AddItem S
ListView1.ListItems.Add , pi & ":\", S, 7
End Select
Next
'列出我的文档桌面__________________________________ 后加
ListView1.ListItems.Add , regread("personal") & "\", "我的文档", 1
ListView1.ListItems.Add , regread("desktop") & "\", "桌面", 9
Combo1.AddItem "我的文档"
Combo1.AddItem "桌面"
Combo1.AddItem "我的电脑", 0
Combo1.SelText = "我的电脑"
'初始化listview1内的内容
End Sub
Private Sub Form_Resize()
'界面设计____________________________________
On Error Resume Next
Frame1.Move 60, 0, Me.ScaleWidth / 2 - Frame3.Width / 2, Me.ScaleHeight
Frame2.Move Me.ScaleWidth / 2 + Frame3.Width / 2.5, 0, Me.ScaleWidth / 2 - Frame3.Width / 2, Me.ScaleHeight
Frame3.Move Frame1.Width * 4
ListView1.Move 100, 1400, Frame1.Width + 50, Frame1.Height - 1600 - StatusBar1.Height
ListView2.Move 100, 1400, Frame2.Width + 50, Frame2.Height - 1600 - StatusBar2.Height
Toolbar1.Width = Frame1.Width + 10
Toolbar2.Width = Frame2.Width + 10
Combo1.Width = Frame2.Width - 1420
Combo2.Width = Frame2.Width - 1548
StatusBar1.Top = Frame1.Height - 100 - StatusBar1.Height
StatusBar2.Top = Frame2.Height - 100 - StatusBar2.Height
StatusBar1.Width = Frame1.Width + 20
StatusBar2.Width = Frame2.Width + 20
StatusBar1.Left = 100
StatusBar2.Left = 100
StatusBar1.Panels(1).Width = 1000
StatusBar1.Panels(2).Width = StatusBar1.Width - 1000
StatusBar2.Panels(1).Width = 1000
StatusBar2.Panels(2).Width = StatusBar2.Width - 1000
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload Fapt
End Sub
Public Sub clickimage()
On Error Resume Next
Dim g1 As Long '在list2中枚举用的索引
Dim g2 As Long '为list2中对象的共个数
Dim g3 As Long '记录选中对象的个数
g2 = ListView2.ListItems.Count
For g1 = 1 To g2 Step 1
If (ListView2.ListItems(g1).Selected = True) Then
ReDim Preserve list2paths(g3)
list2paths(g3) = ListView2.ListItems(g1).Key
g3 = g3 + 1
End If
Next
End Sub
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Image1.Picture = LoadResPicture(106, 0)
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Image1.Picture = LoadResPicture(102, 0)
Timer1.Enabled = True
End Sub
'重写可发送文件夹对象的程序
Public Sub clickimage2()
On Error Resume Next
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -