高分求教。自已用vb写的一个控件，如何通过activex提交图片到sql server数据库中？

[agevan]

自已写的一个控件，该控件内有一个画笔模块，用于画出一张图片，图片名称为　时间.gif　，如何将画好的图片提交到数据库保存里呢？谢谢。

[zjsm96441125]

rs("字段")=picture1.image

[w18ily]

ado2.6以后都支持Stream方法！

用ado的stream对象，使用方便而且是发展趋势。
是一个存图象到数据库然后读出的例子！
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
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

[CnChenyuan]

解决了，给分吧。

[zhgj1728]

给你一个启发
Public Sub SaveToDB()
Dim AdoCnn As New ADODB.Connection
Dim AdoRst As New ADODB.Recordset
Dim fldFilecon As ADODB.Field
Dim fldFileTp As ADODB.Field
Dim mfiletype As String
Dim StrF As String
Dim tmp As Integer
On Error GoTo DbConErr:

StrF = txtDir.Text
ConnectionString = "Provider=OraOleDB.Oracle.1;User ID=" & "'" & g_wfmUser & "'" & ";Password=" & "'" & g_wfmPassWord & "'" & ";Data Source=" & "'" & g_wfmDataBase & "'" & ";Persist Security Info=False"
scmd = "select * from doc_dzwdb where dabh='" & txtDocno.Text & "' and fileno='" & txtNo.Text & "'"
If IsNull(g_wfmConn.ConnectionString) Then

MsgBox "数据连接字符串为空,不能连接数据库!", vbInformation, "提示"
Exit Sub
'Else
' AdoCnn.ConnectionString = g_wfmConn.ConnectionString
End If


If scmd = "" Then
MsgBox "SQL语句为空,不能连接数据表,文档无法入库!", vbInformation, "提示"
Exit Sub
End If

AdoCnn.Open (ConnectionString)
AdoCnn.BeginTrans
AdoRst.Open scmd, AdoCnn, adOpenDynamic, adLockOptimistic

If AdoRst.EOF Then
MsgBox "没有发现这条记录", vbInformation, "提示"
AdoRst.Close
AdoCnn.Close
Set AdoRst = Nothing
Set AdoCnn = Nothing
Exit Sub
End If
Set fldFilecon = AdoRst!wdnr
Call FileToBlob(fldFilecon, StrF)

AdoRst.Fields("filetype") = Filetype
AdoRst.Update

AdoRst.Close
AdoCnn.CommitTrans
AdoCnn.Close
Set AdoRst = Nothing
Set AdoCnn = Nothing
MsgBox "文档入库成功!", vbInformation, "提示"
Exit Sub
DbConErr:
MsgBox "文档入库错误!", vbInformation, "错误提示1"
If Not IsNull(AdoRst) Then
If AdoRst.State = adStateOpen Then
AdoRst.Close
Set AdoRst = Nothing
End If
End If
If Not IsNull(AdoCnn) Then
If AdoCnn.State = adStateOpen Then
AdoCnn.Close
Set AdoCnn = Nothing
End If
End If
End Sub
把图片转换成二进制
Public Sub FileToBlob(ByRef fld As ADODB.Field, filename As String, Optional ChunkSize As Long = 8192)
Dim fnum As Integer, bytesleft As Long, bytes As Long
Dim tmp() As Byte
If (fld.Attributes And adFldLong) = 0 Then
Err.Raise 1001, , "field doesn't support the GetChunk method."
End If
If Dir$(filename) = "" Then Err.Raise 53, , "File not found"
fnum = FreeFile
Open filename For Binary As fnum
bytesleft = LOF(fnum)
Do While bytesleft
bytes = bytesleft
If bytes > ChunkSize Then bytes = ChunkSize
ReDim tmp(1 To bytes) As Byte
Get fnum, , tmp
fld.AppendChunk tmp
bytesleft = bytesleft - bytes
Loop
Close #fnum
End Sub
如果有不明白的的方给我发EMAIL:[e-mail]