''''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
  &

[1] [2]  下一页