frmsearch.frm

分别用DIR与API扫描硬盘上的所有文件

VERSION 5.00
Begin VB.Form frmsearch 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Find all files demo"
   ClientHeight    =   3750
   ClientLeft      =   45
   ClientTop       =   360
   ClientWidth     =   6930
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3750
   ScaleWidth      =   6930
   StartUpPosition =   3  'Windows Default
   Begin VB.CheckBox chkhidelist 
      Caption         =   "Hide lists when searching"
      Height          =   495
      Left            =   360
      TabIndex        =   7
      Top             =   1560
      Value           =   1  'Checked
      Width           =   2895
   End
   Begin VB.CommandButton cmdgo 
      Caption         =   "Do search"
      Height          =   615
      Left            =   240
      TabIndex        =   6
      Top             =   2160
      Width           =   3015
   End
   Begin VB.Frame framethod 
      Caption         =   "Search Method"
      Height          =   1215
      Left            =   240
      TabIndex        =   2
      Top             =   240
      Width           =   3015
      Begin VB.OptionButton optapi 
         Caption         =   "Use API"
         Height          =   495
         Left            =   120
         TabIndex        =   4
         Top             =   600
         Width           =   2535
      End
      Begin VB.OptionButton optdir 
         Caption         =   "Use DIR function"
         Height          =   495
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Value           =   -1  'True
         Width           =   2295
      End
   End
   Begin VB.ListBox lstdirs 
      Height          =   1425
      Left            =   3600
      TabIndex        =   1
      Top             =   2160
      Width           =   3135
   End
   Begin VB.ListBox lstfiles 
      Height          =   1815
      Left            =   3600
      TabIndex        =   0
      Top             =   240
      Width           =   3135
   End
   Begin VB.Label lbltime 
      Caption         =   "Time taken: 0 second(s)"
      Height          =   615
      Left            =   240
      TabIndex        =   5
      Top             =   2880
      Width           =   3015
      WordWrap        =   -1  'True
   End
End
Attribute VB_Name = "frmsearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdgo_Click()
Dim starttime As Single

lstfiles.Clear

starttime = Timer

If chkhidelist = vbChecked Then
  lstdirs.Visible = False
  lstfiles.Visible = False
End If

lstdirs.AddItem "C:\"

Do
  lbltime = "Searching . . . " & lstdirs.List(0)
  If optdir = True Then
    findfilesdir lstdirs.List(0), "*.*"
  Else
    findfilesapi lstdirs.List(0), "*.*"
  End If
  
  lstdirs.RemoveItem 0
Loop Until lstdirs.ListCount = 0

lstdirs.Visible = True
lstfiles.Visible = True

lbltime = "Time taken: " & Timer - starttime & " seconds"

End Sub

Sub findfilesapi(DirPath As String, FileSpec As String)
Dim FindData As WIN32_FIND_DATA
Dim FindHandle As Long
Dim FindNextHandle As Long
Dim filestring As String

DirPath = Trim$(DirPath)

If Right(DirPath, 1) <> "\" Then
  DirPath = DirPath & "\"
End If

' Find the first file in the selected directory

FindHandle = FindFirstFile(DirPath & FileSpec, FindData)
If FindHandle <> 0 Then
  If FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
    ' It's a directory
    If Left$(FindData.cFileName, 1) <> "." And Left$(FindData.cFileName, 2) <> ".." Then
      filestring = DirPath & Trim$(FindData.cFileName) & "\"
      lstdirs.AddItem filestring
    End If
  Else
    filestring = DirPath & Trim$(FindData.cFileName)
    lstfiles.AddItem filestring
  End If
End If

' Now loop and find the rest of the files
If FindHandle <> 0 Then
  Do
  
    DoEvents
    
    FindNextHandle = FindNextFile(FindHandle, FindData)
    If FindNextHandle <> 0 Then
      If FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
        ' It's a directory
        If Left$(FindData.cFileName, 1) <> "." And Left$(FindData.cFileName, 2) <> ".." Then
          filestring = DirPath & Trim$(FindData.cFileName) & "\"
          lstdirs.AddItem filestring
        End If
      Else
        filestring = DirPath & Trim$(FindData.cFileName)
        lstfiles.AddItem filestring
      End If
    Else
      Exit Do
    End If
  Loop
End If

' It is important that you close the handle for FindFirstFile
Call FindClose(FindHandle)

End Sub


Public Sub findfilesdir(DirPath As String, FileSpec As String)
Dim filestring As String

DirPath = Trim$(DirPath)

If Right$(DirPath, 1) <> "\" Then
  DirPath = DirPath & "\"
End If

filestring = Dir$(DirPath & FileSpec, vbArchive Or vbHidden Or vbSystem Or vbDirectory)
Do
  DoEvents
  If filestring = "" Then
    Exit Do
  Else
    If (GetAttr(DirPath & filestring) And vbDirectory) = vbDirectory Then
      If Left$(filestring, 1) <> "." And Left$(filestring, 2) <> ".." Then
        lstdirs.AddItem DirPath & filestring & "\"
      End If
    Else
      lstfiles.AddItem DirPath & filestring
    End If
  End If
  
  filestring = Dir$
Loop

End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub