您现在的位置： 阿标在线 >> 技术文章 >> .NET技术 >> VB.Net语言 >> 正文

VB 二进制块读写类模块（第一版）

[ 录入：阿标 | 点击数： | 更新时间：2005-3-18 12:55:00]
'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


  • 上一篇文章：

  • 下一篇文章： 没有了