利用自建的文件缓冲区来提高文件读写速度,下面是与VB 自带的Put Get 进行比较
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 测试代码 :Form1 Option Explicit
Private cfb1 As CFileBuff Private cfb2 As CFileBuff Private fh1 As Long Private fh2 As Long
Private Sub Command1_Click() Dim fn1 As String Dim fn2 As String Dim fn3 As String Dim ch As Byte Dim i As Long Dim st1 As Single, et1 As Single Dim st2 As Single, et2 As Single fn1 = App.Path & "\D.DAT" fn2 = App.Path & "\D.BAK" fn3 = App.Path & "\D.BAK2" st1 = Timer Set cfb1 = New CFileBuff Set cfb2 = New CFileBuff If cfb1.Create(fn1) = True Then cfb2.Create (fn2) Do If cfb1.GetByte(ch) = 1 Then cfb2.PutByte ch Else Exit Do End If Loop While cfb1.FEof = False Else Debug.Print "Error Open File!" End If Set cfb1 = Nothing Set cfb2 = Nothing et1 = Timer ' MsgBox CStr(et1 - st1) st2 = Timer fh1 = FreeFile(0) Open fn1 For Binary As fh1 fh2 = FreeFile(0) Open fn3 For Binary As fh2 Do Get fh1, , ch Put fh2, , ch Loop While EOF(fh1) = False Close fh1 Close fh2 et2 = Timer MsgBox CStr(et1 - st1) & " " & CStr(et2 - st2) Debug.Print "Success!" End Sub
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 类代码 : CFileBuff Option Explicit
'文件缓冲类,利用块读写来提高文件的读写速度
Private Const GENERIC_WRITE = &H40000000 Private Const GENERIC_READ = &H80000000 Const FILE_ATTRIBUTE_NORMAL = &H80 Const CREATE_ALWAYS = 2 Const OPEN_ALWAYS = 4 Const INVALID_HANDLE_VALUE = -1 Const ERROR_HANDLE_EOF = 38
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _ lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _ lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) _ As Long
Private Declare Function CloseHandle Lib "kernel32" ( _ ByVal hObject As Long) As Long
Private Declare Function WriteFile Lib "kernel32" ( _ ByVal hFile As Long, lpBuffer As Any, _ ByVal nNumberOfBytesToWrite As Long, _ lpNumberOfBytesWritten As Long, ByVal lpOverlapped As _ Long) As Long
Private Declare Function CreateFile Lib "kernel32" _ Alias "CreateFileA" (ByVal lpFileName As String, _ ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _ ByVal lpSecurityAttributes As Long, _ ByVal dwCreationDisposition As Long, _ ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile _ As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" ( _ ByVal hFile As Long, ByVal loWord As Long, ByVal hiWord As Long, ByVal MoveMethod As Long) As Long
Public Enum enumFileSeek FS_BEGIN FS_CURRENT FS_END End Enum
Private Const MAX_FILE_BUFF As Long = 512 '定义最大的缓冲区,正好一个扇区 Private Const EOF_CHAR As Byte = 0
Private m_fb(MAX_FILE_BUFF - 1) As Byte Private m_NeedCloseFile As Boolean '是否需要
Private m_Handle As Long Private m_OffSet As Long Private m_DirtyFlag As Boolean Private m_LastBuff As Boolean Private m_MaxBytes As Long Private m_FileName As String '按标志创建文件 Public Function Create(FileName As String) As Boolean m_Handle = CreateFile(FileName, GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0) If m_Handle <> INVALID_HANDLE_VALUE Then '看是否正确创建了文件 m_FileName = FileName ReadFileToBuff Create = True Else Create = False End If End Function '关闭文件 Public Sub CloseFile() WriteBuffToFile CloseHandle m_Handle End Sub '移动文件指针,不支持超过2 ^ 31 的位移 Public Function FSeek(Pos As Long, FS As enumFileSeek) As Boolean Dim iPos As Long If m_DirtyFlag = True Then WriteBuffToFile Select Case FS Case FS_BEGIN If Pos < 0 Then FSeek = False If SetFilePointer(m_Handle, Pos, 0, 0) = &HFFFFFFFF Then FSeek = False Else If ReadFileToBuff = -1 Then FSeek = False Else FSeek = True End If End If Case FS_END If Pos > 0 Then FSeek = False If SetFilePointer(m_Handle, Pos, 0, 2) = &HFFFFFFFF Then FSeek = False Else If ReadFileToBuff = -1 Then FSeek = False Else FSeek = True End If End If Case FS_CURRENT iPos = Pos - (m_MaxBytes - m_OffSet) '计算实际的偏移位置 If SetFilePointer(m_Handle, iPos, 0, 1) = &HFFFFFFFF Then FSeek = False Else If ReadFileToBuff = -1 Then FSeek = False Else FSeek = True End If End If End Select End Function '取一个字节 '返回 1 表示正确取到字符 '返回 0 表示已到文件尾,并且ch= EOF_CHAR '返回 -1 表示取字符错误。 Public Function GetByte(ByRef ch As Byte) As Long Dim fl As Long If m_LastBuff = False Then If m_OffSet = MAX_FILE_BUFF Then fl = ReadFileToBuff Select Case fl Case 0 GetByte = 0 Case -1 GetByte = -1 Case Else ch = m_fb(0) m_OffSet = 1 GetByte = 1 End Select Else ch = m_fb(m_OffSet) m_OffSet = m_OffSet + 1 GetByte = 1 End If Else If m_OffSet < m_MaxBytes Then ch = m_fb(m_OffSet) m_OffSet = m_OffSet + 1 GetByte = 1 Else ch = EOF_CHAR GetByte = 0 End If End If End Function '写一个字节,如果正确表示1,错误为-1 Public Function PutByte(by As Byte) As Long If m_OffSet < MAX_FILE_BUFF Then m_fb(m_OffSet) = by m_OffSet = m_OffSet + 1 m_DirtyFlag = True Else '已写满一个缓冲区 WriteBuffToFile m_fb(0) = by m_OffSet = 1 m_DirtyFlag = True End If End Function '看当前指针是否到达文件最尾端 Public Function FEof() As Boolean If m_LastBuff = False Then FEof = False Else If m_OffSet = m_MaxBytes Then FEof = True Else FEof = False End If End If End Function '/////////////////////////////////////////////////////////////////////////////////////// '预读字节到缓冲区,并返回实际读到的字节,如果返回-1,则表示出错了。 Private Function ReadFileToBuff() As Long Dim dwReadNum As Long If ReadFile(m_Handle, m_fb(0), MAX_FILE_BUFF, dwReadNum, 0) = 0 Then ReadFileToBuff = -1 Else If dwReadNum <> MAX_FILE_BUFF Then '最后一个缓冲区 m_LastBuff = True m_MaxBytes = dwReadNum m_OffSet = 0 m_DirtyFlag = False ReadFileToBuff = dwReadNum Else m_LastBuff = False m_MaxBytes = MAX_FILE_BUFF m_OffSet = 0 m_DirtyFlag = False ReadFileToBuff = MAX_FILE_BUFF End If End If End Function '写缓冲区到文件,并返回实际写的字节数 Private Function WriteBuffToFile() As Long Dim dwWriteNum As Long If m_OffSet = 0 Or m_DirtyFlag = False Then '如果写入数为0或者写入标志错则不写入 WriteBuffToFile = 0 Else If WriteFile(m_Handle, m_fb(0), m_OffSet, dwWriteNum, 0) Then WriteBuffToFile = dwWriteNum Else WriteBuffToFile = -1 '出错 End If End If m_OffSet = 0 m_DirtyFlag = False End Function
Private Sub Class_Initialize() Dim i As Long m_OffSet = 0 m_Handle = 0 m_DirtyFlag = False m_FileName = "" m_LastBuff = False m_MaxBytes = MAX_FILE_BUFF End Sub
Private Sub Class_Terminate() CloseFile End Sub

|