'CFileRead.cls-----------------------------------------------------------------------------------
Option Explicit
'***************************************************************
'读写文件的类，为文件的读写操作提供了封装，用起来更方便，重用度好
'这是读文件的类。
'刘琦。2005-3-7 Last modified.
'***************************************************************
Private m_bFileOpened As Boolean '文件打开标志
Private m_iFileNum As Integer '文件号，为什么用Integer,由FreeFile的定义得知
Private m_lFileLen As Long '文件长度
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
'打开一个二进制文件，成功返回真，失败返回假
'INPUT------------------------------------------------------------
'sFQFilename 要打开文件的全路径名
'-----------------------------------------------------------------
'OUTPUT-----------------------------------------------------------
'返回值 成功返回真，失败返回假
'-----------------------------------------------------------------
'备注-------------------------------------------------------------
'该类的一个实例在同一时间只能够打开一个文件。
'-----------------------------------------------------------------
OpenBinary = False 'default Return value.
On Error GoTo catch '错误捕获
If m_bFileOpened Then Err.Raise 1000 '如果该类的实例正处在打开文件的
'状态，那么不允许打开另一个文件，引发一个错误。这意味着这个类遵循强严谨
'性编码规则，而非强容错性编码规则（按这个规则的要求，就不会报错，而是自
'动关闭上一个打开的文件）
m_iFileNum = FreeFile '取得一个合法文件号
'以二进制、只读方式打开文件
Open sFQFilename For Binary Access Read As #m_iFileNum
m_bFileOpened = True '如果能执行到这一句，说明文件打开了,记录状态
m_lFileLen = LOF(m_iFileNum) '取得文件长度
OpenBinary = True 'return succeed flag!!!
Exit Function
catch:
End Function
Public Sub CloseFile()
'关闭曾经用OpenBinary打开过的文件
If m_bFileOpened Then '如果现在正处在打开文件的状态。
'如果当前状态为有文件打开，那么关闭它，并设置当前状态
Close #m_iFileNum '关闭文件
m_bFileOpened = False '文件打开标志设为假
m_iFileNum = -1 '把文件号和文件长度设为无效值
m_lFileLen = -1
Else
'如果没有打开文件
Err.Raise 1000 '报错,这意味着这个类遵循强严谨
'性编码规则
End If
End Sub
'几个只读属性------------------------------------------
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
'读文件的块,在使用此方法前需要先打开文件
'INPUT------------------------------------------------------------------------------
'lpBuffer 用来接受数据的缓冲区指针
'lBufferSize 指出缓冲区的大小（以字节计）
' (也就是期望从文件中读取的字节数)
'OUTPUT-----------------------------------------------------------------------------
'返回值 实际读取到缓冲区的字节数，可能等于也可能小于 lBufferSize
Dim lTemp As Long
Dim aBuf() As Byte
'计算出从当前文件指针开始到文件末尾还有多少字节未读
'计算方法就是文件长度减去已读的字节数，就是未读的字节数
'就是 m_lFileLen-(seek(m_ifilenum)-1)
lTemp = m_lFileLen - Seek(m_iFileNum) + 1
If lTemp >= lBufferSize Then '[lBufferSize..)
'未读字节数大于等于缓冲区大小
'可以填满缓冲区(这种情况的出现概率较大，所以放在最前)
ReadBlock = lBufferSize '返回实际读取到缓冲区的字节数
ReDim aBuf(0 To lBufferSize - 1) '分配空间,大小是lBufferSize
Get #m_iFileNum, , aBuf() '从文件中读取 lBufferSize个字节
CopyMemory ByVal lpBuffer, aBuf(0), lBufferSize
'把数据复制到客户的缓冲区
ElseIf lTemp > 0 Then '(0..lBufferSize) 也即 [1..lBufferSize-1]
' 0< lTemp < lBufferSize
'还有字节需要读，但不足以填满缓冲区
ReadBlock = lTemp '返回实际读取的字节数
ReDim aBuf(0 To lTemp - 1) '定义一个刚好能容纳将要读取数据的数组
Get #m_iFileNum, , aBuf() '读块
CopyMemory ByVal lpBuffer, aBuf(0), lTemp '投放到客户提供的缓冲区里
Else '( ..0]
'没有字节需要读了，回吧
ReadBlock = 0 '返回实际读取到缓冲区的字节数
End If
End Function
Private Sub Class_Terminate()
If m_bFileOpened Then Err.Raise 1000, , "Please Close File"
End Sub
'---------------------------------------------------------------------------------------------------------------------------
'CFileWrite.cls--------------------------------------------------------------------------------------------------------
Option Explicit
'***************************************************************
'读写文件的类，为文件的读写操作提供了封装，用起来更方便，重用度好
'这是写文件的类。
'刘琦。2005-3-7 Last modified.
'***************************************************************
'CFileWrite--------------------------------------------------------------------------
Private m_bFileOpened As Boolean '文件打开标志
Private m_iFileNum As Integer '文件号，为什么用Integer,由FreeFile的定义得知
Private m_lFileLen As Long '文件长度
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
'打开一个文件，成功返回真，失败返回假
'INPUT------------------------------------------------------------
'sFQFilename 要打开文件的全路径名
'-----------------------------------------------------------------
'OUTPUT-----------------------------------------------------------
'返回值 成功返回真，失败返回假
'-----------------------------------------------------------------
'备注-------------------------------------------------------------
'该类的一个实例在同一时间只能够打开一个文件。
'-----------------------------------------------------------------
OpenBinary = False 'default Return
On Error GoTo catch
If m_bFileOpened Then Err.Raise 1000 '如果该类的实例正处在打开文件的
'状态，那么不允许打开另一个文件，引发一个错误。这意味着这个类遵循强严谨
'性编码规则，而非强容错性编码规则（按这个规则的要求，就不会报错，而是自
'动关闭上一个打开的文件）
m_iFileNum = FreeFile '取得一个合法文件号
'以二进制、只写方式打开文件
Open sFQFilename For Binary Access Write As #m_iFileNum
m_bFileOpened = True '如果能执行到这一句，说明文件打开了,记录状态
m_lFileLen = LOF(m_iFileNum) '取得文件长度
OpenBinary = True 'return succeed flag!!!
Exit Function
catch:
End Function
Public Sub CloseFile()
'关闭曾经用OpenBinary打开过的文件
If m_bFileOpened Then '如果现在正处在打开文件的状态。
'如果当前状态为有文件打开，那么关闭它，并设置当前状态
Close #m_iFileNum '关闭文件
m_bFileOpened = False '文件打开标志设为假
m_iFileNum = -1 '把文件号和文件长度设为无效值
m_lFileLen = -1
Else
'如果没有打开文件
Err.Raise 1000 '报错,这意味着这个类遵循强严谨
'性编码规则
End If
End Sub
'只读属性------------------------------------------
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)
'把一块缓冲区的数据写入到文件中，前提是文件必须打开
'INPUT--------------------------------------------------------------
'lpBuffer 数据缓冲区的指针
'nCount 期望写入的字节数
'OUTPUT-------------------------------------------------------------
'N/A
'
Dim aBuf() As Byte
If nCount <= 0 Then Exit Sub
ReDim aBuf(0 To nCount - 1) '定义一个于期望写入的字节数大小相等的数组
CopyMemory aBuf(0), ByVal lpBuffer, nCount '把客户提供的数据拷贝到aBuf()中
Put #m_iFileNum, , aBuf() '写到文件
End Sub
Private Sub Class_Terminate()
If m_bFileOpened Then Err.Raise 1000, , "Please Close File"
End Sub
'----------------------------------------------------------------------------------------------------------------------------
'以下是使用范例-------------------------------------------------------------------------------------------------------
'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 "打开文件失败！" & Text1.Text
If Not m_cFileWrite.OpenBinary(Text2.Text) Then MsgBox "打开文件失败！" & Text2.Text
Do
nActual = m_cFileRead.ReadBlock(lpBuf, BUFFER_SIZE)
m_cFileWrite.WriteBlock lpBuf, nActual
Loop Until nActual < BUFFER_SIZE '当实际读取字节数小于缓冲区大小的时候，就不需要再读啦,已读完啦
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 "打开文件失败！" & Text1.Text
If Not m_cFileWrite.OpenBinary(Text2.Text) Then MsgBox "打开文件失败！" & Text2.Text
Do
nActual = m_cFileRead.ReadBlock(VarPtr(aBuf(0)), BUFFER_SIZE)
m_cFileWrite.WriteBlock VarPtr(aBuf(0)), nActual
Loop Until nActual < BUFFER_SIZE '当实际读取字节数小于缓冲区大小的时候，就不需要再读啦,已读完啦
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 "打开文件失败！" & Text1.Text
If Not m_cFileWrite.OpenBinary(Text2.Text) Then MsgBox "打开文件失败！" & Text2.Text
lFileLen = m_cFileRead.FileLength
iFileNum = m_cFileRead.FileNumber
k = 0
Do
k = k + 1
If k = 10 Then
k = 0
pb1.Value = 100 * (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 '当实际读取字节数小于缓冲区大小的时候，就不需要再读啦,已读完啦
m_cFileRead.CloseFile
m_cFileWrite.CloseFile
MsgBox "OK! total time:" & Timer - tmr
End Sub
Private Sub Command4_Click()
Dim sPass As String
sPass = InputBox("请输入密码。")
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 "打开文件失败！" & Text1.Text
If Not m_cFileWrite.OpenBinary(Text2.Text) Then MsgBox "打开文件失败！" & Text2.Text
lFileLen = m_cFileRead.FileLength
iFileNum = m_cFileRead.FileNumber
k = 0
Do
k = k + 1
If k = 10 Then
k = 0
pb1.Value = 100 * (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 '当实际读取字节数小于缓冲区大小的时候，就不需要再读啦,已读完啦
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 "打开文件失败！" & Text1.Text
m_cFileRead.CloseFile
If Not m_cFileRead.OpenBinary(Text1.Text) Then MsgBox "打开文件失败！" & Text1.Text
m_cFileRead.CloseFile
If Not m_cFileWrite.OpenBinary(Text2.Text) Then MsgBox "打开文件失败！" & Text2.Text
m_cFileWrite.CloseFile
If Not m_cFileWrite.OpenBinary(Text2.Text) Then MsgBox "打开文件失败！" & Text2.Text
m_cFileWrite.CloseFile
End Sub
'---------------------------------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------------------------------'
完整的VB工程文件可从这里下载
http://lqweb.nease.net/mycode/FileReadBlockFileWriteBlock.zip