VBA代码：Private Sub Test(ByVal FileName As String, ByVal id As Long) Dim cmm As ADODB.Command Dim cnn As New ADODB.Connection Dim par As New ADODB.Parameter Dim image() As Byte Const BLOBSIZE = 4096
Dim strConn As String Dim FileNo As Integer Dim lngPosition As Long Dim LenF As Long Dim NoGr As Long Dim i As Long
lngPosition = 0 FileNo = FreeFile
Open FileName For Binary As FileNo LenF = LOF(FileNo)
Debug.Print LenF
NoGr = LenF \ BLOBSIZE
strConn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist SecurityInfo=False;Initial Catalog=test;Data Source=(local)" cnn.Open strConn
For i = 1 To NoGr Set cmm = New ADODB.Command With cmm Set .ActiveConnection = cnn .CommandType = adCmdStoredProc .CommandText = "addImage"
lngPosition = (i - 1) * BLOBSIZE + 1 ReDim image(BLOBSIZE)
Get FileNo, lngPosition, image
Set par = .CreateParameter("bin", adVarBinary, adParamInput,BLOBSIZE + 1)
par.Attributes = adParamLong par.AppendChunk image() .Parameters.Append par Set par = .CreateParameter("ID", adInteger, adParamInput) par.Value = id .Parameters.Append par .Execute
End With Set cmm = Nothing Next
Dim lngLast As Long lngLast = LenF Mod BLOBSIZE
If lngLast > 0 Then Set cmm = New ADODB.Command With cmm .CommandType = adCmdStoredProc .CommandText = "addImage" Set .ActiveConnection = cnn ' 6 = 5 + 1 lngPosition = (i - 1) * BLOBSIZE + 1 ReDim image(lngLast)
Get FileNo, lngPosition, image
Set par = .CreateParameter("bin", adVarBinary, adParamInput,lngLast + 1)
par.Attributes = adParamLong par.AppendChunk image() .Parameters.Append par Set par = .CreateParameter("ID", adInteger, adParamInput) par.Value = id .Parameters.Append par .Execute
End With Set cmm = Nothing End If Close FileNo
cnn.Close Set cnn = NothingEnd Sub
朱亦文2004.04.19