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

miaozk2006

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

 
 
 

日志

 
 

VB常用文件操作类  

2011-12-30 11:22:12|  分类: 编程-VB |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

       最近经常看到有网友问到VB文件操作相关的,正好以前写程序自己封装了一个类,希望能给大家一些帮助。当中难免存在问题希望大家修改并完善。 

程序代码:  

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 

‘***************************************

引自:http://blog.csdn.net/chenhui530/article/details/1809726


VB部分相关推荐


VB快速读取 TextBox N 行的资料

VB禁止使用 Alt-Tab Ctrl-Alt-Del

生成迷宫的程序

另一方法转换大小写

VB控件注册 - 利用资源文件将dllocx打包进exe文件

VB利用资源文件进行工作

[]vb高效编程(优化)

VB阳历转阴历

VB代码取得硬盘的物理序列号

VB获得磁盘的文件系统

VB的,经常注册和反注册OCX控件和DLL

VB从程序中生成Exe文件

VB6监视/操作剪贴板示例(VB6.0代码)

VB6里自动提交/自动填表的一种相对通用的方案

VB移动没有标题的窗体

VB随机字母的函数

VB删除带子文件夹和文件的文件夹

VB怎样屏蔽 Alt+F4

VB 隐藏进程

vb屏蔽文本框点右键时的弹出菜单

VB手控Combobox的打开或收起

VBINI文件的读写、删除(对中文支持很好)

vb全局热键的写法(占很少的资源)

vb取消文本框的粘贴功能

VB常用文件操作类

VB获取特殊文件夹

VB获取windows各常用目录的函数(模块)

VB生成太极图

VB:常用内部函数大全,你会了几个呢?

vbSendMessage函数

精简VB程序的代码

VB:将数字转换为大写中文

VB:设定 MsgBox 在若干时间之后若无回应则自动关闭

VB:读取及设定NumLock/CapsLock/ScrollLock的值

VB:您知道 Mid$ 函量可以放在 '=' 的左方吗

VB后台获得按键,并执行自己的函数(非钩子及热键)

VB:将短文件名格式转成长文件名

vb中使用Iphlpapi.dll获取网络信息(上)

vb中使用Iphlpapi.dll获取网络信息(下)

更多精彩>>>
  评论这张
 
阅读(925)| 评论(0)

历史上的今天

评论

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

页脚

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