' Brought to you by Brad Martinez
' [url]http://members.aol.com/btmtz/vb[/url]
'Search All Drives
' Though this example has been optimized for speed,
' it's obviously not as efficient as it could be.
' Consider it a starting point...
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
' 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.
Private 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.
Private Const LB_ADDSTRING = &H180
Private Const WM_SETREDRAW = &HB
Private Const WM_VSCROLL = &H115
Private Const SB_BOTTOM = 7
'this constant is used in displaying an item in the files list box as a tool tip
'see the mouse_move event for that control
Private Const LB_ITEMFROMPOINT = &H1A9
' 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.
Private 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
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
'FindFirstFile failure rtn value
Private Const INVALID_HANDLE_VALUE = -1
' Rtns True (non zero) on succes, False on failure
Private 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
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Const MaxLFNPath = 260
Private 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
' A liberal use of form level variables...
Private PicHeight As Integer
Private hLB As Long
Private FileSpec As String
Private UseFileSpec As Integer
Private TotalDirs As Integer
Private TotalFiles As Integer
Private Running As Boolean
' SearchDirs() private constants
Private Const vbBackslash = "\"
Private Const vbAllFiles = "*.*"
Private Const vbKeyDot = 46
Private Sub GetDrives(LB As ListBox, ByVal IsUsed As Boolean)
Dim DriveLtr As Long
LB.Clear
For DriveLtr = 0 To 25
If CBool(GetLogicalDrives And (2 ^ DriveLtr)) = IsUsed Then
LB.AddItem Chr$(Asc("A") + DriveLtr) & ":"
End If
Next
End Sub
Private Sub SearchDirs(CurPath As String) ' curpath$ is passed w/ trailing "\"
' These can't be static!!! They must be
' re-allocated on each recursive call.
Dim Dirs As Integer
Dim DirBuf() As String
Dim i As Integer
Dim j As Integer
' These variables are declared as Static to save on
' stack space & on variable re-allocation time
Static WFD As WIN32_FIND_DATA
Static hItem As Long
' Display what's happening...
' A Timer could be used instead to display status at
' pre-defined intervals, saving on PictureBox redraw time...
lblStatus.Caption = "Searching " & 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 cmdFind_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 cmdFolderInfo_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 cmdFind_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
End Sub
Private Sub SearchFileSpec(CurPath$) ' curpath$ is passed w/ trailing "\"
' This procedure *only* finds files in the current folder that match the FileSpec$
' These variables are declared as Static to save on
' stack space & on variable re-allocation time
Static WFD As WIN32_FIND_DATA
Static hFile As Long
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...
SendMessage hLB&, LB_ADDSTRING, 0, _
ByVal 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