登录  
 加关注
查看详情
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

miaozk2006

点滴积累与收藏:关于技术,关于生活

 
 
 

日志

 
 

VB常用文件类  

2012-06-13 23:25:43|  分类: 编程-VB |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

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

摘自:网络整理



VB相关



VB6 中善用ByRef 提升速度

[vb] Set 语句

VB_Format自定义格式

VB如读取内存地址

vb FindwindowEx的用法实例

进制转化进10进制数

收藏:如何获取当前已经打开的IE对象(VB6代码)

DXInput中键码的转换(VB6.0代码)

如何在VB6.0里动态使用具有事件的对象

[vb]格式输出Format函数

读取和写入WindowsINI文件

简述UTF8编码原理及其文本文件的读写技术【转】

VB中的文件操作

VB中的文件操作文档

vb 中拷贝文件

VB反跟踪技术点滴

VB共享软件防破解设计技术初探(二)

VB共享软件防破解设计技术初探(三)

VB共享软件防破解设计技术初探(一)

RTF文件格式【转】

VB压缩技术

[vb]FSO对象模型在VB中的应用

VB 窗体实现文件拖拽获取路径方法

VB:注册表的读写

vb中空操作(等待)的指令、延时方法

VB让控件可以当标题栏拖动

FSO对象新建、打开、保存文件

获取网关IPMAC VB源码

VB文件关联

vb获得本地和远程的MAC地址(网卡地址)

VBShellExeCute的应用

VB打开网址方法大全

vb简单控制音量大小及静音的方法

拖动无边框窗体(VB6代码)

VB使用FileSystemObject对象写文件

VB 从注册表中删除项及其某个值

vb 字符串转为数字和判断字符串是否是数字字符串【转】

vb按热键启动应用程序

VB的坐标系统综述

VB利用API函数来处理文件

关于VBShellShellExecute的总结与记录

[vb]On Error GoTo 0On Error resume区别

[vb]On Error 语句

记录一下:在菜单上添加自绘图形的例子(VB6代码)

vbfindwindow的疑惑

[vb]FindWindow使用方法

常用文件类[转,无法运行通,待调试]

[vb]url utf-8编码

VB中的Unicode Ansi 格式

VB中的format格式化函数

VB中字符串匹配的多种方式

VB抓图

vb目录文件操作的三种方法-2

vb目录文件操作的三种方法-1

vb使用open方法读写文件

VBMD5加密模块

VB 超简单的屏幕截图代码

vb以类名或窗口标题查找句柄并关闭

VB将配置保存到EXE本身(生成EXE木马程序)

VB 调用腾讯截图控件CameraDLL.dll

VB6.0中怎么实现escapeunescape

vb求任意两线交点

VB中调用Windows API的注意事项[VB知识库]

VB 一个获得自己外网IP 地址的程序代码

VB程序中实现IP地址子网掩码网关DNS的更改[]

VB 中应用FSO 对象模型介绍(摘自网络)

[] VbFSO 对象的介绍

VB 画坐标轴

VB 二进制文件的操作

[VB]BMPJPG

VBKeyCode常数用法

vb实时曲线的绘制和保存


更多精彩>>>

  评论这张
 
阅读(784)| 评论(0)

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2018