Attribute VB_Name = "mdlScanDir"
Option Explicit
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Const MAX_PATH = 260
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
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 * MAX_PATH
cAlternate As String * 14
End Type
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public bStopScan As Boolean
'============================================
Public Function RemoveNull$(ByVal source$)
Dim i&
i = InStr(1, source, vbNullChar)
If i > 0 Then
RemoveNull = Left$(source, i - 1)
Else
RemoveNull = source
End If
End Function
Public Function ScanDir(ByVal sPath$, ByVal sMask$) As Boolean
Dim wfd As WIN32_FIND_DATA
Dim hFind&, sFile$
Dim bRet As Boolean
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
If bStopScan Then
ScanDir = False
Exit Function
End If
SearchIn sPath
hFind = FindFirstFile(sPath & sMask, wfd)
bRet = hFind <> -1
If bRet Then
Do
sFile = RemoveNull(wfd.cFileName)
If sFile <> "." And sFile <> ".." Then
If (wfd.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> 0 Then
'If (GetFileAttributes(sPath & sFile) And FILE_ATTRIBUTE_DIRECTORY) <> 0 Then
FileFounded sPath & sFile, True
If Not ScanDir(sPath & sFile, sMask) Then bRet = False
SearchIn sPath
Else
FileFounded sPath & sFile, False
End If
End If
If bStopScan Then
bRet = False
Exit Do
End If
Loop While FindNextFile(hFind, wfd)
FindClose hFind
End If
ScanDir = bRet
End Function
Private Sub FileFounded(ByVal Name$, ByVal IsDir As Boolean)
If bStopScan Then Exit Sub
'founded Name
If IsDir Then
Form1.AddDir
Else
Form1.AddFile
End If
DoEvents
End Sub
Public Sub SearchIn(ByVal sDir$)
If bStopScan Then Exit Sub
Form1.lblSearchIn.Caption = sDir
End Sub
Public Function GetDrives() As String()
Dim s$, lRet&
s = String(255, " ")
If GetLogicalDriveStrings(Len(s), s) > 0 Then
lRet = InStr(1, s, vbNullChar & vbNullChar)
If lRet > 0 Then s = Left$(s, lRet - 1)
GetDrives = Split(s, vbNullChar)
End If
End Function