请各位大侠辛苦给看看这段代码哪有问题?
功能是往SQL数据库image字段存入文件但这段代码在存较少的文件时可以正常运行,但存入大文件是update时就会出“多步操作产生错误,请检查每一步的状态!”
Public Function UpFile1(ByVal vDataField As ADODB.Field, ByVal vFileName As String)
Dim fnum As Long, bytesLeft As Long, bytes As Long
Dim lSumSize As Long, lNowSize As Long
Dim tmp() As Byte
On Error GoTo ErrHandleFileToDatabase
fnum = FreeFile
Open vFileName For Binary As fnum
bytesLeft = LOF(fnum)
lSumSize = CLng(bytesLeft / 8192)
vDataField.Value = Null
Do While bytesLeft
bytes = bytesLeft
If bytes > 8192 Then bytes = 8192
ReDim tmp(1 To bytes) As Byte
Get #fnum, , tmp
vDataField.AppendChunk tmp
bytesLeft = bytesLeft - bytes
lNowSize = lNowSize + 1
DoEvents
Loop
Close #fnum
Exit Function
ErrHandleFileToDatabase:
Err.Clear
End Function
我感觉好像是文件较少是仅执行一次AppendChunk正常,循环执行多次就无法update。
我是新手,请大家帮帮吧!!!!跪求了。 --------------------编程问答-------------------- 给一个函数,需要引用ADO2.5以上的版本
--------------------编程问答-------------------- 使用流对象保存和显示图片
'根据传入的记录号,将文件写入F_File表中
'以SQL Server为例,
'表名为:F_File,这里包含
'Recid列 int型,应该是其它表的一个外键
'sFile image型
'ExtensionName 文件的扩展名,Varchar(8)
Public Sub SaveFileToDB(ByVal FilePath As String, ByVal Recid As _
Long)
On Error GoTo SaveFileToDB_Err
Dim Stream As New ADODB.Stream
Dim Reco As New ADODB.Recordset
Dim Fso As New FileSystemObject
Dim FileType As String
100 If Fso.FileExists(FilePath) Then
102 FileType = Fso.GetExtensionName(FilePath)
104 Reco.Open "Select * from F_File where Recid=" & _
Recid & "", Cn, adOpenKeyset, adLockOptimistic
106 If Reco.EOF Then
108 Reco.AddNew
End If
110 Stream.Type = adTypeBinary
112 Stream.Open
114 Stream.LoadFromFile FilePath
Reco!Recid = Recid
116 Reco!sFile = Stream.Read
118 Reco!ExtensionName = FileType
120 Reco.Update
122 Reco.Close
124 Stream.Close
126 Set Reco = Nothing
128 Set Stream = Nothing
End If
Set Fso=Nothing
Exit Sub
SaveFileToDB_Err:
MsgBox Err.Description & vbCrLf & _
"位于 SaveFileToDB" & _
"所在行数 " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
'Resume Next
End Sub
打开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 Sub
--------------------编程问答-------------------- 楼上的大哥,流方式我试过,但由于客户机器的限制,读写大文件时,总会出现"溢出"的错误。
所以我才采用分段AppendChunk的方式,但实在不理解到底哪出错了? --------------------编程问答--------------------
--------------------编程问答-------------------- 楼上大哥:
'给你一段MSDN上的代码参考一下:
'AppendChunk 和 GetChunk 方法范例
'该范例使用 AppendChunk 和 GetChunk 方法用其他记录中的数据填写图像字段。
Public Sub AppendChunkX()
Dim cnn1 As ADODB.Connection
Dim rstPubInfo As ADODB.Recordset
Dim strCnn As String
Dim strPubID As String
Dim strPRInfo As String
Dim lngOffset As Long
Dim lngLogoSize As Long
Dim varLogo As Variant
Dim varChunk As Variant
Const conChunkSize = 100
' 打开连接
Set cnn1 = New ADODB.Connection
strCnn = "Provider=sqloledb;" & _
"Data Source=srv;Initial Catalog=pubs;User Id=sa;Password=; "
cnn1.Open strCnn
' 打开 pub_info 表。
Set rstPubInfo = New ADODB.Recordset
rstPubInfo.CursorType = adOpenKeyset
rstPubInfo.LockType = adLockOptimistic
rstPubInfo.Open "pub_info", cnn1, , , adCmdTable
' 提示复制徽标。
strMsg = "Available logos are : " & vbCr & vbCr
Do While Not rstPubInfo.EOF
strMsg = strMsg & rstPubInfo!pub_id & vbCr & _
Left(rstPubInfo!pr_info, InStr(rstPubInfo!pr_info, ",") - 1) & _
vbCr & vbCr
rstPubInfo.MoveNext
Loop
strMsg = strMsg & "Enter the ID of a logo to copy:"
strPubID = InputBox(strMsg)
' 将徽标复制到大块中的变量。
rstPubInfo.Filter = "pub_id = '" & strPubID & "'"
lngLogoSize = rstPubInfo!logo.ActualSize
Do While lngOffset < lngLogoSize
varChunk = rstPubInfo!logo.GetChunk(conChunkSize)
varLogo = varLogo & varChunk
lngOffset = lngOffset + conChunkSize
Loop
' 从用户得到数据。
strPubID = Trim(InputBox("Enter a new pub ID:"))
strPRInfo = Trim(InputBox("Enter descriptive text:"))
' 添加新记录,将徽标复制到大块中。
rstPubInfo.AddNew
rstPubInfo!pub_id = strPubID
rstPubInfo!pr_info = strPRInfo
lngOffset = 0 ' 重置位移。
Do While lngOffset < lngLogoSize
varChunk = LeftB(RightB(varLogo, lngLogoSize - lngOffset), _
conChunkSize)
rstPubInfo!logo.AppendChunk varChunk
lngOffset = lngOffset + conChunkSize
Loop
rstPubInfo.Update
' 显示新添加的数据。
MsgBox "New record: " & rstPubInfo!pub_id & vbCr & _
"Description: " & rstPubInfo!pr_info & vbCr & _
"Logo size: " & rstPubInfo!logo.ActualSize
' 删除新记录,因为这只是演示。
rstPubInfo.Requery
cnn1.Execute "DELETE FROM pub_info " & _
"WHERE pub_id = '" & strPubID & "'"
rstPubInfo.Close
cnn1.Close
上述方法是先把文件读入一个Variant变量中,理论与把大文件全部读入一个数组中是一样的,这对小文件是可行的,但对于超大文件,理论上由于机器资源限制一样会造成“溢出”,这是其一;第二,例子中是从字段中读到Variant变量中,但对于机器上的文件怎么能读入Variant变量中呢?因为GET不支持Variant变量!
另帮助中说用AppendChunk时,Field 对象的 Attributes 属性中的 adFldLong 位设置为 True,如何进行设置adFldLong值呢?
帮帮小弟吧! --------------------编程问答-------------------- --------------------编程问答-------------------- Public Function UpFile1(ByVal vDataField As ADODB.Field, ByVal vFileName As String
--------------------编程问答-------------------- Public Function UpFile1(ByVal vDataField As ADODB.Field, ByVal vFileName As String错了
补充:VB , 基础类