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
文章整理：站长天空 网址：http://www.z6688.com/
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
