|
本帖最后由 joforn 于 2012-8-30 23:21 编辑
- Option Explicit
- Private Declare Function PathIsDirectoryEmptyW Lib "shlwapi.dll" (ByVal pszPath As Long) As Long
- Private Declare Function PathAddBackslashW Lib "shlwapi.dll" (ByVal pszPath As Long) As Long
- Private Declare Function PathIsDirectoryW Lib "shlwapi.dll" (ByVal pszPath As Long) As Long
- Private Declare Function PathFindExtension Lib "shlwapi.dll" Alias "PathFindExtensionW" (ByVal pszPath As Long) As Long
- Private Declare Function GetFileTimeAPI Lib "kernel32" Alias "GetFileTime" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
- Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
- Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
- Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" (ByVal lpFileName As Long, lpFindFileData As WIN32_FIND_DATA) As Long
- Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileW" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Boolean
- Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
- Private Declare Sub CopyMemoryString Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
- Private Const INVALID_HANDLE_VALUE As Long = -1&
- Private Const MAX_PATH As Long = 260
- Private Type FILETIME
- dwLowDateTime As Long
- dwHighDateTime As Long
- End Type
- Private Type SYSTEMTIME
- wYear As Integer
- wMonth As Integer
- wDayOfWeek As Integer
- wDay As Integer
- wHour As Integer
- wMinute As Integer
- wSecond As Integer
- wMilliseconds As Integer
- End Type
- Private Type WIN32_FIND_DATA
- dwFileAttributes As Long ' 文件属性
- ftCreationTime As FILETIME ' 文件创建时间
- ftLastAccessTime As FILETIME ' 文件最后一次访问时间
- ftLastWriteTime As FILETIME ' 文件最后一次修改时间
- nFileSizeHigh As Long ' 文件长度高32位
- nFileSizeLow As Long ' 文件长度低32位
- dwReserved0 As Long ' 系统保留
- dwReserved1 As Long ' 系统保留
- cFileName(MAX_PATH * 2) As Byte ' 长文件名
- cAlternate(14 * 2) As Byte ' 8.3格式文件名
- End Type
- Private blnExtension As Boolean
- Private ExtList() As String
- Private blnFind As Boolean
- Public Event FindBegin()
- Public Event FindEnd()
- Public Event FindedFile(ByVal FileName As String, ByVal CreationTime As Date, ByVal LastAccessTime As Date, ByVal LastWriteTime As Date)
- Public Sub FileSearch(ByVal DirName As String, Optional ByVal ScanSubDir As Boolean = True)
- Dim FileName As String
- Dim FindData As WIN32_FIND_DATA
- Dim hFind As Long
- Dim I As Long
- Dim blnFirst As Boolean
-
- If Not blnFind Then
- blnFind = True
- blnFirst = True
- RaiseEvent FindBegin
- End If
-
- DirName = PathAddBackslash(DirName)
- If PathIsDirectoryW(StrPtr(DirName & vbNullChar)) Then
- If PathIsDirectoryEmptyW(StrPtr(DirName & vbNullChar)) Then Exit Sub
-
- hFind = FindFirstFile(StrPtr(DirName & "*.*" & vbNullChar), FindData)
- If hFind <> INVALID_HANDLE_VALUE Then
- With FindData
- Do
- FileName = .cFileName
- I = InStr(1&, FileName, vbNullChar)
- If I Then FileName = Left$(FileName, I - 1)
- If InStr(1, "..", FileName) Then
- '如果是"."和".."则不做任何处理
- Else
- FileName = DirName & FileName
- If PathIsDirectoryW(StrPtr(FileName & vbNullChar)) Then ' 查找到的是一个目录名
- If ScanSubDir Then FileSearch FileName, True
- Else
- RaiseFindFile FileName, FindData
- End If
- End If
- DoEvents
- Loop While (FindNextFile(hFind, FindData) <> 0) And blnFind
- End With
- End If
-
- FindClose hFind
- Err.Clear
- End If
-
- If blnFirst Then
- blnFind = False
- RaiseEvent FindEnd
- End If
- End Sub
- Public Sub SetExtensionList(ByVal Extension As String)
- Dim I As Long
- blnExtension = False
- Extension = Trim$(UCase$(ExtList(I)))
- If Len(Extension) Then
- Extension = Replace(Extension, "|", vbNullChar)
- ExtList = Split(Extension, vbNullChar)
- For I = 0 To UBound(ExtList)
- ExtList(I) = Trim$(ExtList(I))
- If ExtList(I) = "*.*" Then Exit Sub
- Next I
- blnExtension = True
- End If
- End Sub
- Public Sub CleanExtensionList()
- blnExtension = False
- ReDim ExtList(0)
- End Sub
- Public Sub StopSearch()
- blnFind = False
- End Sub
- '在路径后添加一个分隔符""
- Private Function PathAddBackslash(ByVal Path As String) As String
- Dim I As Long
-
- Path = Path & String(MAX_PATH, vbNullChar)
- PathAddBackslashW StrPtr(Path)
- I = InStr(Path, vbNullChar)
- If I > 0 Then Path = Left$(Path, I - 1)
- PathAddBackslash = Path
- End Function
- '从路径提取文件后缀名
- Private Function ExtractFileExtension(ByVal Path As String) As String
- Dim I As Long
-
- Path = Path & vbNullChar
- I = PathFindExtension(StrPtr(Path))
- If I Then
- CopyMemoryString StrPtr(Path), I, Len(Path) * 2
- I = InStr(Path, vbNullChar)
- If I > 0 Then Path = Left$(Path, I - 1)
- ExtractFileExtension = Path
- End If
- End Function
- Private Sub RaiseFindFile(ByVal FileName As String, FindInfo As WIN32_FIND_DATA)
- Dim I As Long, J As Long
- Dim Extension As String
-
- With FindInfo
- If blnExtension Then
- Extension = UCase$(ExtractFileExtension(.cFileName))
- J = UBound(ExtList)
- For I = 0 To J
- If ExtList(I) = Extension Then Exit For
- Next I
- If I > J Then Exit Sub
- End If
-
- RaiseEvent FindedFile(FileName, FileTimeToDate(.ftCreationTime), FileTimeToDate(.ftLastAccessTime), FileTimeToDate(.ftLastWriteTime))
- End With
- End Sub
- '文件时间转换
- Private Function FileTimeToDate(lpFileTime As FILETIME) As Date
- Dim lFileTime As FILETIME
- Dim sysTime As SYSTEMTIME
-
- FileTimeToLocalFileTime lpFileTime, lFileTime
- FileTimeToSystemTime lFileTime, sysTime
- FileTimeToDate = CDate(sysTime.wYear & "-" & sysTime.wMonth & "-" & sysTime.wDay & " " & _
- sysTime.wHour & ":" & sysTime.wMinute & ":" & sysTime.wSecond)
- End Function
- Private Sub Class_Initialize()
- ReDim ExtList(0)
- End Sub
- Private Sub Class_Terminate()
- Erase ExtList
- End Sub
复制代码
完整代码示例表:
FileSearch.rar
(21.46 KB, 下载次数: 733)
|
评分
-
3
查看全部评分
-
|