Use the self-built file buffer to increase the file read and write speed, the following is comparison // test code: Form1Option Explicit
Private cfb1 as cfilebuffprivate cfb2 as cfilebuffprivate fH1 as longprivate 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 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 kil Cfb2.create (fn2) do if cfb1.getbyte (CH) = 1 dam2.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 (false close fh1 close fH2 et = Timer MSGBOX CSTR (ET1 - ST1) & "& CSTR (ET2 - ST2) DEB Ug.print "Success!" End Sub
/// class code: cfilebuff ion explicit
'File buffer class, use block read and write to improve file read and write speed
Private Const GENERIC_WRITE = & H40000000Private Const GENERIC_READ = & H80000000Const FILE_ATTRIBUTE_NORMAL = & H80Const CREATE_ALWAYS = 2Const OPEN_ALWAYS = 4Const INVALID_HANDLE_VALUE = -1Const 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 LongPrivate 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
Private declare function setfilepointer lib "kernel32" (_ Byval Hfile As Long, Byvaliord As Long, Byval Movethod As long) As long
PUBLIC ENUM ENUMFILESEEK FS_BEGIN FS_CURRENT FS_ENDEND ENUM
Private Const MAX_FILE_BUFF As Long = 512 'defines the maximum buffer, just one sector Private Const EOF_CHAR As Byte = 0 Private m_fb (MAX_FILE_BUFF - 1) As BytePrivate m_NeedCloseFile As Boolean' need Private m_Handle As LongPrivate m_OffSet As LongPrivate m_DirtyFlag As BooleanPrivate m_LastBuff As BooleanPrivate m_MaxBytes As LongPrivate m_FileName As String 'created by the mark file 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 'look if created correctly file m_FileName = FileName ReadFileToBuff create = True Else create = False End IfEnd Function' close the file Public Sub CloseFile () WriteBuffToFile CloseHandle m_HandleEnd Sub 'move the file pointer, does not support more than 2 ^ 31 displacements Public Function fSeek ( POS as long, fs as enumfileseek) AS Boolean Dim IPOS as long if m_dirtyflag = true kil tfftofile 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) = & HFFFFFFF1 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) 'calculates the actual offset position 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 Selectens Function 'Take a byte' Returns 1 Indicates that the character 'Return 0 indicates that the file has been arrived, and CH = EOF_CHAR' Returns -1 indicates the character error.
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
