VB常用文件操作类 - 转自chenhui530的专栏 - 优快云Blog

　　Option Explicit
　　"*************************************************************************************************************
　　" 读写文件函数
　　"*************************************************************************************************************
　　"以字节方式读文件
　　Private Const FILE_SHARE_READ = &H1
　　Private Const FILE_SHARE_WRITE = &H2
　　Private Declare Function ReadFileToByte Lib "kernel32" Alias "ReadFile" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
　　"以字符串方式读文件
　　Private Declare Function ReadFileToString Lib "kernel32" Alias "ReadFile" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
　　"打开文件函数
　　"Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
　　Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
　　"以字符串方式写文件函数
　　Private Declare Function WriteFileToString Lib "kernel32" Alias "WriteFile" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
　　"以字节方式写文件函数
　　Private Declare Function WriteFileToByte Lib "kernel32" Alias "WriteFile" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
　　"关闭文件函数
　　Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
　　"文件位置定位函数
　　Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
　　"*************************************************************************************************************
　　"移动文件函数
　　Private Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal dwFlags As Long) As Long
　　"移动文件常数
　　"表示当文件存在时覆盖文件（注意当文件有只读属性的话会失败）
　　Private Const MOVEFILE_REPLACE_EXISTING = &H1
　　"如移动到一个不同的卷，则复制文件并删除原来的文件
　　Private Const MOVEFILE_COPY_ALLOWED = &H2
　　"*************************************************************************************************************
　　"删除文件函数
　　Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
　　"*************************************************************************************************************
　　"遍历文件目录函数
　　Private Const INVALID_HANDLE_VALUE = -1
　　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 FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
　　"记录文件、目录总数变量（这里本来打算是在函数中定义成静态变量的但是怕在程序中多次调用会造成数据不对所以改成了只读属性了）
　　Private lngFileCount As Long, lngFolderCount 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
　　"*************************************************************************************************************
　　"保持属性值的局部变量
　　Private mvarFileFullPath As String "局部复制
　　Private msglStartTime As Single
　　Private mclskernel32 As clsKernel
　　Public Property Get StartTime() As Single
　　"检索属性值时使用，位于赋值语句的右边。
　　"Syntax: Debug.Print X.fileFullPath
　　StartTime = Timer
　　End Property
　　Public Property Let FileFullPath(ByVal vData As String)
　　"向属性指派值时使用，位于赋值语句的左边。
　　"Syntax: X.fileFullPath = 5
　　mvarFileFullPath = vData
　　End Property
　　Public Property Get FileFullPath() As String
　　"检索属性值时使用，位于赋值语句的右边。
　　"Syntax: Debug.Print X.fileFullPath
　　FileFullPath = mvarFileFullPath
　　End Property
　　"获取当前搜索的文件数
　　Public Property Get SearchFilesCount() As Long
　　SearchFilesCount = lngFileCount
　　End Property
　　"获取当前搜索的目录数
　　Public Property Get SearchFoldersCount() As Long
　　SearchFoldersCount = lngFolderCount
　　End Property
　　"以字符串方式读出文件所有内容
　　Public Function ReadFileAllToString(Optional ByVal strFile As String) As String
　　Dim lngFile As Long, lngLen As Long, lngRecevieBytes As Long, strOut As String
　　If strFile = "" Then strFile = FileFullPath
　　If FileExist(strFile) Then
　　lngLen = FileLen(strFile)
　　If lngLen = 0 Then
　　mclskernel32.ShowMsg "文件为空！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　lngFile = CreateFile(ByVal strFile, ByVal &H80000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
　　strOut = String(lngLen, Chr(0))
　　ReadFileToString lngFile, strOut, lngLen, lngRecevieBytes, ByVal 0&
　　CloseHandle lngFile
　　Else
　　mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　ReadFileAllToString = strOut
　　End Function
　　"以字节数组方式读出文件所有内容
　　Public Function ReadFileAllToBytes(Optional ByVal strFile As String) As Byte()
　　Dim lngFile As Long, lngLen As Long, lngRecevieBytes As Long, bytFilebytes() As Byte
　　If strFile = "" Then strFile = FileFullPath
　　If FileExist(strFile) Then
　　lngLen = FileLen(strFile)
　　If lngLen = 0 Then
　　mclskernel32.ShowMsg "文件为空！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　ReDim bytFilebytes(lngLen - 1)
　　lngFile = CreateFile(ByVal strFile, ByVal &H80000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
　　ReadFileToByte lngFile, bytFilebytes(0), lngLen, lngRecevieBytes, ByVal 0&
　　CloseHandle lngFile
　　Else
　　mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　ReadFileAllToBytes = bytFilebytes
　　End Function
　　"以字符串方式读取指定位置的字符串
　　Public Function ReadFileByPositionToString(ByVal lngStart As Long, Optional ByVal lngEnd As Long = -1, Optional ByVal strFile As String) As String
　　Dim lngFile As Long, lngLen As Long, lngRecevieBytes As Long, strOut As String, lngReadLen As Long
　　If strFile = "" Then strFile = FileFullPath
　　If FileExist(strFile) Then
　　lngLen = FileLen(strFile) "lngEnd - lngStart + 1
　　If lngLen = 0 Then
　　mclskernel32.ShowMsg "文件为空！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　If lngEnd = -1 Then
　　lngReadLen = FileLen(strFile) - lngStart
　　Else
　　lngReadLen = lngEnd
　　End If
　　lngFile = CreateFile(ByVal strFile, ByVal &H80000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
　　SetFilePointer lngFile, lngStart, 0, 0
　　strOut = String(lngReadLen, Chr(0))
　　ReadFileToString lngFile, strOut, lngReadLen, lngRecevieBytes, ByVal 0&
　　CloseHandle lngFile
　　Else
　　mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　ReadFileByPositionToString = strOut
　　End Function
　　"以字节数组方式读取指定位置的字符串
　　Public Function ReadFileByPositionToBytes(ByVal lngStart As Long, Optional ByVal lngEnd As Long = -1, Optional ByVal strFile As String) As Byte()
　　Dim lngFile As Long, lngLen As Long, lngRecevieBytes As Long, bytFilebytes() As Byte, lngReadLen As Long
　　If strFile = "" Then strFile = FileFullPath
　　If FileExist(strFile) Then
　　lngLen = FileLen(strFile) " lngEnd - lngStart + 1
　　If lngLen = 0 Then
　　MsgBox "文件为空！！", vbCritical, "错误"
　　Exit Function
　　End If
　　If lngEnd = -1 Then
　　lngReadLen = FileLen(strFile) - lngStart
　　Else
　　lngReadLen = lngEnd
　　End If
　　ReDim bytFilebytes(lngReadLen - 1)
　　lngFile = CreateFile(ByVal strFile, ByVal &H80000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
　　SetFilePointer lngFile, lngStart, 0, 0
　　ReadFileToByte lngFile, bytFilebytes(0), lngReadLen, lngRecevieBytes, ByVal 0&
　　CloseHandle lngFile
　　Else
　　mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　ReadFileByPositionToBytes = bytFilebytes
　　End Function
　　"以字符串方式写文件
　　Public Function WriteStringToFile(ByVal strData As String, Optional ByVal strFile As String) As Long
　　Dim lngFile As Long, lngWriteBytes As Long
　　If strFile = "" Then strFile = FileFullPath
　　lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 4, ByVal 0&, ByVal 0&)
　　WriteFileToString lngFile, strData, Len(strData), lngWriteBytes, ByVal 0&
　　CloseHandle lngFile
　　WriteStringToFile = lngWriteBytes
　　End Function
　　"以字节数组方式写文件
　　Public Function WriteByteToFile(bytes() As Byte, Optional ByVal strFile As String) As Long
　　Dim lngFile As Long, lngWriteBytes As Long, lngLen As Long
　　If strFile = "" Then strFile = FileFullPath
　　lngLen = UBound(bytes) + 1
　　lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 4, ByVal 0&, ByVal 0&)
　　WriteFileToByte lngFile, bytes(0), lngLen, lngWriteBytes, ByVal 0&
　　CloseHandle lngFile
　　WriteByteToFile = lngWriteBytes
　　End Function
　　"以字符串方式把需要写的字符串写到指定位置（注意指定文件后的字符串会被覆盖）
　　Public Function WriteStringByPositionToFile(ByVal strData As String, ByVal lngStart As Long, Optional ByVal strFile As String) As Long
　　Dim lngFile As Long, lngWriteBytes As Long
　　If strFile = "" Then strFile = FileFullPath
　　If FileExist(strFile) Then
　　If FileLen(strFile) = 0 Then
　　WriteStringByPositionToFile = WriteStringToFile(strData, strFile)
　　Exit Function
　　End If
　　lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
　　SetFilePointer lngFile, lngStart, 0, 0
　　WriteFileToString lngFile, strData, Len(strData), lngWriteBytes, ByVal 0&
　　CloseHandle lngFile
　　WriteStringByPositionToFile = lngWriteBytes
　　Else
　　mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　End Function
　　"以字节数组方式把需要写的字节数组写到指定位置（注意指定文件后的字节会被覆盖）
　　Public Function WriteByteByPositionToFile(bytes() As Byte, ByVal lngStart As Long, Optional ByVal strFile As String) As Long
　　Dim lngFile As Long, lngWriteBytes As Long, lngLen As Long
　　If strFile = "" Then strFile = FileFullPath
　　If FileExist(strFile) Then
　　If FileLen(strFile) = 0 Then
　　WriteByteByPositionToFile = WriteByteToFile(bytes, strFile)
　　Exit Function
　　End If
　　lngLen = UBound(bytes) + 1
　　lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
　　SetFilePointer lngFile, lngStart, 0, 0
　　WriteFileToByte lngFile, bytes(0), lngLen, lngWriteBytes, ByVal 0&
　　CloseHandle lngFile
　　WriteByteByPositionToFile = lngWriteBytes
　　Else
　　mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　End Function
　　"以字符串方式把字符串添加到文件尾
　　Public Function WriteStringToAppend(ByVal strData As String, Optional ByVal strFile As String) As Long
　　Dim lngFile As Long, lngWriteBytes As Long, lngEnd As Long
　　If strFile = "" Then strFile = FileFullPath
　　If FileExist(strFile) Then
　　If FileLen(strFile) = 0 Then
　　WriteStringToAppend = WriteStringToFile(strData, strFile)
　　Exit Function
　　End If
　　lngEnd = FileLen(strFile)
　　"lngFile = OpenFile(strFile, oF, OF_WRITE)
　　lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
　　SetFilePointer lngFile, lngEnd, 0, 0
　　WriteFileToString lngFile, strData, Len(strData), lngWriteBytes, ByVal 0&
　　CloseHandle lngFile
　　WriteStringToAppend = lngWriteBytes
　　Else
　　mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　End Function
　　"以字节数组方式把字节数组添加到文件尾
　　Public Function WriteByteToAppend(bytes() As Byte, Optional ByVal strFile As String) As Long
　　Dim lngFile As Long, lngWriteBytes As Long, lngEnd As Long, lngLen As Long
　　If strFile = "" Then strFile = FileFullPath
　　If FileExist(strFile) Then
　　If FileLen(strFile) = 0 Then
　　WriteByteToAppend = WriteByteToFile(bytes, strFile)
　　Exit Function
　　End If
　　lngLen = UBound(bytes) + 1
　　lngEnd = FileLen(strFile)
　　lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
　　SetFilePointer lngFile, lngEnd, 0, 0
　　WriteFileToByte lngFile, bytes(0), lngLen, lngWriteBytes, ByVal 0&
　　CloseHandle lngFile
　　WriteByteToAppend = lngWriteBytes
　　Else
　　mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　End Function
　　"在文件中插入指定的字节数据（字符串需要转换成字节数组）
　　Public Function WriteInsertToFile(bytes() As Byte, ByVal lngStart As Long, Optional ByVal strFile As String) As Long
　　Dim lngFile As Long, lngWriteBytes As Long, lngEnd As Long, lngLen As Long, bBytes() As Byte, lngReadBytes As Long, lngReadLen As Long
　　If strFile = "" Then strFile = FileFullPath
　　If FileExist(strFile) Then
　　If FileLen(strFile) = 0 Then
　　WriteInsertToFile = WriteByteToFile(bytes, strFile)
　　Exit Function
　　End If
　　lngLen = UBound(bytes) + 1
　　lngReadLen = FileLen(strFile) - lngStart
　　ReDim bBytes(lngReadLen - 1)
　　lngFile = CreateFile(ByVal strFile, ByVal (&H40000000 Or &H80000000), FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
　　SetFilePointer lngFile, lngStart, 0, 0
　　ReadFileToByte lngFile, bBytes(0), lngReadLen, lngReadBytes, ByVal 0&
　　SetFilePointer lngFile, lngStart, 0, 0
　　WriteFileToByte lngFile, bytes(0), lngLen, lngWriteBytes, ByVal 0&
　　WriteInsertToFile = lngWriteBytes
　　WriteFileToByte lngFile, bBytes(0), lngReadLen, lngWriteBytes, ByVal 0&
　　CloseHandle lngFile
　　Else
　　mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　End Function
　　"写入一行数据
　　Public Function WriteLine(ByVal strData As String, Optional ByVal strFile As String) As Long
　　Dim lngFile As Long, lngWriteBytes As Long, lngEnd As Long, lngLen As Long
　　If strFile = "" Then strFile = FileFullPath
　　If FileExist(strFile) Then
　　lngLen = FileLen(strFile)
　　If lngLen = 0 Then
　　WriteLine = WriteStringToFile(strData, strFile)
　　Exit Function
　　End If
　　lngFile = CreateFile(ByVal strFile, ByVal &H40000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
　　SetFilePointer lngFile, lngLen, 0, 0
　　WriteFileToString lngFile, strData & vbCrLf, Len(strData & vbCrLf), lngWriteBytes, ByVal 0&
　　CloseHandle lngFile
　　WriteLine = lngWriteBytes
　　Else
　　mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　End Function
　　"读一行数据或者读取所有行
　　Public Function ReadLine(strArray() As String, Optional ByVal intLine As Integer = -1, Optional ByVal strFile As String) As String
　　Dim lngFile As Long, lngLen As Long, bBytes(0) As Byte, lngReadLen As Long
　　Dim bytOut() As Byte, i As Integer, j As Integer, strLine As String
　　If strFile = "" Then strFile = FileFullPath
　　If FileExist(strFile) Then
　　lngLen = FileLen(strFile)
　　If lngLen = 0 Then
　　ReadLine = ""
　　Exit Function
　　End If
　　lngFile = CreateFile(ByVal strFile, ByVal &H80000000, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
　　SetFilePointer lngFile, 0, 0, 0
　　Do
　　ReadFileToByte lngFile, bBytes(0), 1, lngReadLen, ByVal 0&
　　ReDim Preserve bytOut(0 To i)
　　bytOut(i) = bBytes(0)
　　i = i + 1
　　If bBytes(0) = 10 Then
　　ReDim Preserve strArray(0 To j)
　　strArray(j) = StrConv(bytOut, vbUnicode)
　　j = j + 1
　　If intLine = j Then
　　strLine = strArray(j - 1)
　　ReadLine = strLine
　　CloseHandle lngFile
　　Exit Function
　　End If
　　Erase bytOut
　　i = 0
　　End If
　　Loop While lngReadLen <> 0
　　CloseHandle lngFile
　　If (intLine <> -1 And j < intLine) Then
　　ReDim Preserve bytOut(UBound(bytOut) - 1)
　　strLine = StrConv(bytOut, vbUnicode)
　　ReadLine = strLine
　　Exit Function
　　Else
　　If i > 0 Then
　　ReDim Preserve bytOut(UBound(bytOut) - 1)
　　ReDim Preserve strArray(0 To j)
　　strArray(j) = StrConv(bytOut, vbUnicode)
　　End If
　　End If
　　Else
　　mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
　　Exit Function
　　End If
　　End Function
　　"文件复制函数支持文件备份操作
　　Public Function MyCopyFile(ByVal strExistingFileName As String, ByVal strNewFileName As String, Optional ByVal isCover As Boolean = True) As Boolean
　　If strExistingFileName = "" Then strExistingFileName = FileFullPath
　　If FileExist(strNewFileName) Then
　　If isCover Then
　　SetFileAttr strNewFileName
　　On Error GoTo errPurview
　　Kill strNewFileName
　　Else
　　On Error GoTo errExist
　　Name strNewFileName As strNewFileName & ".bak"
　　End If
　　End If
　　FileCopy strExistingFileName, strNewFileName
　　MyCopyFile = True
　　Exit Function
　　errExist:
　　MyCopyFile = False
　　Exit Function
　　errPurview:
　　mclskernel32.ShowMsg "没有权限替换此文件，或者此文件目前处于使用中！！", "错误", vbCritical, 0
　　MyCopyFile = False
　　End Function
　　"遍历指定路径写的文件目录信息（返回两个字符串数组一个是文件集合另一个是目录集合返回值是文件总数）
　　Public Function SearchDirInfo(ByVal strPath As String, strFileArray() As String, strFolderArray() As String, Optional ByVal strFileExt As String = "*.*", Optional ByVal isCheckSub As Boolean = True) As Long
　　Dim i As Integer, lngItem As Long, objWda As WIN32_FIND_DATA, intFolders As Integer
　　Dim strFullPath As String, strFolders() As String
　　If Right(strPath, 1) <> "/" Then strPath = strPath & "/"
　　lngItem = FindFirstFile(strPath & "*.*", objWda)
　　If lngItem <> INVALID_HANDLE_VALUE Then
　　Do
　　"检查是不是目录
　　If (objWda.dwFileAttributes And vbDirectory) Then
　　strFullPath = Left(objWda.cFileName, InStr(objWda.cFileName, vbNullChar) - 1)
　　If Len(strFullPath) = 1 And strFullPath = "." Then
　　ElseIf Len(strFullPath) = 2 And strFullPath = ".." Then
　　
　　Else
　　If lngFolderCount Mod 10 = 0 Then mclskernel32.AppDoEvents
　　ReDim Preserve strFolderArray(0 To lngFolderCount)
　　strFolderArray(lngFolderCount) = strPath & strFullPath
　　lngFolderCount = lngFolderCount + 1
　　ReDim Preserve strFolders(0 To intFolders)
　　strFolders(intFolders) = strPath & strFullPath
　　intFolders = intFolders + 1
　　End If
　　Else
　　If lngFileCount Mod 10 = 0 Then mclskernel32.AppDoEvents
　　strFullPath = Left(objWda.cFileName, InStr(objWda.cFileName, vbNullChar) - 1)
　　If LCase(strFileExt) <> "*.*" Then
　　If LCase(GetFileExt(strFullPath)) = LCase(GetFileExt(strFileExt)) Then
　　ReDim Preserve strFileArray(0 To lngFileCount)
　　strFileArray(lngFileCount) = strPath & strFullPath
　　lngFileCount = lngFileCount + 1
　　End If
　　Else
　　ReDim Preserve strFileArray(0 To lngFileCount)
　　strFileArray(lngFileCount) = strPath & strFullPath
　　lngFileCount = lngFileCount + 1
　　End If
　　End If
　　Loop While FindNextFile(lngItem, objWda)
　　Call FindClose(lngItem)
　　End If
　　If Not isCheckSub Then
　　Exit Function
　　End If
　　For i = 0 To intFolders - 1
　　SearchDirInfo strFolders(i), strFileArray, strFolderArray, strFileExt, isCheckSub
　　Next i
　　SearchDirInfo = lngFileCount
　　End Function
　　"文件移动函数支持文件备份操作
　　Public Function FileMove(ByVal strExistingFileName As String, ByVal strNewFileName As String, Optional ByVal isBackFile As Boolean = False) As Boolean
　　If strExistingFileName = "" Then strExistingFileName = FileFullPath
　　If FileExist(strNewFileName) Then
　　If isBackFile Then
　　On Error GoTo errExist
　　Name strNewFileName As strNewFileName & ".bak"
　　Else
　　SetFileAttr strNewFileName
　　On Error GoTo errPurview
　　Kill strNewFileName
　　End If
　　End If
　　MoveFileEx strExistingFileName, strNewFileName, MOVEFILE_REPLACE_EXISTING Or MOVEFILE_COPY_ALLOWED
　　FileMove = True
　　Exit Function
　　errExist:
　　FileMove = False
　　Exit Function
　　errPurview:
　　mclskernel32.ShowMsg "没有权限替换此文件，或者此文件目前处于使用中！！", "错误", vbCritical, 0
　　FileMove = False
　　End Function
　　"删除文件函数
　　Public Function FileDelete(Optional ByVal strFile As String) As Boolean
　　If strFile = "" Then strFile = FileFullPath
　　If FileExist(strFile) Then
　　SetFileAttr strFile
　　If DeleteFile(strFile) > 0 Then
　　FileDelete = True
　　Else
　　FileDelete = False
　　End If
　　Else
　　mclskernel32.ShowMsg "文件不存在！！", "错误", vbCritical, 0
　　End If
　　End Function
　　"设置指定文件属性为正常属性
　　Private Sub SetFileAttr(ByVal strFile As String)
　　On Error Resume Next
　　If GetAttr(strFile) And vbReadOnly Then SetAttr strFile, vbNormal
　　End Sub
　　"文件查找函数（判断指定文件是否存在）
　　Private Function FileExist(ByVal strFile As String) As Boolean
　　If strFile <> "" Then
　　If Dir(strFile, 1 Or 2 Or 4) = "" Then
　　FileExist = False
　　Else
　　FileExist = True
　　End If
　　Else
　　FileExist = False
　　End If
　　End Function
　　"此函数从字符串中分离出文件扩展名
　　Private Function GetFileExt(ByVal strFileName As String) As String
　　Dim p As Integer
　　For p = Len(strFileName) To 1 Step -1
　　If InStr(".", Mid$(strFileName, p, 1)) Then Exit For
　　Next
　　GetFileExt = Right$(strFileName, Len(strFileName) - p)
　　End Function
　　Private Sub Class_Initialize()
　　msglStartTime = StartTime
　　Set mclskernel32 = New clsKernel
　　End Sub
　　Private Sub Class_Terminate()
　　lngFileCount = 0
　　lngFolderCount = 0
　　Set mclskernel32 = Nothing
　　End Sub
　　Public Function GetAppRunTime() As Single
　　GetAppRunTime = CSng(Timer - msglStartTime)
　　End Function
　　Trackback: http://tb.blog.youkuaiyun.com/TrackBack.aspx?PostId=1809726

本文转自
http://blog.youkuaiyun.com/chenhui530/archive/2007/10/02/1809726.aspx