fcopy.frm

with this program you can search your whole driver and list all files in a tree view box.

Private Sub mdel_Click()
  tp = List3.ListIndex
  List3.RemoveItem List3.ListIndex
  List1.ListIndex = tp
  List1.RemoveItem List1.ListIndex
  List2.ListIndex = tp
  List2.RemoveItem List2.ListIndex
  List4.ListIndex = tp
  size = size - Val(List4.Text)
  List4.RemoveItem List4.ListIndex
  
  If size < 0 Then size = 0
  If List3.ListCount = 0 Then size = 0
  If size > 1048576 Then
    Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1048576) + "." + Mid(CStr(size / 1048576 - size \ 1048576), 3, 2) + " Mb"
  Else
    Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1024) + "." + Mid(CStr(size / 1024 - size \ 1024), 3, 2) + " Kb"
  End If
  
  If tp > List3.ListCount - 1 Then
     List3.ListIndex = List3.ListCount - 1
  Else
     List3.ListIndex = tp
  End If
  
  If List3.ListCount = 0 Then str = ""

End Sub

Private Sub mdelaf_Click()
On Error Resume Next
 
f1 = MsgBox(Chr(13) + "是否清除列表中的" + CStr(List3.ListCount) + "个磁盘文件？  " + Chr(13) + Chr(13) + "警告：清除后将无法恢复。", vbYesNo + vbQuestion)
If f1 = 6 Then
  f2 = MsgBox(Chr(13) + "严重警告：清除后将无法恢复。" + Chr(13) + Chr(13) + "的确需要清除列表中的" + CStr(List3.ListCount) + "个磁盘文件？  ", vbYesNo + vbExclamation)
  If f2 = 6 Then
    List3.Visible = False
    For k = 0 To List3.ListCount - 1
      List3.ListIndex = k
      SetAttr List3.Text, vbArchive
      Kill List3.Text
      Call mdel_Click
    Next k
    List3.Visible = True
  End If
  str = ""
End If

End Sub

Private Sub mdelall_Click()
List1.Clear
List2.Clear
List3.Clear
str = ""
size = 0
If size > 1048576 Then
  Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1048576) + "." + Mid(CStr(size / 1048576 - size \ 1048576), 3, 2) + " Mb"
Else
  Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1024) + "." + Mid(CStr(size / 1024 - size \ 1024), 3, 2) + " Kb"
End If

End Sub

Private Sub mdelf_Click()
On Error GoTo err
 f2 = MsgBox(Chr(13) + List3.Text + "  " + Chr(13) + Chr(13) + "是否删除这个磁盘文件？  ", vbYesNo + vbQuestion)
 If f2 = 6 Then
   SetAttr List3.Text, vbArchive
   Kill List3.Text
   Call mdel_Click
   If List3.ListCount = 0 Then str = ""
 End If
Exit Sub
err:
MsgBox Chr(13) + List3.Text + "  " + Chr(13) + Chr(13) + "无法删除这个磁盘文件。  ", vbCritical

End Sub

Private Sub mnext_Click()
Dim pos As Integer
Dim cindex As Integer
Me.Refresh
cindex = List3.ListIndex
fm.Visible = False
List3.Visible = False
Label3.Caption = "正在查找：关键字“" + str + "”..."
If cindex = List3.ListCount - 1 Then
  MsgBox Chr(13) + "已经搜索完整个列表！", vbInformation
  If size > 1048576 Then
    Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1048576) + "." + Mid(CStr(size / 1048576 - size \ 1048576), 3, 2) + " Mb"
  Else
    Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1024) + "." + Mid(CStr(size / 1024 - size \ 1024), 3, 2) + " Kb"
  End If
  List3.Visible = True
  fm.Visible = True
  Exit Sub
Else
pos = cindex + 1
For k = pos To List3.ListCount - 1
  List3.ListIndex = k
  List2.ListIndex = k
  List1.ListIndex = k
  If compstr(str, UCase(List3.Text)) = True Then
    If size > 1048576 Then
      Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1048576) + "." + Mid(CStr(size / 1048576 - size \ 1048576), 3, 2) + " Mb"
    Else
      Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1024) + "." + Mid(CStr(size / 1024 - size \ 1024), 3, 2) + " Kb"
    End If
    List3.Visible = True
    fm.Visible = True
    Exit Sub
  End If
Next k
End If
Beep
MsgBox Chr(13) + "已经搜索完整个列表！", vbInformation
If size > 1048576 Then
  Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1048576) + "." + Mid(CStr(size / 1048576 - size \ 1048576), 3, 2) + " Mb"
Else
  Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1024) + "." + Mid(CStr(size / 1024 - size \ 1024), 3, 2) + " Kb"
End If
List3.ListIndex = cindex
List2.ListIndex = cindex
List1.ListIndex = cindex
List3.Visible = True
fm.Visible = True

End Sub

Private Sub mopen_Click()
Call List3_DblClick
End Sub

Private Sub msave_Click()
Dim outf As String
rep:
outf = ""
outf = InputBox(Chr(13) + Chr(13) + "文件大小：" + CStr(Val(List4.Text) \ 1024) + "." + Mid(List4.Text, 3, 2) + " Kb" + Chr(13) + Chr(13) + "输入目标路径：", "文件复制")
On Error GoTo er
If outf <> "" Then
  If Right(outf, 1) <> "\" Then outf = outf + "\"
  If Dir(outf, vbDirectory) = "" Then
    MsgBox Chr(13) + "非法路径！  " + Chr(13) + Chr(13) + "请重新输入目标路径。 ", vbCritical
    GoTo rep
  Else
    If Dir(outf + List1.Text, vbDirectory + vbArchive + vbHidden + vbReadOnly) <> "" Then
      ret = MsgBox(Chr(13) + "已经存在文件：" + outf + List1.Text + "  " + Chr(13) + Chr(13) + "是否覆盖？", vbYesNo + vbQuestion)
      If ret = 6 Then
        FileCopy List3.Text, outf + List1.Text
        MsgBox Chr(13) + List3.Text + "  " + Chr(13) + Chr(13) + "复制成功到：" + Chr(13) + Chr(13) + UCase(outf + List1.Text) + "  ", vbInformation
      End If
    Else
        FileCopy List3.Text, outf + List1.Text
        MsgBox Chr(13) + List3.Text + "  " + Chr(13) + Chr(13) + "复制成功到：" + Chr(13) + Chr(13) + UCase(outf + List1.Text) + "  ", vbInformation
    End If
  End If
End If

Exit Sub
er:
MsgBox Chr(13) + "无法复制：" + List3.Text + "  " + Chr(13) + Chr(13) + "到：" + outf + List2.Text + List1.Text + Chr(13) + Chr(13) + "目标盘中没有足够的空间或存在同名的只读文件！  ", vbCritical

End Sub


Private Sub mseekf_Click()
Dim cindex As Integer
cindex = List3.ListIndex
str = ""
str = InputBox(Chr(13) + Chr(13) + Chr(13) + Chr(13) + "输入待查找信息：", "定位")
str = UCase(Trim(str))
If str <> "" Then
Me.Refresh
fm.Visible = False
List3.Visible = False
Label3.Caption = "正在查找：关键字“" + str + "”..."
For k = 0 To List3.ListCount - 1
  List3.ListIndex = k
  List2.ListIndex = k
  List1.ListIndex = k
  If compstr(str, UCase(List3.Text)) = True Then
    If size > 1048576 Then
      Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1048576) + "." + Mid(CStr(size / 1048576 - size \ 1048576), 3, 2) + " Mb"
    Else
      Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1024) + "." + Mid(CStr(size / 1024 - size \ 1024), 3, 2) + " Kb"
    End If
    List3.Visible = True
    fm.Visible = True
    Exit Sub
  End If
Next k
Beep
MsgBox Chr(13) + "已经搜索完整个列表！", vbInformation
If size > 1048576 Then
  Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1048576) + "." + Mid(CStr(size / 1048576 - size \ 1048576), 3, 2) + " Mb"
Else
  Label3.Caption = "搜索结果列表：" + CStr(List3.ListCount) + " 个文件，占用磁盘空间：" + CStr(size \ 1024) + "." + Mid(CStr(size / 1024 - size \ 1024), 3, 2) + " Kb"
End If
List3.ListIndex = cindex
List2.ListIndex = cindex
List1.ListIndex = cindex
List3.Visible = True
fm.Visible = True
End If

End Sub

Private Sub Text1_Change()
If Text1.Text <> "" Then
  Command1.Enabled = True
Else
  Command1.Enabled = False
End If
fm1.Caption = "搜索: " + disk + Text1.Text

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
  If Command1.Enabled = True Then Call Command1_Click
End If
End Sub


Public Sub alf(ByVal sdn As String, ByVal ff As String)
Dim sn As String, sf As String
Dim sdl() As String, idn As Long, i As Long


On Error GoTo err
Label3.Caption = "正在搜索：" + sdn
Label3.Refresh
sf = Dir(sdn + ff, vbArchive + vbHidden + vbReadOnly + vbSystem)
Do While Len(sf) > 0
   sf = UCase(Trim(sf))
   List3.AddItem sdn + sf
   List1.AddItem sf
   List2.AddItem Mid(sdn, 3)
   size = size + FileLen(sdn + sf)
   List4.AddItem CStr(FileLen(sdn + sf))
   sf = Dir
   DoEvents
Loop
   
idn = 0
sn = Dir(sdn + "*.*", vbDirectory + vbArchive + vbHidden + vbReadOnly + vbSystem)
Do While Len(sn) > 0
   If sn <> "." And sn <> ".." Then
      idn = idn + 1
      ReDim Preserve sdl(1 To idn)
      sdl(idn) = sdn + sn + "\"
   End If
   sn = Dir
   DoEvents
Loop

For i = 1 To idn
  alf sdl(i), ff
Next

err:
Exit Sub

End Sub

Function mdir(pa As String)
On Error Resume Next
For k = 4 To Len(pa)
  If Mid(pa, k, 1) = "\" Then
    If Dir(Left(pa, k - 1)) = "" Then
      MkDir Left(pa, k - 1)
    End If
  End If
Next k


End Function

Private Sub Timer1_Timer()
On Error Resume Next
  fp.Image2.Visible = False
  For k = st To List3.ListCount - 1
    List3.ListIndex = k
    ' 获取被拖动的文件名的最后 3 个字母。
    temp = LCase(Right$(List3.Text, 3))
    dropfile = List3.Text
    Select Case UCase$(Trim$(temp))
    Case "BMP"
        fp.Image1.Picture = LoadPicture(dropfile)
        GoTo bg
    Case "GIF"
        fp.Image1.Picture = LoadPicture(dropfile)
        GoTo bg
    Case "JPG"
        fp.Image1.Picture = LoadPicture(dropfile)
        GoTo bg
    End Select
  Next k

fc.Timer1.Enabled = False
fp.Hide
fc.Show
MsgBox Chr(13) + "已经显示完搜索结果列表中的图片！ ", vbExclamation
bg:
  If Timer1.Interval <> 2000 Then Timer1.Interval = 2000
  fp.Image2.Stretch = False
  fp.Image2.Picture = fp.Image1.Image
  If fp.Image1.Width > Screen.Width Or fp.Image2.Height > Screen.Height Then
    fp.Image2.Width = fp.Image1.Width / 2
    fp.Image2.Height = fp.Image1.Height / 2
    fp.Image2.MousePointer = 99
  Else
    fp.Image2.MousePointer = 0
  End If
  fp.Image2.Left = (Screen.Width - fp.Image2.Width) / 2
  fp.Image2.Top = (Screen.Height - fp.Image2.Height) / 2
  fp.Image2.Stretch = True
  fp.Image2.Visible = True

If st > List3.ListCount - 1 Then
  fc.Timer1.Enabled = False
  fp.Hide
  fc.Show
End If
st = st + 1

End Sub

Public Function compstr(str1 As String, str2 As String) As Boolean
Dim ts As String
Dim i As Integer
compstr = False
If str1 = "" Or str2 = "" Or Len(str1) > Len(str2) Then
  compstr = False
  GoTo et
End If
For i = 1 To (Len(str2) - Len(str1) + 1)
  ts = Mid(str2, i, Len(str1))
  If ts = str1 Then
    compstr = True
    GoTo et
  End If
Next i
et:

End Function