|
''''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] 下一页
[VB.NET程序]GSM短信模块库函数，可以用VB,VC,调用简单实用 [办公软件]PowerPoint做交互课件之弃用VBA
[办公软件]VBA获取U盘、主板、CPU序列号和网卡MAC地址 [办公软件]VBA设置文件属性及加密源代码示例
[办公软件]VBA中初始化ADO连接的几种方法 [网络安全]“VB破坏者变种N”病毒摘要
[Web开发]ASP.NET上传文件到数据库VB版 [办公软件]在Excel中利用VBA实现多表单元格数据的读取与赋值…
[办公软件]使用Vba读取已关闭的Excel工作薄数据到当前工作表… [办公软件]Excel编程基础之VBA文件操作详解
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
