VB binary Block read-write class module (first edition)

Binary ' Cfileread.cls-----------------------------------------------------------------------------------

Option Explicit

'***************************************************************
' Read and write file class, for file read and write operation provides encapsulation, easy to use, reuse degree good
' This is the class that reads the file.
' Liu Qi. 2005-3-7 last modified.
'***************************************************************

Private m_bfileopened as Boolean ' File open flag

Private m_ifilenum As Integer ' file number, why use integer, by the definition of freefile know

Private M_lfilelen as Long ' file length

Private Declare Sub copymemory Lib "Kernel32" Alias _
"RtlMoveMemory" (destination as Any, _
Source as any, ByVal Length as Long

Public Function openbinary (ByVal sfqfilename as String) as Boolean
' Open a binary file, return true successfully, fail return false
' INPUT------------------------------------------------------------
' Sfqfilename to open the file's full path name
'-----------------------------------------------------------------
' OUTPUT-----------------------------------------------------------
' Return value successfully returned true, failure returns false
'-----------------------------------------------------------------
' Remarks-------------------------------------------------------------
' An instance of the class can only open a file at the same time.
'-----------------------------------------------------------------

openbinary = False ' default return value.

On error GoTo catch ' Bug Catch '

If m_bfileopened Then err.raise 1000 ' If an instance of the class is in the open file
' State, you are not allowed to open another file, raising an error. This means that this class follows a strong rigorous
' Sexual coding rules, rather than strong fault-tolerant coding rules (as required by this rule, will not be an error, but from
' Move close last Open file '

M_ifilenum = FreeFile ' Get a legal file number

' Open a file in binary, read-only mode
Open sfqfilename for Binary Access Read as #m_iFileNum

m_bfileopened = True ' If you can execute to this sentence, the documentation is open and the status of the record

M_lfilelen = LOF (m_ifilenum) ' Get file length

Openbinary = True ' return SUCCEED flag!!!

Exit Function
Catch:
End Function

Public Sub CloseFile ()
' Close a file that has been opened with Openbinary

If m_bfileopened Then ' If you are now in the state of the open file.

' If the current state is open for a file, then close it and set the current state
Close #m_iFileNum ' closes file
m_bfileopened = False ' File open flag set to False
M_ifilenum =-1 ' Set the file number and file length to an invalid value
M_lfilelen =-1
Else
' If you don't open the file
Err.Raise 1000 ' error, which means that this class follows strong rigor
' Sex Code rules
End If

End Sub

' Several read-only properties------------------------------------------
Public Property Get FileNumber () as Integer
FileNumber = M_ifilenum
End Property

Public Property Get Fileopened () as Boolean
fileopened = m_bfileopened
End Property

Public Property Get Filelength () as Long
Filelength = M_lfilelen
End Property
'-------------------------------------------------------

Public Function Readblock (ByVal lpbuffer as Long, _
ByVal Lbuffersize as Long) as long
' Read the block of the file, you need to open the file before using this method
' INPUT------------------------------------------------------------------------------
' Lpbuffer the buffer pointer used to accept data
' Lbuffersize indicates the size of the buffer (in bytes)
' (that is, the number of bytes that are expected to be read from the file)
' OUTPUT-----------------------------------------------------------------------------
' The number of bytes the return value actually reads to the buffer, which may or may be less than lbuffersize

Dim Ltemp as Long
Dim abuf () as Byte

' Calculates how many bytes are unread from the current file pointer to the end of the file
' The calculation is the file length minus the number of bytes read, which is the number of unread bytes.
' Is m_lfilelen-(Seek (M_ifilenum)-1)
Ltemp = M_lfilelen-seek (m_ifilenum) + 1

If ltemp >= lbuffersize Then ' [lbuffersize ...]
' Unread byte count is greater than or equal to buffer size

' Can fill the buffer (the probability of occurrence is greater, so put it in the front)
Readblock = Lbuffersize ' Returns the number of bytes actually read to the buffer
ReDim abuf (0 to LBufferSize-1) ' allocate space, size is lbuffersize
Get #m_iFileNum, Abuf () reads lbuffersize bytes from file
CopyMemory ByVal lpbuffer, abuf (0), lbuffersize
' Copy the data to the customer's buffer

ElseIf ltemp > 0 Then ' (0..lBufferSize) also known as [1..lbuffersize-1]
' 0< Ltemp < lbuffersize

' There are still bytes to read, but not enough to fill the buffer
Readblock = Ltemp ' Returns the number of bytes actually read
ReDim abuf (0 to LTemp-1) ' defines an array that just holds the data that will be read
Get #m_iFileNum,, abuf () ' Read block
CopyMemory ByVal lpbuffer, abuf (0), ltemp ' into customer-supplied buffers

Else ' (.. 0]

' There's no byte to read, go back
Readblock = 0 ' Returns the number of bytes actually read to the buffer

End If

End Function

Private Sub Class_Terminate ()
If m_bfileopened Then err.raise 1000,, "Please close File"
End Sub
'-------------------------------------------------------------------------------------------------------------- -------------

' Cfilewrite.cls--------------------------------------------------------------------------------------------------------

Option Explicit

'***************************************************************
' Read and write file class, for file read and write operation provides encapsulation, easy to use, reuse degree good
' This is the class that writes the file.
' Liu Qi. 2005-3-7 last modified.
'***************************************************************

' Cfilewrite--------------------------------------------------------------------------

Private m_bfileopened as Boolean ' File open flag

Private m_ifilenum As Integer ' file number, why use integer, by the definition of freefile know

Private M_lfilelen as Long ' file length

Private Declare Sub copymemory Lib "Kernel32" Alias _
"RtlMoveMemory" (destination as any, Source as any, _
ByVal Length as Long)

Public Function openbinary (ByVal sfqfilename as String) as Boolean
' Open a file, return true successfully, fail return false
' INPUT------------------------------------------------------------
' Sfqfilename to open the file's full path name
'-----------------------------------------------------------------
' OUTPUT-----------------------------------------------------------
' Return value successfully returned true, failure returns false
'-----------------------------------------------------------------
' Remarks-------------------------------------------------------------
' An instance of the class can only open a file at the same time.
'-----------------------------------------------------------------

openbinary = False ' default return

On Error GoTo catch

If m_bfileopened Then err.raise 1000 ' If an instance of the class is in the open file
' State, you are not allowed to open another file, raising an error. This means that this class follows a strong rigorous
' Sexual coding rules, rather than strong fault-tolerant coding rules (as required by this rule, will not be an error, but from
' Move close last Open file '

M_ifilenum = FreeFile ' Get a legal file number

' Open a file in binary, write-only mode
Open sfqfilename for Binary Access Write as #m_iFileNum

m_bfileopened = True ' If you can execute to this sentence, the documentation is open and the status of the record


M_lfilelen = LOF (m_ifilenum) ' Get file length

Openbinary = True ' return SUCCEED flag!!!
Exit Function
Catch:
End Function

Public Sub CloseFile ()
' Close a file that has been opened with Openbinary

If m_bfileopened Then ' If you are now in the state of the open file.

' If the current state is open for a file, then close it and set the current state
Close #m_iFileNum ' closes file
m_bfileopened = False ' File open flag set to False
M_ifilenum =-1 ' Set the file number and file length to an invalid value
M_lfilelen =-1
Else
' If you don't open the file
Err.Raise 1000 ' error, which means that this class follows strong rigor
' Sex Code rules
End If

End Sub

' Read-only property------------------------------------------
Public Property Get FileNumber () as Integer
FileNumber = M_ifilenum
End Property

Public Property Get Fileopened () as Boolean
fileopened = m_bfileopened
End Property

Public Property Get Filelength () as Long
Filelength = M_lfilelen
End Property
'-------------------------------------------------------

Public Sub WriteBlock (ByVal lpbuffer as Long, ByVal ncount as Long)
' writes a buffer of data to a file, provided the file must be opened
' INPUT--------------------------------------------------------------
' Lpbuffer A pointer to a data buffer
' Ncount the number of bytes expected to be written
' OUTPUT-------------------------------------------------------------
' N/A
'
Dim abuf () as Byte

If ncount <= 0 Then Exit Sub

ReDim abuf (0 to NCount-1) ' defines an array that is equal in size to the desired number of bytes written

CopyMemory abuf (0), ByVal lpbuffer, ncount ' copy customer-supplied data to ABUF ()

Put #m_iFileNum,, abuf () ' Write to File

End Sub

Private Sub Class_Terminate ()
If m_bfileopened Then err.raise 1000,, "Please close File"
End Sub

'-------------------------------------------------------------------------------------------------------------- --------------

' Here's how to use the example-------------------------------------------------------------------------------------------------------

' Form1.frm--------------------------------------------------------------------------------------------------------------

Option Explicit

Dim M_cfileread as New cfileread
Dim M_cfilewrite as New cfilewrite

Private Sub Command1_Click ()
Const buffer_size as Long = 4096 * 2
Dim Nactual as Long
Dim abuf (0 to buffer_size-1) as Byte
Dim Lpbuf as Long
Dim TMR as Single

TMR = Timer

Lpbuf = VarPtr (abuf (0))

If not M_cfileread.openbinary (text1.text) Then MsgBox "Open file failed!" "& Text1.Text
If not M_cfilewrite.openbinary (text2.text) Then MsgBox "Open file failed!" "& Text2.text

Todo
Nactual = M_cfileread.readblock (lpbuf, Buffer_size)
M_cfilewrite.writeblock Lpbuf, Nactual
Loop Until nactual < buffer_size ' when the actual byte count is less than the buffer size, there's no need to read it anymore.

M_cfileread.closefile
M_cfilewrite.closefile

MsgBox "ok! Total time: "& TIMER-TMR
End Sub

Private Sub Command2_Click ()
Const buffer_size = 1
Dim Nactual as Long
Dim abuf (0 to buffer_size-1) as Byte
Dim TMR as Single

TMR = Timer

If not M_cfileread.openbinary (text1.text) Then MsgBox "Open file failed!" "& Text1.Text
If not M_cfilewrite.openbinary (text2.text) Then MsgBox "Open file failed!" "& Text2.text

Todo
Nactual = M_cfileread.readblock (varptr (abuf (0)), buffer_size)
M_cfilewrite.writeblock varptr (abuf (0)), nactual
Loop Until nactual < buffer_size ' when the actual byte count is less than the buffer size, there's no need to read it anymore.

M_cfileread.closefile
M_cfilewrite.closefile

MsgBox "ok! Total time: "& TIMER-TMR
End Sub

Private Sub Command3_Click ()
Const buffer_size = 40960 * 2
Dim Nactual as Long
Dim abuf (0 to buffer_size-1) as Byte
Dim TMR as Single
Dim Lfilelen as Long
Dim Ifilenum as Integer
Dim K as Long

TMR = Timer

If not M_cfileread.openbinary (text1.text) Then MsgBox "Open file failed!" "& Text1.Text
If not M_cfilewrite.openbinary (text2.text) Then MsgBox "Open file failed!" "& Text2.text
Lfilelen = M_cfileread.filelength
Ifilenum = M_cfileread.filenumber

K = 0
Todo
K = k + 1
If k = Ten Then
K = 0
PB1. Value = * (Seek (Ifilenum)/Lfilelen)
DoEvents
End If
Nactual = M_cfileread.readblock (varptr (abuf (0)), buffer_size)
M_cfilewrite.writeblock varptr (abuf (0)), nactual
Loop Until nactual < buffer_size ' when the actual byte count is less than the buffer size, there's no need to read it anymore.

M_cfileread.closefile
M_cfilewrite.closefile

MsgBox "ok! Total time: "& TIMER-TMR
End Sub

Private Sub Command4_click ()
Dim Spass as String
Spass = InputBox ("Enter your password.) ")
Dim Clogi as New clogistic
Clogi.pass = Spass

Const buffer_size = 4096
Dim Nactual as Long
Dim abuf (0 to buffer_size-1) as Byte
Dim TMR as Single
Dim Lfilelen as Long
Dim Ifilenum as Integer
Dim K as Long

TMR = Timer

If not M_cfileread.openbinary (text1.text) Then MsgBox "Open file failed!" "& Text1.Text
If not M_cfilewrite.openbinary (text2.text) Then MsgBox "Open file failed!" "& Text2.text
Lfilelen = M_cfileread.filelength
Ifilenum = M_cfileread.filenumber

K = 0
Todo
K = k + 1
If k = Ten Then
K = 0
PB1. Value = * (Seek (Ifilenum)/Lfilelen)
DoEvents
End If
Nactual = M_cfileread.readblock (varptr (abuf (0)), buffer_size)
Clogi.encblock Abuf, Nactual
M_cfilewrite.writeblock varptr (abuf (0)), nactual
Loop Until nactual < buffer_size ' when the actual byte count is less than the buffer size, there's no need to read it anymore.

M_cfileread.closefile
M_cfilewrite.closefile

MsgBox "ok! Total time: "& TIMER-TMR

End Sub

Private Sub Command5_click ()
If not M_cfileread.openbinary (text1.text) Then MsgBox "Open file failed!" "& Text1.Text
M_cfileread.closefile

If not M_cfileread.openbinary (text1.text) Then MsgBox "Open file failed!" "& Text1.Text
M_cfileread.closefile

If not M_cfilewrite.openbinary (text2.text) Then MsgBox "Open file failed!" "& Text2.text
M_cfilewrite.closefile
If not M_cfilewrite.openbinary (text2.text) Then MsgBox "Open file failed!" "& Text2.text
M_cfilewrite.closefile

End Sub


'-------------------------------------------------------------------------------------------------------------- -------------

'-------------------------------------------------------------------------------------------------------------- -----------'

Complete VB project files can be downloaded from here

Http://lqweb.nease.net/mycode/FileReadBlockFileWriteBlock.zip