'cfileread.cls-----------------------------------------------------------------------------------
option explicit
'***************************************************************
'讀寫文件的類，為文件的讀寫操作提供了封裝，用起來更方便，重用度好
'這是讀文件的類。
'劉琦。2005-3-7 last modified.
'***************************************************************
private m_bfileopened as boolean '文件打開標(biāo)志
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 '如果該類的實例正處在打開文件的
'狀態(tài)，那么不允許打開另一個文件，引發(fā)一個錯誤。這意味著這個類遵循強嚴(yán)謹(jǐn)
'性編碼規(guī)則，而非強容錯性編碼規(guī)則（按這個規(guī)則的要求，就不會報錯，而是自
'動關(guān)閉上一個打開的文件）
m_ifilenum = freefile '取得一個合法文件號
'以二進制、只讀方式打開文件
open sfqfilename for binary access read as #m_ifilenum
m_bfileopened = true '如果能執(zhí)行到這一句，說明文件打開了,記錄狀態(tài)
m_lfilelen = lof(m_ifilenum) '取得文件長度
openbinary = true 'return succeed flag!!!
exit function
catch:
end function
public sub closefile()
'關(guān)閉曾經(jīng)用openbinary打開過的文件
if m_bfileopened then '如果現(xiàn)在正處在打開文件的狀態(tài)。
'如果當(dāng)前狀態(tài)為有文件打開，那么關(guān)閉它，并設(shè)置當(dāng)前狀態(tài)
close #m_ifilenum '關(guān)閉文件
m_bfileopened = false '文件打開標(biāo)志設(shè)為假
m_ifilenum = -1 '把文件號和文件長度設(shè)為無效值
m_lfilelen = -1
else
'如果沒有打開文件
err.raise 1000 '報錯,這意味著這個類遵循強嚴(yán)謹(jǐn)
'性編碼規(guī)則
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 用來接受數(shù)據(jù)的緩沖區(qū)指針
'lbuffersize 指出緩沖區(qū)的大小（以字節(jié)計）
' (也就是期望從文件中讀取的字節(jié)數(shù))
'output-----------------------------------------------------------------------------
'返回值 實際讀取到緩沖區(qū)的字節(jié)數(shù)，可能等于也可能小于 lbuffersize
dim ltemp as long
dim abuf() as byte
'計算出從當(dāng)前文件指針開始到文件末尾還有多少字節(jié)未讀
'計算方法就是文件長度減去已讀的字節(jié)數(shù)，就是未讀的字節(jié)數(shù)
'就是 m_lfilelen-(seek(m_ifilenum)-1)
ltemp = m_lfilelen - seek(m_ifilenum) + 1
if ltemp >= lbuffersize then '[lbuffersize..)
'未讀字節(jié)數(shù)大于等于緩沖區(qū)大小
'可以填滿緩沖區(qū)(這種情況的出現(xiàn)概率較大，所以放在最前)
readblock = lbuffersize '返回實際讀取到緩沖區(qū)的字節(jié)數(shù)
redim abuf(0 to lbuffersize - 1) '分配空間,大小是lbuffersize
get #m_ifilenum, , abuf() '從文件中讀取 lbuffersize個字節(jié)
copymemory byval lpbuffer, abuf(0), lbuffersize
'把數(shù)據(jù)復(fù)制到客戶的緩沖區(qū)
elseif ltemp > 0 then '(0..lbuffersize) 也即 [1..lbuffersize-1]
' 0< ltemp < lbuffersize
'還有字節(jié)需要讀，但不足以填滿緩沖區(qū)
readblock = ltemp '返回實際讀取的字節(jié)數(shù)
redim abuf(0 to ltemp - 1) '定義一個剛好能容納將要讀取數(shù)據(jù)的數(shù)組
get #m_ifilenum, , abuf() '讀塊
copymemory byval lpbuffer, abuf(0), ltemp '投放到客戶提供的緩沖區(qū)里
else '( ..0]
'沒有字節(jié)需要讀了，回吧
readblock = 0 '返回實際讀取到緩沖區(qū)的字節(jié)數(shù)
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 '文件打開標(biāo)志
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 '如果該類的實例正處在打開文件的
'狀態(tài)，那么不允許打開另一個文件，引發(fā)一個錯誤。這意味著這個類遵循強嚴(yán)謹(jǐn)
'性編碼規(guī)則，而非強容錯性編碼規(guī)則（按這個規(guī)則的要求，就不會報錯，而是自
'動關(guān)閉上一個打開的文件）
m_ifilenum = freefile '取得一個合法文件號
'以二進制、只寫方式打開文件
open sfqfilename for binary access write as #m_ifilenum
m_bfileopened = true '如果能執(zhí)行到這一句，說明文件打開了,記錄狀態(tài)
m_lfilelen = lof(m_ifilenum) '取得文件長度
openbinary = true 'return succeed flag!!!
exit function
catch:
end function
public sub closefile()
'關(guān)閉曾經(jīng)用openbinary打開過的文件
if m_bfileopened then '如果現(xiàn)在正處在打開文件的狀態(tài)。
'如果當(dāng)前狀態(tài)為有文件打開，那么關(guān)閉它，并設(shè)置當(dāng)前狀態(tài)
close #m_ifilenum '關(guān)閉文件
m_bfileopened = false '文件打開標(biāo)志設(shè)為假
m_ifilenum = -1 '把文件號和文件長度設(shè)為無效值
m_lfilelen = -1
else
'如果沒有打開文件
err.raise 1000 '報錯,這意味著這個類遵循強嚴(yán)謹(jǐn)
'性編碼規(guī)則
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)
'把一塊緩沖區(qū)的數(shù)據(jù)寫入到文件中，前提是文件必須打開
'input--------------------------------------------------------------
'lpbuffer 數(shù)據(jù)緩沖區(qū)的指針
'ncount 期望寫入的字節(jié)數(shù)
'output-------------------------------------------------------------
'n/a
'
dim abuf() as byte
if ncount <= 0 then exit sub
redim abuf(0 to ncount - 1) '定義一個于期望寫入的字節(jié)數(shù)大小相等的數(shù)組
copymemory abuf(0), byval lpbuffer, ncount '把客戶提供的數(shù)據(jù)拷貝到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 '當(dāng)實際讀取字節(jié)數(shù)小于緩沖區(qū)大小的時候，就不需要再讀啦,已讀完啦
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 '當(dāng)實際讀取字節(jié)數(shù)小于緩沖區(qū)大小的時候，就不需要再讀啦,已讀完啦
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 '當(dāng)實際讀取字節(jié)數(shù)小于緩沖區(qū)大小的時候，就不需要再讀啦,已讀完啦
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 '當(dāng)實際讀取字節(jié)數(shù)小于緩沖區(qū)大小的時候，就不需要再讀啦,已讀完啦
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
