如何用VB.net直接向ACSSES和SQL SERVER读写图像？

[fheb2003]

我是初学者，请详细些！

[谜斯特段]

我是转抄坛子中一位高手的内容,是谁我忘了(不好意思)：

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

Private Sub SavePictureToDB(cn As ADODB.Connection)
'将BMP图片存入数据库
On Error GoTo EH
Set stm = New ADODB.Stream
rs.Open "select ImagePath,ImageValue from tbl_Image", cn, adOpenKeyset, adLockOptimistic
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName

With stm
.Type = adTypeBinary
.Open
.LoadFromFile CommonDialog1.FileName
End With
With rs
.AddNew
.Fields("ImagePath") = Text1.Text
.Fields("ImageValue") = stm.Read
.Update
End With
rs.Close
Set rs = Nothing
Exit Sub
EH: MsgBox Err.Description, vbInformation, "Error"
End Sub


Private Sub LoadPictureFromDB(cn As ADODB.Connection)
'载数据库中读出BMP图片
On Error GoTo EH
Dim strTemp As String
Set stm = New ADODB.Stream
strTemp = "c:\temp.tmp" '临时文件,用来保存读出的图片
rs.Open "select ImagePath,ImageValue from tbl_image", cn, , , adCmdText
With stm
.Type = adTypeBinary
.Open
.Write rs("ImageValue")
.SaveToFile strTemp, adSaveCreateOverWrite
.Close
End With
Image1.Picture = LoadPicture(strTemp)
Set stm = Nothing
rs.Close
Set rs = Nothing
Exit Sub
EH: MsgBox Err.Description, vbInformation, "Error"
End Sub


image类型
用picture显示
'以下两个函数是从数据库中读出图片的核心程序

Public Function GetImage(Optional Filename As String) As Variant
On Error GoTo ProcErr

Dim objRS As adodb.Recordset
Dim strSQL As String
Dim Chunk() As Byte

Set objRS = New adodb.Recordset

'strSQL = "select thumb from tblpictures where idpict='" & tblID(ThumbIndex) & "'"
strSQL = "select thumb from tblpictures where idpict= " & thumb
'strSQL = "select thumb from tblpictures where idpict='387'"
'db.Execute strSQL
objRS.Open strSQL, db, adOpenForwardOnly, adLockReadOnly

If objRS.BOF And objRS.EOF Then
GetImage = 0
GoTo ProcExit
ElseIf IsNull(objRS.Fields(0)) Then
'ErrNumber = 1001
'ErrDesc = "字段为空"
GoTo ProcExit
End If

Chunk() = objRS.Fields(0).GetChunk(objRS.Fields(0).ActualSize)
Set GetImage = Chunk2Image(Chunk(), Filename)

ProcExit:
On Error Resume Next
'objRS.Close
' Chunk() = objRS.Fields(0).GetChunk(0)
Set GetImage = Chunk2Image(Chunk(), Filename)
' Set objRS = Nothing

Exit Function

ProcErr:
GetImage = 0
Resume ProcExit
End Function


Private Function Chunk2Image(Chunk() As Byte, Optional Filename As String) As Variant
On Error GoTo ProcErr
Dim KeepFile As Boolean
Dim Datafile As Integer

KeepFile = True
If Trim(Filename) = "" Then
Filename = "c:\tmpxxdb.fil"
KeepFile = False
End If

Datafile = FreeFile
Open Filename For Binary Access Write As Datafile
Put Datafile, , Chunk()
Close Datafile

ProcExit:
Set Chunk2Image = LoadPicture(Filename)
On Error Resume Next
' If Not KeepFile Then Kill filename
Exit Function

ProcErr:
On Error Resume Next
Kill Filename
Chunk2Image = 0
End Function

[Montaque]

http://expert.csdn.net/Expert/TopicView1.asp?id=1521284 101例子中有
我也写了一片:
http://www.csdn.net/develop/read_article.asp?id=14963

[Montaque]

http://www.csdn.net/develop/read_article.asp?id=14963