Article ID: 194975
Article Last Modified on 3/14/2005
If fld.Attributes And adFldLong Then ' You can use GetChunk/AppendChunkLong columns are commonly referred to as BLOBs (Binary Large OBjects) even though they may contain text data. The sample code below provides two routines, BlobToFile and FileToBlob.
BlobToFile Calls one of the below routines to use GetChunk
WriteFromBinary Writes a LongVarBinary of known size to disk
WriteFromUnsizedBinary Writes a LongVarBinary on unknown size
WriteFromText Writes a LongVarChar of known size
WriteFromUnsizedText Writes a LongVarChar of unknown size
FileToBlob Calls one of the below routines to use AppendChunk
ReadToBinary Reads a file into a LongVarBinary column
ReadToText Reads a file into a LongVarChar column
Data = fld.GetChunk(BLOCK_SIZE) :
Run-time error '94':
Invalid use of Null
ADO 2.1 and later might report the ActualSize property of a Text type BLOB field
as twice the number of characters. This is correct if the BLOB field contains Unicode
text, because Unicode uses 2 bytes per character. This is incorrect if the BLOB field
contains ANSI text, which uses 1-byte per character. If the ActualSize is twice the
length of an ANSI field, then GetChunk eventually attempts to get past
the end of the field.
Option Explicit
Private Sub CmdSave_Click()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, SQL As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.CursorLocation = adUseServer
cn.Open "dsn=nwind_jet" ' *** change this ***
SQL = "SELECT * FROM Employees WHERE LastName='Fuller'"
rs.Open SQL, cn, adOpenStatic, adLockReadOnly
'
' Save using GetChunk and known size.
' FieldSize (ActualSize) > Threshold arg (16384)
'
BlobToFile rs!Photo, "c:\photo1.dat", rs!Photo.ActualSize, 16384
BlobToFile rs!Notes, "c:\notes1.txt", rs!Notes.ActualSize, 16384
' Uncomment the next line of code, and comment the line above,
' to workaround Runtime error '94': Invalid use of Null
' BlobToFile rs!Notes, "c:\notes1.txt", rs!Notes.ActualSize \ 2, 16384
'
' Save using GetChunk and unknown size.
' FieldSize not specified.
'
BlobToFile rs!Photo, "c:\photo2.dat"
BlobToFile rs!Notes, "c:\notes2.txt"
'
' Save without using GetChunk
' FieldSize (ActualSize) < Threshold arg (defaults to 1Mb)
'
BlobToFile rs!Photo, "c:\photo3.dat", rs!Photo.ActualSize
BlobToFile rs!Notes, "c:\notes3.txt", rs!Notes.ActualSize
' Uncomment the next line of code, and comment the line above,
' to workaround Runtime error '94': Invalid use of Null
' BlobToFile rs!Notes, "c:\notes3.txt", rs!Notes.ActualSize \ 2
rs.Close
cn.Close
End Sub
Private Sub CmdLoad_Click()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, SQL As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.CursorLocation = adUseServer
cn.Open "dsn=ole_db_nwind_jet"
SQL = "SELECT * FROM Employees"
rs.Open SQL, cn, adOpenKeyset, adLockOptimistic
'
' Load using AppendChunk
'
rs.AddNew
rs!FirstName = "Test"
rs!LastName = "Fuller11"
FileToBlob "c:\photo1.dat", rs!Photo, 16384
FileToBlob "c:\notes1.txt", rs!Notes, 16384
rs.Update
rs.AddNew
rs!FirstName = "Test"
rs!LastName = "Fuller21"
FileToBlob "c:\photo2.dat", rs!Photo, 16384
FileToBlob "c:\notes2.txt", rs!Notes, 16384
rs.Update
rs.AddNew
rs!FirstName = "Test"
rs!LastName = "Fuller31"
FileToBlob "c:\photo3.dat", rs!Photo, 16384
FileToBlob "c:\notes3.txt", rs!Notes, 16384
rs.Update
'
' Load without using AppendChunk
'
rs.AddNew
rs!FirstName = "Test"
rs!LastName = "Fuller12"
FileToBlob "c:\photo1.dat", rs!Photo
FileToBlob "c:\notes1.txt", rs!Notes
rs.Update
rs.AddNew
rs!FirstName = "Test"
rs!LastName = "Fuller22"
FileToBlob "c:\photo2.dat", rs!Photo
FileToBlob "c:\notes2.txt", rs!Notes
rs.Update
rs.AddNew
rs!FirstName = "Test"
rs!LastName = "Fuller32"
FileToBlob "c:\photo3.dat", rs!Photo
FileToBlob "c:\notes3.txt", rs!Notes
rs.Update
rs.Close
cn.Close
End Sub
Option Explicit
Const BLOCK_SIZE = 16384
Sub BlobToFile(fld As ADODB.Field, ByVal FName As String, _
Optional FieldSize As Long = -1, _
Optional Threshold As Long = 1048576)
'
' Assumes file does not exist
' Data cannot exceed approx. 2Gb in size
'
Dim F As Long, bData() As Byte, sData As String
F = FreeFile
Open FName For Binary As #F
Select Case fld.Type
Case adLongVarBinary
If FieldSize = -1 Then ' blob field is of unknown size
WriteFromUnsizedBinary F, fld
Else ' blob field is of known size
If FieldSize > Threshold Then ' very large actual data
WriteFromBinary F, fld, FieldSize
Else ' smallish actual data
bData = fld.Value
Put #F, , bData ' PUT tacks on overhead if use fld.Value
End If
End If
Case adLongVarChar, adLongVarWChar
If FieldSize = -1 Then
WriteFromUnsizedText F, fld
Else
If FieldSize > Threshold Then
WriteFromText F, fld, FieldSize
Else
sData = fld.Value
Put #F, , sData ' PUT tacks on overhead if use fld.Value
End If
End If
End Select
Close #F
End Sub
Sub WriteFromBinary(ByVal F As Long, fld As ADODB.Field, _
ByVal FieldSize As Long)
Dim Data() As Byte, BytesRead As Long
Do While FieldSize <> BytesRead
If FieldSize - BytesRead < BLOCK_SIZE Then
Data = fld.GetChunk(FieldSize - BLOCK_SIZE)
BytesRead = FieldSize
Else
Data = fld.GetChunk(BLOCK_SIZE)
BytesRead = BytesRead + BLOCK_SIZE
End If
Put #F, , Data
Loop
End Sub
Sub WriteFromUnsizedBinary(ByVal F As Long, fld As ADODB.Field)
Dim Data() As Byte, Temp As Variant
Do
Temp = fld.GetChunk(BLOCK_SIZE)
If IsNull(Temp) Then Exit Do
Data = Temp
Put #F, , Data
Loop While LenB(Temp) = BLOCK_SIZE
End Sub
Sub WriteFromText(ByVal F As Long, fld As ADODB.Field, _
ByVal FieldSize As Long)
Dim Data As String, CharsRead As Long
Do While FieldSize <> CharsRead
If FieldSize - CharsRead < BLOCK_SIZE Then
Data = fld.GetChunk(FieldSize - BLOCK_SIZE)
CharsRead = FieldSize
Else
Data = fld.GetChunk(BLOCK_SIZE)
CharsRead = CharsRead + BLOCK_SIZE
End If
Put #F, , Data
Loop
End Sub
Sub WriteFromUnsizedText(ByVal F As Long, fld As ADODB.Field)
Dim Data As String, Temp As Variant
Do
Temp = fld.GetChunk(BLOCK_SIZE)
If IsNull(Temp) Then Exit Do
Data = Temp
Put #F, , Data
Loop While Len(Temp) = BLOCK_SIZE
End Sub
Sub FileToBlob(ByVal FName As String, fld As ADODB.Field, _
Optional Threshold As Long = 1048576)
'
' Assumes file exists
' Assumes calling routine does the UPDATE
' File cannot exceed approx. 2Gb in size
'
Dim F As Long, Data() As Byte, FileSize As Long
F = FreeFile
Open FName For Binary As #F
FileSize = LOF(F)
Select Case fld.Type
Case adLongVarBinary
If FileSize > Threshold Then
ReadToBinary F, fld, FileSize
Else
Data = InputB(FileSize, F)
fld.Value = Data
End If
Case adLongVarChar, adLongVarWChar
If FileSize > Threshold Then
ReadToText F, fld, FileSize
Else
fld.Value = Input(FileSize, F)
End If
End Select
Close #F
End Sub
Sub ReadToBinary(ByVal F As Long, fld As ADODB.Field, _
ByVal FileSize As Long)
Dim Data() As Byte, BytesRead As Long
Do While FileSize <> BytesRead
If FileSize - BytesRead < BLOCK_SIZE Then
Data = InputB(FileSize - BytesRead, F)
BytesRead = FileSize
Else
Data = InputB(BLOCK_SIZE, F)
BytesRead = BytesRead + BLOCK_SIZE
End If
fld.AppendChunk Data
Loop
End Sub
Sub ReadToText(ByVal F As Long, fld As ADODB.Field, _
ByVal FileSize As Long)
Dim Data As String, CharsRead As Long
Do While FileSize <> CharsRead
If FileSize - CharsRead < BLOCK_SIZE Then
Data = Input(FileSize - CharsRead, F)
CharsRead = FileSize
Else
Data = Input(BLOCK_SIZE, F)
CharsRead = CharsRead + BLOCK_SIZE
End If
fld.AppendChunk Data
Loop
End Sub
153238 How To Use GetChunk and AppendChunk Methods of RDO Object
185958 How To Use ADO GetChunk/AppendChunk with Oracle for BLOB Data
189415 FILE: AdoChunk.exe Using GetChunk and AppendChunk in Visual C++
103257 ACC: Reading, Storing, &Writing Binary Large Objects (BLOBs)
Additional query words: concatenate
Keywords: kbhowto kbbug kbdatabase KB194975