HOWTO: Retrieve and Update a SQL Server Text Field Using ADOID: Q180368
|
This article demonstrates how to access and update large text fields (Binary Large Objects/BLOBS) using ActiveX Data Objects (ADO). This is accomplished using the GetChunk and AppendChunk methods of an ADODB RecordSet's field object.
Global cn As ADODB.Connection
Global cmd1 As ADODB.Command
Global rsset As ADODB.Recordset
Const BLOCKSIZE As Long = 4096
Public Sub ColumnToFile(Col As ADODB.Field, DiskFile As String)
'Retrieves data from the database and puts it into a temp file on
'the hard drive.
'The size of the chunk is in the variable BLOCKSIZE (4096).
Dim NumBlocks As Long 'Holds the number of chunks.
Dim LeftOver As Long '# of chars left over after last whole chunk.
Dim strData As String
Dim DestFileNum As Long
Dim I As Long
Dim ColSize As Long
'Make sure that you aren't in an empty recordset.
If Not rsset.EOF And Not rsset.BOF Then
ColSize = Col.ActualSize
'If filelength > 0, then it is soiled:
' throw away contents.
If Len(Dir$(DiskFile)) > 0 Then
Kill DiskFile
End If
DestFileNum = FreeFile
Open DiskFile For Binary As DestFileNum
NumBlocks = ColSize \ BLOCKSIZE
LeftOver = ColSize Mod BLOCKSIZE
'Now Write data to the file in chunks.
For I = 1 To NumBlocks
strData = String(BLOCKSIZE, 0)
strData = Col.GetChunk(BLOCKSIZE)
Put DestFileNum, , strData
Next I
strData = String(LeftOver, 0)
strData = Col.GetChunk(LeftOver)
Put DestFileNum, , strData
Close DestFileNum
End If
End Sub
Sub FileToColumn(Col As ADODB.Field, DiskFile As String)
'Takes data from the temp file and saves it to the database.
Dim strData As String
Dim NumBlocks As Long
Dim FileLength As Long
Dim LeftOver As Long
Dim SourceFile As Long
Dim I As Long
SourceFile = FreeFile
Open DiskFile For Binary Access Read As SourceFile
FileLength = LOF(SourceFile)
If FileLength = 0 Then
Close SourceFile
MsgBox DiskFile & " Empty or Not Found."
Else
NumBlocks = FileLength \ BLOCKSIZE
LeftOver = FileLength Mod BLOCKSIZE
Col.AppendChunk Null
strData = String(BLOCKSIZE, 0)
For I = 1 To NumBlocks
Get SourceFile, , strData
Col.AppendChunk strData
Next I
strData = String(LeftOver, 0)
Get SourceFile, , strData
Col.AppendChunk strData
rsset.Update
Close SourceFile
End If
End Sub
Public Sub FileToForm(DiskFile As String, SomeControl As Control)
'Retrieves data from the temp file and puts it onto the control.
Dim SourceFile As Long
Dim FileLength As Long
Dim strData As String
SourceFile = FreeFile
Open DiskFile For Binary Access Read As SourceFile
FileLength = LOF(SourceFile)
If FileLength = 0 Then
Close SourceFile
MsgBox DiskFile & " Empty or Not Found."
Else
strData = String(FileLength, 0)
Get SourceFile, , strData
SomeControl.Text = strData
Close SourceFile
End If
End Sub
Sub FormToFile(DiskFile As String, SomeControl As Control)
'Saves data from the form into a temp file on the local hard drive.
Dim DestinationFile As Long
Dim FileLength As Long
Dim strData As String
If Len(Dir$(DiskFile)) > 0 Then
Kill DiskFile
End If
DestinationFile = FreeFile
Open DiskFile For Binary As DestinationFile
strData = SomeControl.Text
Put DestinationFile, , strData
Close DestinationFile
End Sub
Option Explicit
Dim DiskFile As String
Private Sub cmdNext_Click()
If (rsset.RecordCount > 0) And (Not rsset.EOF) Then
rsset.MoveNext
If Not rsset.EOF Then
rtbText.Text = ""
ColumnToFile rsset.Fields("pr_info"), DiskFile
FileToForm DiskFile, rtbText
Else
rsset.MoveLast
End If
End If
End Sub
Private Sub cmdPrev_Click()
If (rsset.RecordCount > 0) And (Not rsset.BOF) Then
rsset.MovePrevious
If Not rsset.BOF Then
rtbText.Text = ""
ColumnToFile rsset.Fields("pr_info"), DiskFile
FileToForm DiskFile, rtbText
Else
rsset.MoveFirst
End If
End If
End Sub
Private Sub cmdSave_Click()
FormToFile DiskFile, rtbText
FileToColumn rsset.Fields("pr_info"), DiskFile
End Sub
Private Sub Form_Activate()
rtbText.Text = ""
If rsset.RecordCount > 0 Then
rsset.MoveFirst
ColumnToFile rsset.Fields("pr_info"), DiskFile
FileToForm DiskFile, rtbText
End If
End Sub
Private Sub Form_Load()
Dim ConnectString As String
Dim anerror As ADODB.Error
Dim Sql As String
On Error GoTo handler
DiskFile = App.Path & "\BLOB.txt"
'Set the connect string to use pubs on your SQL server.
ConnectString = _
"Driver={SQL SERVER};Server=<yourserver>;Database=pubs;UID=sa;pwd=;"
Sql = "SELECT pr_info FROM pub_info;"
Set cn = New ADODB.Connection
cn.ConnectionString = ConnectString
cn.Open
Set rsset = New ADODB.Recordset
rsset.Open Sql, cn, adOpenKeyset, adLockOptimistic, adCmdText
Exit Sub
handler:
For Each anerror In cn.Errors
Debug.Print anerror.Number & ": " & anerror.Description & _
" - " & anerror.SQLState
Next anerror
End Sub
Additional query words: chunk BLOB
Keywords : kbADO kbADO200 kbDatabase kbVBp500 kbVBp600 kbMDAC200
Version : WINDOWS:5.0,6.0
Platform : WINDOWS
Issue type : kbhowto
Last Reviewed: May 3, 1999