给你个参考代码自己改改:AppendChunk、GetChunk 方法示例 下面示例说明使用 AppendChunk 和 GetChunk 方法将基于数据页的、大的二进制对象 (BLOB) 数据写入远程数据源。这段代码需要一个名为 Chunks 的表,表中带有字符、文本、以及图象域。为了建立该表,提出如下代码作为对测试数据库的查询操作:CREATE TABLE Chunks (ID integer identity NOT NULL, PName char(10) NULL, Description TEXT NULL, Photo IMAGE NULL) CREATE UNIQUE INDEX ChunkIDIndex on Chunks(ID)一旦建立了该表,就需要一个或多个 .BMP 或其它合适的、可由 PictureBox 控件定位装入的图形图象。 Option Explicit Dim en As rdoEnvironment Dim Qd As rdoQuery Dim Cn As rdoConnection Dim Rs As rdoResultset Dim SQL As String Dim DataFile As Integer, Fl As Long, Chunks As Integer Dim Fragment As Integer, Chunk() As Byte, I As Integer Const ChunkSize As Integer = 16384Private Sub Form_Load() Set en = rdoEnvironments(0) Set Cn = en.OpenConnection(dsname:="", _ Connect:="UID=;PWD=;DATABASE=WorkDB;" _ & ""Driver={SQL Server};SERVER=Betav486", _ prompt:=rdDriverNoPrompt) Set Qd = Cn.CreateQuery("TestChunk", "Select * from Chunks Where PName = ?") End Sub Private Sub LoadFromFile_Click() ' ' 将文件定位并为该文件设置文件名。 ' With CommonDialog1 .Filter = "Pictures(*.bmp;*.ico)|*.bmp;*.ico" .ShowOpen FileName = .FileName End With End SubPrivate Sub ReadFromDB_Click() If Len(NameWanted) = 0 Then _ NameWanted = InputBox("Enter name wanted", "Animal") Qd(0) = NameWanted Set Rs = Qd.OpenResultset(rdOpenKeyset, rdConcurRowver) If Rs Is Nothing Or Rs.Updatable = False Then MsgBox "Can't open or write to result set" Exit Sub End If If Rs.EOF Then MsgBox "Can't find picture by that name" Exit Sub End If Description = Rs!Description DataFile = 1 Open "pictemp" For Binary Access Write As DataFile Fl = Rs!Photo.ColumnSize Chunks = Fl \ ChunkSize Fragment = Fl Mod ChunkSize ReDim Chunk(Fragment) Chunk() = Rs!Photo.GetChunk(Fragment) Put DataFile, , Chunk() For I = 1 To Chunks ReDim Buffer(ChunkSize) Chunk() = Rs!Photo.GetChunk(ChunkSize) Put DataFile, , Chunk() Next I Close DataFile FileName = "pictemp" End SubPrivate Sub SaveToDB_Click() If Len(NameWanted) = 0 Then _ NameWanted = InputBox("Enter name for this" _ & " picture", "Animal") Qd(0) = NameWanted Set Rs = Qd.OpenResultset(rdOpenKeyset, _ rdConcurRowver) If Rs Is Nothing Or Rs.Updatable = False Then MsgBox "Can't open or write to result set" Exit Sub End If If Rs.EOF Then Rs.AddNew Rs!PName = NameWanted If Description = "" Then _ Description = InputBox("Describe the picture", _ "Don't care") 'Rs!Description = Description Else Rs.Edit End If DataFile = 1 Open FileName For Binary Access Read As DataFile Fl = LOF(DataFile) ' 文件中数据的长度 If Fl = 0 Then Close DataFile: Exit Sub Chunks = Fl \ ChunkSize Fragment = Fl Mod ChunkSize Rs!Photo.AppendChunk Null ReDim Chunk(Fragment) Get DataFile, , Chunk() Rs!Photo.AppendChunk Chunk() ReDim Chunk(ChunkSize) For I = 1 To Chunks Get DataFile, , Chunk() Rs!Photo.AppendChunk Chunk() Next I Close DataFile Rs.Update End SubPrivate Sub FileName_Change() Picture1.Picture = LoadPicture(FileName) End Sub
下面示例说明使用 AppendChunk 和 GetChunk 方法将基于数据页的、大的二进制对象 (BLOB) 数据写入远程数据源。这段代码需要一个名为 Chunks 的表,表中带有字符、文本、以及图象域。为了建立该表,提出如下代码作为对测试数据库的查询操作:CREATE TABLE Chunks (ID integer identity NOT NULL, PName char(10) NULL,
Description TEXT NULL,
Photo IMAGE NULL)
CREATE UNIQUE INDEX ChunkIDIndex on Chunks(ID)一旦建立了该表,就需要一个或多个 .BMP 或其它合适的、可由 PictureBox 控件定位装入的图形图象。
Option Explicit
Dim en As rdoEnvironment
Dim Qd As rdoQuery
Dim Cn As rdoConnection
Dim Rs As rdoResultset
Dim SQL As String
Dim DataFile As Integer, Fl As Long, Chunks As Integer
Dim Fragment As Integer, Chunk() As Byte, I As Integer
Const ChunkSize As Integer = 16384Private Sub Form_Load()
Set en = rdoEnvironments(0)
Set Cn = en.OpenConnection(dsname:="", _
Connect:="UID=;PWD=;DATABASE=WorkDB;" _
& ""Driver={SQL Server};SERVER=Betav486", _
prompt:=rdDriverNoPrompt)
Set Qd = Cn.CreateQuery("TestChunk", "Select * from
Chunks Where PName = ?")
End Sub
Private Sub LoadFromFile_Click()
'
' 将文件定位并为该文件设置文件名。
'
With CommonDialog1
.Filter = "Pictures(*.bmp;*.ico)|*.bmp;*.ico"
.ShowOpen
FileName = .FileName
End With
End SubPrivate Sub ReadFromDB_Click()
If Len(NameWanted) = 0 Then _
NameWanted = InputBox("Enter name wanted", "Animal")
Qd(0) = NameWanted
Set Rs = Qd.OpenResultset(rdOpenKeyset,
rdConcurRowver)
If Rs Is Nothing Or Rs.Updatable = False Then
MsgBox "Can't open or write to result set"
Exit Sub
End If
If Rs.EOF Then
MsgBox "Can't find picture by that name"
Exit Sub
End If
Description = Rs!Description
DataFile = 1
Open "pictemp" For Binary Access Write As DataFile
Fl = Rs!Photo.ColumnSize
Chunks = Fl \ ChunkSize
Fragment = Fl Mod ChunkSize
ReDim Chunk(Fragment)
Chunk() = Rs!Photo.GetChunk(Fragment)
Put DataFile, , Chunk()
For I = 1 To Chunks
ReDim Buffer(ChunkSize)
Chunk() = Rs!Photo.GetChunk(ChunkSize)
Put DataFile, , Chunk()
Next I
Close DataFile
FileName = "pictemp"
End SubPrivate Sub SaveToDB_Click()
If Len(NameWanted) = 0 Then _
NameWanted = InputBox("Enter name for this" _
& " picture", "Animal")
Qd(0) = NameWanted
Set Rs = Qd.OpenResultset(rdOpenKeyset, _
rdConcurRowver)
If Rs Is Nothing Or Rs.Updatable = False Then
MsgBox "Can't open or write to result set"
Exit Sub
End If
If Rs.EOF Then
Rs.AddNew
Rs!PName = NameWanted
If Description = "" Then _
Description = InputBox("Describe the picture", _
"Don't care")
'Rs!Description = Description
Else
Rs.Edit
End If
DataFile = 1
Open FileName For Binary Access Read As DataFile
Fl = LOF(DataFile) ' 文件中数据的长度
If Fl = 0 Then Close DataFile: Exit Sub
Chunks = Fl \ ChunkSize
Fragment = Fl Mod ChunkSize
Rs!Photo.AppendChunk Null
ReDim Chunk(Fragment)
Get DataFile, , Chunk()
Rs!Photo.AppendChunk Chunk()
ReDim Chunk(ChunkSize)
For I = 1 To Chunks
Get DataFile, , Chunk()
Rs!Photo.AppendChunk Chunk()
Next I
Close DataFile
Rs.Update
End SubPrivate Sub FileName_Change()
Picture1.Picture = LoadPicture(FileName)
End Sub