请问VB中如何保存图片到 Sql Server中，又如何读取出来？？

[pennyzhueng]

如题

[jxfzcgh]

Const BLOCKSIZE = 8192
Public Sub SaveToDB(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 '定义循环变量
SourceFile = FreeFile '提供一个尚未使用的文件号
Open DiskFile For Binary Access Read As SourceFile '打开文件
FileLength = LOF(SourceFile) '得到文件长度
If FileLength = 0 Then '判断文件是否存在
Close SourceFile
MsgBox DiskFile & "无 内 容 或 不 存 在 !"
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() '写入FLD
Next i
ReDim byteData(LeftOver) '重新定义数据块的大小
Get SourceFile, , byteData() '读到内存块中
Fld.AppendChunk byteData() '写入FLD
Close SourceFile '关闭源文件
End If
End Sub

Public Sub ReadFromDB(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 lOffset As Long
Dim SourceFile As Long '定义自由文件号
Dim i As Long '定义循环变量
SourceFile = FreeFile '提供一个尚未使用的文件号
Open DiskFile For Binary Access Write As SourceFile '打开文件
FileLength = Fld.ActualSize '得到字段的实际长度
If FileLength = 0 Then '判断文件是否存在
Close SourceFile
' MsgBox DiskFile & "无 内 容 或 不 存 在 !"
Exit Sub
Else
NumBlocks = FileLength \ BLOCKSIZE '得到数据块的个数
LeftOver = FileLength Mod BLOCKSIZE '得到剩余字节数
'Fld.Value = Null
ReDim byteData(LeftOver) '重新定义数据块的大小
byteData() = Fld.GetChunk(LeftOver)
Put SourceFile, , byteData()
lOffset = LeftOver
For i = 1 To NumBlocks
ReDim byteData(BLOCKSIZE) '重新定义数据块的大小
byteData() = Fld.GetChunk(BLOCKSIZE) '从数据库中读出一数据块到内存中
Put SourceFile, , byteData() '从内存块写入文件中
lOffset = lOffset + BLOCKSIZE
txtByteCount = lOffset
Next i

Close SourceFile '关闭源文件

End If
End Sub

[qqqdong]

'Use ADODB.Stream Method
'After ADO 2.6
'Import the Image to SQLServer
Private Sub ImportBLOB(cn As ADODB.Connection)

Dim rs As New ADODB.Recordset
Dim stm As ADODB.Stream

Set stm = New ADODB.Stream

' Skip any table not found errors
On Error Resume Next
cn.Execute "drop table BinaryObject"

On Error GoTo 0
'Create the BinaryObject table
cn.Execute "create table BinaryObject " & _
"(blob_id int IDENTITY(1,1), " & _
"blob_filename varchar(256), " & _
"blob_object image)"

rs.Open "Select * from BinaryObject where 1=2", cn, adOpenKeyset, adLockOptimistic
'Read the binary files from disk
stm.Type = adTypeBinary
stm.Open
stm.LoadFromFile App.Path & "\BLOBsample.jpg"

rs.AddNew
rs!blob_filename = App.Path & "\BLOBsample.jpg"
rs!blob_object = stm.Read

'Insert the binary object in the table
rs.Update

rs.Close
stm.Close

Set rs = Nothing
Set stm = Nothing

End Sub
'Display the image on image control
Private Sub DisplayBLOB(cn As ADODB.Connection)

Dim rs As New ADODB.Recordset

' Select the only image in the table
rs.Open "Select * from BinaryObject where blob_id = 1", cn

' Set the DataSource to the recordset
Set imgBinaryData.DataSource = rs
'Set the DataField to the BLOB field
imgBinaryData.DataField = rs!blob_object.Name

'Release the recordset
rs.Close
Set rs = Nothing

End Sub

[zhangbob]

http://expert.csdn.net/Expert/topic/1378/1378684.xml?temp=.9124109

[gang75]

up

[Javaxhb]

Private Sub SavePicture() '保存图像文件
Dim mstream As ADODB.Stream
CDlg.FileName = ""
CDlg.ShowOpen
FileName = CDlg.FileName
If FileName = "" Then
FilePath = ""
Exit Sub
End If
If UCase(Right(FileName, 3)) = "JPG" Or UCase(Right(FileName, 3)) = "BMP" Then
FilePath = App.Path & "\tmpimage.bmp"
Set mstream = New ADODB.Stream
mstream.Type = adTypeBinary
mstream.Open
mstream.LoadFromFile FileName
Else
If MsgBox("选择图片格式不对,请重新选择!", vbOKCancel) = vbOK Then
FilePath = ""
Call Picture1_DblClick
Exit Sub
Else
FilePath = ""
Exit Sub
End If
Set mstream = New ADODB.Stream
mstream.Type = adTypeBinary
mstream.Open
mstream.LoadFromFile FileName
End If
If vEdit = eEditMode.Add Then
m_ValueDict("zp") = mstream.Read
Else
m_rs.Fields("zp").Value = mstream.Read
End If
End Sub

[Javaxhb]

Private Sub LoadPicture() '导入图像
Dim mstream As ADODB.Stream
Set mstream = New ADODB.Stream
mstream.Type = adTypeBinary
mstream.Open
Select Case vEdit
Case eEditMode.View '查看
If IsNull(m_rs.Fields("zp").Value) Then
Set mstream = Nothing
Exit Sub
End If
FilePath = App.Path & "\tmpimage.bmp"
mstream.Write m_rs.Fields("zp").Value
mstream.SaveToFile FilePath, adSaveCreateOverWrite
mstream.Close
Case eEditMode.Edit '编辑
If IsNull(m_rs.Fields("zp").Value) Then
Set mstream = Nothing
Exit Sub
End If
FilePath = App.Path & "\tmpimage.bmp"
mstream.Write m_rs.Fields("zp").Value
mstream.SaveToFile FilePath, adSaveCreateOverWrite
mstream.Close
Case eEditMode.Add '添加
If FileName <> "" Then
FilePath = App.Path & "\tmpimage.bmp"
mstream.Write m_ValueDict("zp")
mstream.SaveToFile FilePath, adSaveCreateOverWrite
mstream.Close
End If
End Select
Set mstream = Nothing

Picture1.Picture = VB.LoadPicture(FilePath)
End Sub

[Javaxhb]

Select Case vEdit
Case eEditMode.View '查看
If IsNull(m_rs.Fields("zp").Value) Then
Set mstream = Nothing
Exit Sub
End If
FilePath = App.Path & "\tmpimage.bmp"
mstream.Write m_rs.Fields("zp").Value
mstream.SaveToFile FilePath, adSaveCreateOverWrite
mstream.Close
Case eEditMode.Edit '编辑
If IsNull(m_rs.Fields("zp").Value) Then
Set mstream = Nothing
Exit Sub
End If
FilePath = App.Path & "\tmpimage.bmp"
mstream.Write m_rs.Fields("zp").Value
mstream.SaveToFile FilePath, adSaveCreateOverWrite
mstream.Close
Case eEditMode.Add '添加
If FileName <> "" Then
FilePath = App.Path & "\tmpimage.bmp"
mstream.Write m_ValueDict("zp")
mstream.SaveToFile FilePath, adSaveCreateOverWrite
mstream.Close
End If
End Select
上面可以删掉一些东西！

[amymax]

最简单的是使用 RTF 控件，绑定到数据库的text,image字段，一下子就行了。RTF 能够复制粘贴图像！类似word.

[阿牛138588]

说底了就是对appchunk和getchunk的使用。

jxfzcgh(jxfzcgh) 的应该行。qqqdong() 的有点怀疑。