VB 二進位塊讀寫類別模組（第一版）

'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

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

'以下是使用範例-------------------------------------------------------------------------------------------------------

VB 二進位塊讀寫類別模組應用執行個體，包括一個檔案拷貝和一個檔案二進位比較的例子。

'form1.frm--------------------------------------------------------------------------------------------------------------

 檔案拷貝執行個體：（Text1存放源檔案位置，Text2存放目標檔案位置）------------------------------------------------------------------------

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是進度條控制項。
        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

---------------------------------------------------------------------------------------------------------------------------------------

二進位檔案比較執行個體(Text1存放第一個檔案的位置，Text2存放第二個檔案的位置)----------------------------

Private Sub Command2_Click()

Const BUFFER_SIZE As Long = 4096 * 2 '規定緩衝區大小
Dim cfRead1 As New CFileRead
Dim cfread2 As New CFileRead
Dim aBuf1(0 To BUFFER_SIZE - 1) As Byte '分配緩衝區
Dim aBuf2(0 To BUFFER_SIZE - 1) As Byte
Dim nActual  As Long
Dim i As Long, lCurPos As Long
Dim tmr As Single
Dim k As Long

tmr = Timer

If Not cfRead1.OpenBinary(Text1.Text) Then MsgBox "open file failed:" & Text1.Text
If Not cfread2.OpenBinary(Text2.Text) Then MsgBox "open file failed:" & Text2.Text

If cfRead1.FileLength <> cfread2.FileLength Then MsgBox "檔案不一樣長"

lCurPos = 1 '當前待比較位元組的位置,虛擬位置，不同於檔案的讀寫指標。
k = 0
Do
    '讀塊，傳給它緩衝區指標和期望讀取的位元組數，返回實際讀取的位元組數，
    nActual = cfRead1.ReadBlock(VarPtr(aBuf1(0)), BUFFER_SIZE)
    '讀第2個檔案的資料區塊
    nActual = cfread2.ReadBlock(VarPtr(aBuf2(0)), BUFFER_SIZE)
   
    For i = 0 To nActual - 1 '比較緩衝區
        If aBuf1(i) <> aBuf2(i) Then MsgBox "不同，位置：" & lCurPos: Exit Do
        lCurPos = lCurPos + 1 '移到下一個待比較位元組的位置
    Next i
   
    k = k + 1
    If k = 100 Then
        k = 0
        Cls
        Print Timer - tmr, "        ", (Seek(cfRead1.FileNumber) / 1024) / (Timer - tmr) & " KB/s"
    End If
Loop Until nActual < BUFFER_SIZE

cfRead1.CloseFile '關檔案
cfread2.CloseFile

MsgBox "OK! " & Timer - tmr

End Sub

---------------------------------------------------------------------------------------------------------------------------------------

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

完整的VB工程檔案可從這裡下載

http://lqweb.nease.net/cn/mycode/FileReadBlockFileWriteBlock.zip