Вот код моего урезанного класса io.cls:
-
- Option Explicit
- Private Const MAX_PATH As Long = 4000
- Private Const MAX_PATH_B As Long = MAX_PATH * 2
- Private Const MAX_ALTERNATE As Long = 14
- Private Const INVALID_HANDLE_VALUE As Long = -1
-
- 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(MAX_PATH_B) As Byte
- cAlternate As String * MAX_ALTERNATE
- End Type
-
- Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileW" (ByVal lpFileName As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
- Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileW" (ByVal hFindFile As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
- Private Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long
- Private Declare Function PathCombine_ Lib "shlwapi.dll" Alias "PathCombineW" (ByVal szDest As Long, ByVal lpszDir As Long, ByVal lpszFile As Long) As Long
-
- Public filesResult As Collection
- Public foldersResult As Collection
-
- Private rxObj As New RegExp
- Private rxMatchCol As MatchCollection
-
- Public Sub fflush()
- Set filesResult = New Collection
- Set foldersResult = New Collection
- End Sub
-
- Public Sub enumFiles(ByVal path As String, Optional ByVal fFilter As String = vbNullString)
- Call fflush
- Call searchFilesRecursive(path, fFilter)
- End Sub
-
- Public Sub enumFilesRecursive(ByRef path As String, Optional ByRef fFilter As String = vbNullString)
- Dim i As Integer, postfix As String, foldername As String
- foldername = PathFilename(path)
- If LenB(foldername) = 0 Then foldername = path
- postfix = " subfolder of """ & foldername & """"
- Call fflush
- Call searchFilesRecursive(path, fFilter)
- Do
- i = i + 1
- If i <= foldersResult.Count Then
- If i Mod 10 = 0 Then
- Form1.Caption = "Search in " & i & postfix
- DoPaintEvents
- End If
- Call searchFilesRecursive(foldersResult(i), fFilter)
- Else
- Exit Do
- End If
- Loop
- End Sub
-
- Private Sub searchFilesRecursive(ByRef directoryPath As String, ByRef fFilter As String)
- Dim locationName As String, l As Long
- Dim findData As WIN32_FIND_DATA
- Dim hFindFile As Long
- hFindFile = FindFirstFile(StrPtr("\\?\" & directoryPath & "\*"), findData)
- If (hFindFile <> INVALID_HANDLE_VALUE) Then
- Do
- l = InStr(1, findData.cFileName, vbNullChar)
- If l = 0 Then l = MAX_PATH + 1
- locationName = Left$(findData.cFileName, l - 1)
- If (locationName <> "." And locationName <> "..") Then
- If ((findData.dwFileAttributes And vbDirectory) <> 0) Then
- Call foldersResult.Add(PathCombine(directoryPath, locationName))
- ElseIf fFilter = vbNullString Then
- Call filesResult.Add(PathCombine(directoryPath, locationName))
- ElseIf checkRegExpMask(locationName, fFilter, vbTextCompare) Then
- Call filesResult.Add(PathCombine(directoryPath, locationName))
- End If
- End If
- Loop While (FindNextFile(hFindFile, findData))
- End If
- Call FindClose(hFindFile)
- End Sub
-
- Private Function PathCombine(ByVal directoryPath As String, ByVal directoryName As String) As String
- Dim l As Long
- PathCombine = String$(MAX_PATH, vbNullChar)
- Call PathCombine_(StrPtr(PathCombine), StrPtr(directoryPath), StrPtr(directoryName))
- l = InStr(1, PathCombine, vbNullChar)
- If l = 0 Then l = MAX_PATH + 1
- PathCombine = Left$(PathCombine, l - 1)
- End Function
-
- Public Function checkRegExpMask(ByRef strText As String, ByRef strSearch As String, Optional ByVal CompareMode As VbCompareMethod) As Boolean
- On Error GoTo 1:
- rxObj.IgnoreCase = (CompareMode = vbTextCompare)
- rxObj.Global = True
- rxObj.MultiLine = True
- rxObj.Pattern = strSearch
- Set rxMatchCol = rxObj.Execute(strText)
- If rxMatchCol.Count = 1 Then _
- If strText = rxMatchCol(0).Value Then _
- checkRegExpMask = True
- Exit Function
- 1: Debug.Print "ERROR in checkRegExpMask", Now
- End Function
- Dim io As New io, i As Long, Count As Long
- io.enumFiles "C:\", ".*\..*"
- Count = io.filesResult.Count
- For i = 1 To Count
- List1.AddItem io.filesResult(i)
- Next i
Ответить
|
pavel
ηikolaŠ~rus
