search.bas

OpenPlayer代码

Attribute VB_Name = "Search"
Option Explicit


' This message helps speed up the initialization of list boxes that have a large number
' of items (more than 100). It preallocates the specified amount of memory so that
' subsequent LB_ADDSTRING, LB_INSERTSTRING, LB_DIR, and LB_ADDFILE
' messages take the shortest possible time. You can use estimates for the wParam and
' lParam parameters. If you overestimate, some extra memory is allocated; if you
' underestimate, the normal allocation is used for items that exceed the preallocated amount.
' wParam:          Specifies the number of items to add.
' lParam:           Specifies the amount of memory, in bytes, to allocate for item strings.
' Return Value:   The return value is the maximum number of items that the memory
                       ' object can store before another memory reallocation is needed, if
                       ' successful. It is LB_ERRSPACE if not enough memory is available.
Public Const LB_INITSTORAGE = &H1A8

' An application sends an LB_ADDSTRING message to add a string to a list box.
' If the list box does not have the LBS_SORT style, the string is added to the end
' of the list. Otherwise, the string is inserted into the list and the list is sorted.
Public Const LB_ADDSTRING = &H180

Public Const WM_SETREDRAW = &HB
Public Const WM_VSCROLL = &H115
Public Const SB_BOTTOM = 7

' If the function succeeds, the return value is a bitmask
' representing the currently available disk drives. Bit
' position 0 (the least-significant bit) is drive A, bit position
' 1 is drive B, bit position 2 is drive C, and so on.
' If the function fails, the return value is zero.
Declare Function GetLogicalDrives Lib "Kernel32" () As Long

' If the function succeeds, the return value is a search handle
' used in a subsequent call to FindNextFile or FindClose
Declare Function FindFirstFile Lib "Kernel32" Alias "FindFirstFileA" _
                        (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

'FindFirstFile failure rtn value
Public Const INVALID_HANDLE_VALUE = -1

' Rtns True (non zero) on succes, False on failure
Declare Function FindNextFile Lib "Kernel32" Alias "FindNextFileA" _
                        (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

' Rtns True (non zero) on succes, False on failure
Declare Function FindClose Lib "Kernel32" (ByVal hFindFile As Long) As Long

Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Public Const MaxLFNPath = 260

Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MaxLFNPath
        cShortFileName As String * 14
End Type
' Brought to you by Brad Martinez
' http://members.aol.com/btmtz/vb

' Though this example has been optimized for speed,
' it's obviously not as efficient as it could be.
' Consider it a starting point...

' A liberal use of module level variables...
Dim PicHeight%, hLB&, FileSpec$, UseFileSpec%
Dim TotalDirs%, TotalFiles%

Public running As Boolean
Dim FilesCounter As Integer

' These variables are allocated at the module level to save on
' stack space & on variable re-allocation time in SearchDirs().
' They could be declared as Static within their respective procs...
Dim WFD As WIN32_FIND_DATA, hItem&, hFile&

' SearchDirs() constants
Const vbBackslash = "\"
Const vbAllFiles = "*.*"
Const vbKeyDot = 46



'======================================================
' This is were it all happens...

' You can use the values in returned in the
' WIN32_FIND_DATA structure to virtually obtain any
' information you want for a particular folder or group of files.

' This recursive procedure is similar to the Dir$ function
' example found in the VB3 help file...
Sub Start(FilePath As String)
If running Then
   running = False
   Exit Sub
End If
    
    Dim drvbitmask&, maxpwr%, pwr%
    On Error Resume Next
    
    FileSpec$ = "*.exe"
   
    
    If Len(FileSpec$) = 0 Then Exit Sub
    
    running = True
    UseFileSpec% = True
    
    Call SearchDirs(FilePath)
    
    running = False
    UseFileSpec% = False
    Form1.Caption = "共找到：" & Form1.List1.ListCount & "个文件"
   
   
End Sub

Private Sub SearchDirs(curpath$)  ' curpath$ is passed w/ trailing "\"

    ' These can't be static!!! They must be
    ' re-allocated on each recursive call.
    Dim dirs%, dirbuf$(), i%
    
    ' Display what's happening...
    ' A Timer could be used instead to display status at
    ' pre-defined intervals, saving on PictureBox redraw time...
    Form1.Caption = "正在搜索：" & curpath$
    
    ' Allows the PictureBox to be redrawn
    ' & this proc to be cancelled by the user.
    ' It's not necessary to have this in the loop
    ' below since the loop works so fast...
    DoEvents
    If Not running Then Exit Sub
    
    ' This loop finds *every* subdir and file in the current dir
    hItem& = FindFirstFile(curpath$ & vbAllFiles, WFD)
    
    If hItem& <> INVALID_HANDLE_VALUE Then
        
        Do
            ' Tests for subdirs only...
            If (WFD.dwFileAttributes And vbDirectory) Then
                
                ' If not a  "." or ".." DOS subdir...
                If Asc(WFD.cFileName) <> vbKeyDot Then
                    ' This is executed in the mnuFindFiles_Click()
                    ' call though it isn't used...
                    TotalDirs% = TotalDirs% + 1
                    ' This is the heart of a recursive proc...
                    ' Cache the subdirs of the current dir in the 1 based array.
                    ' This proc calls itself below for each subdir cached in the array.
                    ' (re-allocating the array only once every 10 itinerations improves speed)
                    If (dirs% Mod 10) = 0 Then ReDim Preserve dirbuf$(dirs% + 10)
                    dirs% = dirs% + 1
                    dirbuf$(dirs%) = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                End If
                

            ' File size and attribute tests can be used here, i.e:
            ' ElseIf (WFD.dwFileAttributes And vbHidden) = False Then  'etc...
            
            ' Get a total file count for mnuFolderInfo_Click()
            ElseIf Not UseFileSpec% Then
                TotalFiles% = TotalFiles% + 1
            End If
        
        ' Get the next subdir or file
        Loop While FindNextFile(hItem&, WFD)
        
        ' Close the search handle
        Call FindClose(hItem&)
    
    End If

    ' When UseFileSpec% is set mnuFindFiles_Click(),
    ' SearchFileSpec() is called & each folder must be
    ' searched a second time.
    If UseFileSpec% Then
        ' Turning off painting speeds things quite a bit...
        ' Speed also would be vastly improved if the redrawing
        ' & scrolling were placed in a Timer event...
       '====================SendMessage hLB&, WM_SETREDRAW, 0, 0
        Call SearchFileSpec(curpath$)
        ' Keeps the currently found items scrolled into view...
       '==================== SendMessage hLB&, WM_VSCROLL, SB_BOTTOM, 0
       '===================== SendMessage hLB&, WM_SETREDRAW, 1, 0
    End If
    
    ' Recursively call this proc & iterate through each subdir cached above.
    For i% = 1 To dirs%
         SearchDirs curpath$ & dirbuf$(i%) & vbBackslash
    Next i%
  
End Sub

Private Sub SearchFileSpec(curpath$)   ' curpath$ is passed w/ trailing "\"
' This procedure *only*  finds files in the
' current folder that match the FileSpec$
    
    hFile& = FindFirstFile(curpath$ & FileSpec$, WFD)
    If hFile& <> INVALID_HANDLE_VALUE Then
        
        Do
            ' Use DoEvents here since we're loading a ListBox and
            ' there could be hundreds of files matching the FileSpec$
            DoEvents
            
            If Not running Then Exit Sub
            
            ' The ListBox's Sorted property is initially set to False.
            ' Set it to True and see how things slow down a bit...
          
                                 
           Form1.List1.AddItem (curpath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1))
            
            
          '  strFoundFile(FileCount) = curpath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
             
        ' Get the next file matching the FileSpec$
        Loop While FindNextFile(hFile&, WFD)
        
        ' Close the search handle
        Call FindClose(hFile&)
    
    End If

End Sub