Option Explicit Private Sub Command2_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer Screen.MousePointer = vbHourglass
List2.Clear
SearchPath = Text1.Text
FindStr = Text2.Text
FileSize = FindFiles(SearchPath, FindStr, NumFiles, NumDirs)
Text5.Text = NumFiles & " Files found in " & NumDirs + 1 & _
" Directories"
Text6.Text = "Size of files found under " & SearchPath & " = " & _
Format(FileSize, "#,###,###,##0") & " Bytes"
Screen.MousePointer = vbDefault
End Sub Private Sub Form_Load()
Command1.Caption = "Use API code"
Command2.Caption = "Use VB code"
' start with some reasonable defaults
Text1.Text = "C:\My Documents\"
Text2.Text = "*.*"
End Sub Private Sub Command1_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer Screen.MousePointer = vbHourglass
List1.Clear
SearchPath = Text1.Text
FindStr = Text2.Text
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & _
" Directories"
Text4.Text = "Size of files found under " & SearchPath & " = " & _
Format(FileSize, "#,###,###,##0") & " Bytes"
Screen.MousePointer = vbDefault
End Sub
Function FindFilesAPI(path As String, SearchStr As String, _
FileCount As Integer, DirCount As Integer)
Dim FileName As String ' Walking filename variable...
Dim DirName As String ' SubDirectory Name
Dim dirNames() As String ' Buffer for directory name entries
Dim nDir As Integer ' Number of directories in this path
Dim i As Integer ' For-loop counter...
Dim hSearch As Long ' Search Handle
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Dim FT As FILETIME
Dim ST As SYSTEMTIME
Dim DateCStr As String, DateMStr As String
If Right(path, 1) <> "\" Then path = path & "\"
' Search for subdirectories.
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
' Ignore the current and encompassing directories.
If (DirName <> ".") And (DirName <> "..") Then
' Check for directory with bitwise comparison.
If GetFileAttributes(path & DirName) And _
FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
' Uncomment the next line to list directories
'List1.AddItem path & FileName
End If
End If
Cont = FindNextFile(hSearch, WFD) ' Get next subdirectory.
Loop
Cont = FindClose(hSearch)
End If ' Walk through this directory and sum file sizes.
hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") And _
((GetFileAttributes(path & FileName) And _
FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * _
MAXDWORD) + WFD.nFileSizeLow
FileCount = FileCount + 1
' To list files w/o dates, uncomment the next line
' and remove or Comment the lines down to End If
'List1.AddItem path & FileName
' Include Creation date...
FileTimeToLocalFileTime WFD.ftCreationTime, FT
FileTimeToSystemTime FT, ST
DateCStr = ST.wMonth & "/" & ST.wDay & "/" & ST.wYear & _
" " & ST.wHour & ":" & ST.wMinute & ":" & ST.wSecond
' and Last Modified Date
FileTimeToLocalFileTime WFD.ftLastWriteTime, FT
FileTimeToSystemTime FT, ST
DateMStr = ST.wMonth & "/" & ST.wDay & "/" & ST.wYear & _
" " & ST.wHour & ":" & ST.wMinute & ":" & ST.wSecond
List1.AddItem path & FileName & vbTab & _
Format(DateCStr, "mm/dd/yyyy hh:nn:ss") _
& vbTab & Format(DateMStr, "mm/dd/yyyy hh:nn:ss")
End If
Cont = FindNextFile(hSearch, WFD) ' Get next file
Wend
Cont = FindClose(hSearch)
End If ' If there are sub-directories...
If nDir > 0 Then
' Recursively walk into them...
For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) _
& "\", SearchStr, FileCount, DirCount)
Next i
End If
End Function
Function FindFiles(path As String, SearchStr As String, _
FileCount As Integer, DirCount As Integer)
Dim FileName As String ' Walking filename variable.
Dim DirName As String ' SubDirectory Name.
Dim dirNames() As String ' Buffer for directory name entries.
Dim nDir As Integer ' Number of directories in this path.
Dim i As Integer ' For-loop counter. On Error GoTo sysFileERR
If Right(path, 1) <> "\" Then path = path & "\"
' Search for subdirectories.
nDir = 0
ReDim dirNames(nDir)
DirName = Dir(path, vbDirectory Or vbHidden) ' Even if hidden.
Do While Len(DirName) > 0
' Ignore the current and encompassing directories.
If (DirName <> ".") And (DirName <> "..") Then
' Check for directory with bitwise comparison.
If GetAttr(path & DirName) And vbDirectory Then
dirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
'List2.AddItem path & DirName ' Uncomment to list
End If ' directories.
sysFileERRCont:
End If
DirName = Dir() ' Get next subdirectory.
Loop ' Search through this directory and sum file sizes.
FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbSystem _
Or vbReadOnly)
While Len(FileName) <> 0
FindFiles = FindFiles + FileLen(path & FileName)
FileCount = FileCount + 1
' Load List box
List2.AddItem path & FileName & vbTab & _
FileDateTime(path & FileName) ' Include Modified Date
FileName = Dir() ' Get next file.
Wend ' If there are sub-directories..
If nDir > 0 Then
' Recursively walk into them
For i = 0 To nDir - 1
FindFiles = FindFiles + FindFiles(path & dirNames(i) & "\", _
SearchStr, FileCount, DirCount)
Next i
End IfAbortFunction:
Exit Function
sysFileERR:
If Right(DirName, 4) = ".sys" Then
Resume sysFileERRCont ' Known issue with pagefile.sys
Else
MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
"Unexpected Error"
Resume AbortFunction
End If
End FunctionModule:Option Explicit Declare Function FindFirstFile Lib "kernel32" Alias _
"FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _
As WIN32_FIND_DATA) As Long Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Declare Function GetFileAttributes Lib "kernel32" Alias _
"GetFileAttributesA" (ByVal lpFileName As String) As Long Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) _
As Long Declare Function FileTimeToLocalFileTime Lib "kernel32" _
(lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long Public Const MAX_PATH = 260
Public Const MAXDWORD = &HFFFF
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100 Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type 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 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 Public Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, _
InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer Screen.MousePointer = vbHourglass
List2.Clear
SearchPath = Text1.Text
FindStr = Text2.Text
FileSize = FindFiles(SearchPath, FindStr, NumFiles, NumDirs)
Text5.Text = NumFiles & " Files found in " & NumDirs + 1 & _
" Directories"
Text6.Text = "Size of files found under " & SearchPath & " = " & _
Format(FileSize, "#,###,###,##0") & " Bytes"
Screen.MousePointer = vbDefault
End Sub Private Sub Form_Load()
Command1.Caption = "Use API code"
Command2.Caption = "Use VB code"
' start with some reasonable defaults
Text1.Text = "C:\My Documents\"
Text2.Text = "*.*"
End Sub Private Sub Command1_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer Screen.MousePointer = vbHourglass
List1.Clear
SearchPath = Text1.Text
FindStr = Text2.Text
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & _
" Directories"
Text4.Text = "Size of files found under " & SearchPath & " = " & _
Format(FileSize, "#,###,###,##0") & " Bytes"
Screen.MousePointer = vbDefault
End Sub
Function FindFilesAPI(path As String, SearchStr As String, _
FileCount As Integer, DirCount As Integer)
Dim FileName As String ' Walking filename variable...
Dim DirName As String ' SubDirectory Name
Dim dirNames() As String ' Buffer for directory name entries
Dim nDir As Integer ' Number of directories in this path
Dim i As Integer ' For-loop counter...
Dim hSearch As Long ' Search Handle
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Dim FT As FILETIME
Dim ST As SYSTEMTIME
Dim DateCStr As String, DateMStr As String
If Right(path, 1) <> "\" Then path = path & "\"
' Search for subdirectories.
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
' Ignore the current and encompassing directories.
If (DirName <> ".") And (DirName <> "..") Then
' Check for directory with bitwise comparison.
If GetFileAttributes(path & DirName) And _
FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
' Uncomment the next line to list directories
'List1.AddItem path & FileName
End If
End If
Cont = FindNextFile(hSearch, WFD) ' Get next subdirectory.
Loop
Cont = FindClose(hSearch)
End If ' Walk through this directory and sum file sizes.
hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") And _
((GetFileAttributes(path & FileName) And _
FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * _
MAXDWORD) + WFD.nFileSizeLow
FileCount = FileCount + 1
' To list files w/o dates, uncomment the next line
' and remove or Comment the lines down to End If
'List1.AddItem path & FileName
' Include Creation date...
FileTimeToLocalFileTime WFD.ftCreationTime, FT
FileTimeToSystemTime FT, ST
DateCStr = ST.wMonth & "/" & ST.wDay & "/" & ST.wYear & _
" " & ST.wHour & ":" & ST.wMinute & ":" & ST.wSecond
' and Last Modified Date
FileTimeToLocalFileTime WFD.ftLastWriteTime, FT
FileTimeToSystemTime FT, ST
DateMStr = ST.wMonth & "/" & ST.wDay & "/" & ST.wYear & _
" " & ST.wHour & ":" & ST.wMinute & ":" & ST.wSecond
List1.AddItem path & FileName & vbTab & _
Format(DateCStr, "mm/dd/yyyy hh:nn:ss") _
& vbTab & Format(DateMStr, "mm/dd/yyyy hh:nn:ss")
End If
Cont = FindNextFile(hSearch, WFD) ' Get next file
Wend
Cont = FindClose(hSearch)
End If ' If there are sub-directories...
If nDir > 0 Then
' Recursively walk into them...
For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) _
& "\", SearchStr, FileCount, DirCount)
Next i
End If
End Function
Function FindFiles(path As String, SearchStr As String, _
FileCount As Integer, DirCount As Integer)
Dim FileName As String ' Walking filename variable.
Dim DirName As String ' SubDirectory Name.
Dim dirNames() As String ' Buffer for directory name entries.
Dim nDir As Integer ' Number of directories in this path.
Dim i As Integer ' For-loop counter. On Error GoTo sysFileERR
If Right(path, 1) <> "\" Then path = path & "\"
' Search for subdirectories.
nDir = 0
ReDim dirNames(nDir)
DirName = Dir(path, vbDirectory Or vbHidden) ' Even if hidden.
Do While Len(DirName) > 0
' Ignore the current and encompassing directories.
If (DirName <> ".") And (DirName <> "..") Then
' Check for directory with bitwise comparison.
If GetAttr(path & DirName) And vbDirectory Then
dirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
'List2.AddItem path & DirName ' Uncomment to list
End If ' directories.
sysFileERRCont:
End If
DirName = Dir() ' Get next subdirectory.
Loop ' Search through this directory and sum file sizes.
FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbSystem _
Or vbReadOnly)
While Len(FileName) <> 0
FindFiles = FindFiles + FileLen(path & FileName)
FileCount = FileCount + 1
' Load List box
List2.AddItem path & FileName & vbTab & _
FileDateTime(path & FileName) ' Include Modified Date
FileName = Dir() ' Get next file.
Wend ' If there are sub-directories..
If nDir > 0 Then
' Recursively walk into them
For i = 0 To nDir - 1
FindFiles = FindFiles + FindFiles(path & dirNames(i) & "\", _
SearchStr, FileCount, DirCount)
Next i
End IfAbortFunction:
Exit Function
sysFileERR:
If Right(DirName, 4) = ".sys" Then
Resume sysFileERRCont ' Known issue with pagefile.sys
Else
MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
"Unexpected Error"
Resume AbortFunction
End If
End FunctionModule:Option Explicit Declare Function FindFirstFile Lib "kernel32" Alias _
"FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _
As WIN32_FIND_DATA) As Long Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Declare Function GetFileAttributes Lib "kernel32" Alias _
"GetFileAttributesA" (ByVal lpFileName As String) As Long Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) _
As Long Declare Function FileTimeToLocalFileTime Lib "kernel32" _
(lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long Public Const MAX_PATH = 260
Public Const MAXDWORD = &HFFFF
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100 Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type 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 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 Public Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, _
InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
解决方案 »
- 怎样判断一个 DLL 或 OCX 文件是否已经注册
- 请问怎么可以取得当前计算机的串口个数?
- 请问关于菜单问题???
- 请教:如何为继承父类接口的子类再定义自己的接口(也就是父类没有的接口)???急急!!!
- 高分在线等~~~~~~~~
- SQL查询语句(快,来那分!要不没时间了)
- 为什么会出现Invalid pointer operation(无效的指针操作)?
- 大哥 帮我做个matlab vb 的接口好吗 只要 + -x 除 求逆 就行
- 简单! 当响应TextBox的KeyPress消息时,如何知道是按下了回车键?
- VBA实现百度百科电影的内容自动提取
- 高程、计算机四级、微软认证 三者中哪个更有价值?
- 我的计算机怎么了!
用file,dir,和drive控件组合,网上有标准explore式样的目录选取树控件下载
仅供参考Option Explicit'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Used for find files
'
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As LongPublic Const MAX_PATH = 260 'Defined in stdlib.h
''''''''''''''''''''''''''''''''''''''''''
'Defined in Mapi.h
Public Const FILE_ATTRIBUTE_READONLY = 1&
Public Const FILE_ATTRIBUTE_HIDDEN = 2&
Public Const FILE_ATTRIBUTE_SYSTEM = 4&
Public Const FILE_ATTRIBUTE_DIRECTORY = 16&
Public Const FILE_ATTRIBUTE_ARCHIVE = 32&
Public Const FILE_ATTRIBUTE_NORMAL = 128&
Public Const FILE_ATTRIBUTE_TEMPORARY = 256&
''''''''''''''''''''''''''''''''''''''''''
Public Type FILETIME ' 8 Bytes
dwLowDateTime As Long
dwHighDateTime As Long
End TypePublic Type WIN32_FIND_DATA
lFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
lReserved0 As Long
lReserved1 As Long
cFileName As String * MAX_PATH
cAlternateFileName As String * 14
End Type''''''''''''''''''''''''''''''''''''''''''''''''
'用来去处给定字串的C语言后缀,即'\0'字符
Public Function TrimZeroSuffix(ByVal zeroString As String) As String
Dim RetStr As String
Dim i As Integer
RetStr = ""
i = 1
Do While i <> Len(zeroString)
If Mid(zeroString, i, 1) <> Chr(0) Then
RetStr = RetStr & Mid(zeroString, i, 1)
Else
Exit Do
End If
i = i + 1
Loop
TrimZeroSuffix = RetStr
End Function '给于的pathname应该是这种形式的("c: or c:\windows ...")Private Sub EnumFiles(ByVal PathName As String)
On Error Resume NextDim SearchName As String
Dim Find_Data As WIN32_FIND_DATA
Dim lhandle As Long, ret As LongDim Filehandle As Long
Dim i As LongSearchName = PathName & "\*.*"
lhandle = FindFirstFile(SearchName, Find_Data)
ret = lhandleDo While ((ret <> 0) And Running)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'handle the file here
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If (Find_Data.lFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> 0 Then
If (Left(Find_Data.cFileName, 1) <> ".") Then 'is a directory
Debug.Print Pathname & "\" & TrimZeroSuffix(Find_Data.cFileName) & "\"
Call EnumFiles(PathName & "\" & TrimZeroSuffix(Find_Data.cFileName))
End If Else
'is a file
'handle the file here
Debug.Print Pathname & "\" & TrimZeroSuffix(Find_Data.cFileName)
End If DoEvents
ret = FindNextFile(lhandle, Find_Data)
LoopFindClose (lhandle)
End Sub