从SQL数据库中写入和读出image出现错误，两函数如下，哪位达人指导一下
Public Function ReadImage(blobColumn As ADODB.Field) As String
Dim strFileName As String
strFileName = "ImageTmp"
Dim FileNumber As Integer
Dim DataLen As Long
Dim Chunks As Long
Dim ChunkAry() As Byte
Dim ChunkSize As Long
Dim Fragment As Long
Dim lngI As Long
On Error GoTo errhander
ChunkSize = 51200
If IsNull(blobColumn) Then Exit Function
Datelen = blobColumn.ActualSize
If DataLen < 8 Then Exit Function
FileNumber = FreeFile
Open strFileName For Binary Access Write As FileNumber
Chunks = DataLen \ ChunkSize
Fragment = DataLen Mod ChunkSize
If Fragment > 0 Then
ReDim ChunkAry(Fragment - 1)
Put FileNumber, , ChunkAry
End If
ReDim ChunkAry(ChunkSize - 1)
For lngI = 1 To Chunks
ChunkAry = blobColumn.GetChunk(ChunkSize)
Put FileNumber, , ChunkAry()
Next lngI
Close FileNumber
ReadImage = strFileName
Exit Function
errhander:
ReadImage = ""
End Function
Public Sub WriteImage(ByRef Fld As ADODB.Field, diskFile As String)
Dim byteData() As Byte
Dim NumBlocks As Long
Dim FileLength As Long
Dim LeftOver As Long
Dim SourceFile As Long
Dim i As Long
Const BLOCKSIZE = 4096
SourceFile = FreeFile
Open diskFile For Binary Access Read As SourceFile
FileLength = LOF(SourceFile)
If FileLength = 0 Then
Close SourceFile
MsgBox "无内容或文件不存在"
Else
NumBlocks = FileLength \ BLOCKSIZE
LeftOver = FileLength Mod BLOCKSIZE
Fld.Value = Null
ReDim byteData(BLOCKSIZE)
For i = 1 To NumBlocks
Get SourceFile, , byteData()
Fld.AppendChunk byteData()
Next i
ReDim byteData(LeftOver)
Get SourceFile, , byteData()
Fld.AppendChunk byteData()
Close SourceFile
End If
End Sub
写入的时候:
call WriteImage rs("photo"),filename
读出
picture1.picture=LoadPicture(ReadImage(rs("photo")))
写入时没有错误，读出报错，不知道是不是根本就没写入过。
问题点数：50、回复次数：3Top
1 楼Leftie（左手,为人民币服务）回复于 2005-06-02 05:39:49 得分 40
试试另外的方法：
使用流对象保存和显示文件
打开vb6,新建工程。
添加两个按钮,一个image控件
注意:Access中的photo字段类型为OLE对象.
SqlServer中的photo字段类型为Image
'** 引用 Microsoft ActiveX Data Objects 2.5 Library 及以上版本
‘2.5版本以下不支持Stream对象
Dim iConcstr As String
Dim iConc As ADODB.Connection
'保存文件到数据库中
Sub s_SaveFile()
Dim iStm As ADODB.Stream
Dim iRe As ADODB.Recordset
Dim iConcstr As String
'读取文件到内容
Set iStm = New ADODB.Stream
With iStm
.Type = adTypeBinary '二进制模式
.Open
.LoadFromFile App.Path + "\test.jpg"
End With
'打开保存文件的表
Set iRe = New ADODB.Recordset
With iRe
.Open "select * from img", iConc, 1, 3
.AddNew '新增一条记录
.Fields("photo") = iStm.Read
.Update
End With
'完成后关闭对象
iRe.Close
iStm.Close
End Sub
Sub s_ReadFile()
Dim iStm As ADODB.Stream
Dim iRe As ADODB.Recordset
'打开表
Set iRe = New ADODB.Recordset
‘得到最新添加的纪录
iRe.Open "select top 1 * from img order by id desc", iConc, adOpenKeyset, adLockReadOnly
'保存到文件
Set iStm = New ADODB.Stream
With iStm
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write iRe("photo")
‘这里注意了,如果当前目录下存在test1.jpg,会报一个文件写入失败的错误.
.SaveToFile App.Path & "\test1.jpg"
End With
Image1.Picture = LoadPicture(App.Path & "\test1.jpg")
'关闭对象
iRe.Close
iStm.Close
End Sub
Private Sub Command1_Click()
Call s_ReadFile
End Sub
Private Sub Command2_Click()
Call s_SaveFile
End Sub
Private Sub Form_Load()
'数据库连接字符串
iConcstr = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
";Data Source=F:\csdn_vb\database\保存图片\access图片\img.mdb"
‘下面的语句是连接sqlserver数据库的.
‘iConcstr = "Provider=SQLOLEDB.1;Persist Security Info=True;" & _
‘ "User ID=sa;Password=;Initial Catalog=test;Data Source=yang"
Set iConc = New ADODB.Connection
iConc.Open iConcstr
End Sub
Private Sub Form_Unload(Cancel As Integer)
iConc.Close
Set iConc = Nothing
End SubTop
2 楼kkmnv（风来了，我走了）回复于 2005-06-02 08:43:17 得分 5
楼上的方法可以用Top
3 楼chenstu（皮蛋）回复于 2005-06-02 09:49:01 得分 5
上面的方法可以用，我已经使用过了！Top
相关问题
关键词
得分解答快速导航
相关链接
广告也精彩
反馈
