'添加 Command1  List1
'故意拷一个文件到几个盘中的某一目录测试看是否都能搜寻到

 '支援通配符*.*与多项扩展名(当然 Dir 那行的代码得修改一下)
Option Explicit
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Dim objWMIService, objProcess, colProcesslist, Tmpstr$
Dim i%, j%, aa$, fname$, DriveNm$(), Filestr$(), Trec&, s

Private Sub Form_Unload(Cancel As Integer)
   Set Form1 = Nothing
   End
End Sub

Private Sub Command1_Click()
   ReDim Preserve Filestr$(0)
   Trec = 0: Filestr(0) = ""
   s = GetallDrive
   fname = "c:\tmpstr.txt"
   List1.Clear
   For i = 0 To UBound(s)
      If Dir(fname) <> "" Then Kill fname
      Me.Caption = Left(s(i), 1) & " 盘搜索中,请稍侯......!!"
      'Call Shell("cmd /c dir " & s(i) & "*.jpg /s/b >" & fname, vbHide) '支援通配符*.*与多项扩展名
      Call Shell("cmd /c dir " & s(i) & "calc.exe /s/b >" & fname, vbHide)
      Do
         DoEvents
         If Not Isrunexe("cmd.exe") Then Exit Do
      Loop
      If FileLen(fname) >= 4 Then
         Open fname For Input As #1
         While Not EOF(1)
            Line Input #1, aa
            ReDim Preserve Filestr$(Trec)
            Filestr(Trec) = aa
            List1.AddItem aa
            Trec = Trec + 1
         Wend
         Close #1
      End If
   Next i
   Me.Caption = "搜索完成!!"
   If Trec = 0 Then MsgBox "未搜索到欲查找的文件": Exit Sub
   '*******Filestr数组变量可以用在其它需要的地方
   'Me.Cls
   'For i = 0 To Trec - 1
   '   Print Filestr(i)
   'Next i
   MsgBox "共搜到 " & CStr(Trec) & " 个文件"
End Sub

Public Function GetallDrive() As String()
   j = 0
   For i = 65 To 90
      If GetDriveType(Chr(i) & ":\") = 3 Then
         ReDim Preserve DriveNm$(j)
         DriveNm(j) = Chr(i) & ":\"
         j = j + 1
      End If
   Next i
   GetallDrive = DriveNm()
End Function

Public Function Isrunexe(ExeNm As String) As Boolean
   Tmpstr = "."
   Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & Tmpstr & "\root\cimv2")
   Set colProcesslist = objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & ExeNm & "'")
   Isrunexe = IIf(colProcesslist.Count > 0, True, False)
   Set objWMIService = Nothing
   Set colProcesslist = Nothing
End Function
 

发表于 @ 2008年02月25日 23:52:00|评论(loading...)|编辑