求助!用ADO流(Stream)写入大二进制文件出错

sgrshh29

将文件分块写入到数据库的ole字段。

sgrshh29

首先谢谢你的回答
我也试过用分块写,
写进去后,导出来就比较麻烦啊
sxb2007 发表于 2010-5-17 15:00

分块导出。

sgrshh29

呵呵，不是分为10条记录，而是分10块保存到同一条记录里。等会写个代码给你。

sgrshh29

5# sxb2007


写了比较详细的注释，ado部分就不写注释了。不要忘记引用ado！
先设计一个表，名称为tbl，二个字段：ID为自动编号主键，fole为ole用来储存二进制数据
再设计一个窗体名称为窗体1，添加一个文本框名称为text0，用来显示记录的ID、一个导入按钮，一个导出按钮。窗体代码自己根据需要写。

下面是导入导出模块

导入模块
Sub FileToOle(strFileName As String)    ‘strFileName为将要保存到数据库的完整文件名
If strFileName = "" Then Exit Sub
Const BufferSize As Long = 1000# * 1024#    '块长度，这里为1M
Dim lFileSize As Long                                   ‘文件长度
Dim FileNo As Long                                       ’文件号
Dim FileData() As Byte                                 ‘二进制数组
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Set cnn = CurrentProject.Connection
rs.Open "tbl", cnn, 3, 3
FileNo = FreeFile                                          ‘获取文件号
Open strFileName For Binary As #FileNo          ’用二进制打开文件
lFileSize = LOF(FileNo)                                 ‘获取文件长度
rs.AddNew                                                  ’添加新记录
Do While lFileSize >= BufferSize                  ‘分块保存到fole字段
    ReDim FileData(BufferSize) As Byte
    Get FileNo, , FileData()
    rs("fOLE").AppendChunk FileData()
    DoEvents
    lFileSize = lFileSize - BufferSize
Loop
If lFileSize > 0 Then                                      ’将剩余字节保存到fole字段
   ReDim FileData(lFileSize) As Byte
   Get FileNo, , FileData()
   rs("fOLE").AppendChunk FileData()
End If
rs.Update                                                  ‘善后，关闭及卸载所有打开的对象
Close #FileNo
rs.Close
Set rs = Nothing
Set cnn = Nothing
MsgBox "导入结束"                                        '提醒
End Sub
导出模块
Sub OleToFile(strFileName As String)
If strFileName = "" Then Exit Sub
Const BufferSize As Long = 1000# * 1024#
Dim lFileSize As Long
Dim FileNo As Long
Dim FileData() As Byte
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Set cnn = CurrentProject.Connection
rs.Open "select * from tbl where id=" & Forms("窗体1").Controls("text0"), cnn, 3, 3
FileNo = FreeFile
Open strFileName For Binary As #FileNo
lFileSize = rs("fole").ActualSize
Do While lFileSize >= BufferSize
    ReDim FileData(BufferSize) As Byte
    FileData() = rs("fole").GetChunk(BufferSize)
    Put #FileNo, , FileData()
    DoEvents
    lFileSize = lFileSize - BufferSize
Loop
If lFileSize > 0 Then
    ReDim FileData(lFileSize) As Byte
    FileData() = rs("fole").GetChunk(lFileSize)
    Put #FileNo, , FileData()
End If
Close #FileNo
rs.Close
Set rs = Nothing
Set cnn = Nothing
MsgBox "导出结束"
End Sub

sgrshh29

一般情况导入一个300M大小的文件约2分钟，导出约30秒。