Как получать и обновлять текстовые поля в SQL Server при помощи ADO

В этой статье описывается механизм получения и изменения больших текстовых полей (Binary Large Objects/BLOBS) с использованием ActiveX Data Objects (ADO). Делается это с участием методов GetChunk и AppendChunk в поле RecordSet объекта ADODB.

Пошаговое создание приложения

1. Открываем новый проект. Form1 создаётся автоматически.
   
   
2. В меню Project кликните References, и выберите Microsoft ActiveX Data Objects Library.
   
   
3. Добавьте новый стандартный модуль в Ваш проект, и поместите в него следующий код:
   
   

      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)
       'Получаем данные из базы данных и помещаем их во временный файл
       'на жёстком диске.
       'Размер блока определён в переменной BLOCKSIZE (4096).
   
      Dim NumBlocks As Long  'Количество блоков.
      Dim LeftOver As Long   '# символов оставшихся после последнего целого блока.
      Dim strData As String
      Dim DestFileNum As Long
      Dim I As Long
      Dim ColSize As Long
   
      'Убеждаемся, что мы не в пустой записи (recordset).
       If Not rsset.EOF And Not rsset.BOF Then
       ColSize = Col.ActualSize
   
      'Если filelength > 0, то файл существует.
      ' Очищаем его содержимое.
       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
   
       'Теперь записываем данные в файл блоками.
        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)
        'Берём данные из временного файла и записываем их в базу данных.
   
          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)
          'Получаем данные из временного файла и помещаем их в контрол.
   
          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)
          'Сохраняем данные из формы во временный файл на диске.
   
          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 S
   ub
   

4. Подготовим форму Form1:
   
   
   1. Добавьте элемент управления RichTextBox, и установите его свойство Name в "rtbText."
      
      
   2. Добавьте элемент управления CommandButton, и установите его свойство Name в "cmdPrev", а свойство Caption в "Prev."
      
      
   3. Добавьте элемент управления CommandButton, и установите его свойство Name в "cmdNext", а свойство Caption в "Next."
      
      
   4. Добавьте элемент управления CommandButton, и установите его свойство Name в "cmdSave", а свойство Caption в "Update."
      
      
5. Вставьте следующий код в форму:
   
   

      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"
   
          'Устанавите строку коннекта на Ваш 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 S
   ub
   

6. Измените ServerName в connectstring на имя Вашего сервера.
   
   
7. Запустите проект. RichTextBox будет содержать первую запись из базы данных.
   
   
8. Кликните Next . В RichTextBox появится следующая запись. Кнопка Next вызывает метод MoveNext, а затем методы ColumnToFile и FileToForm.
   
   
9. Кликните Prev . В RichTextBox появится предыдущая запись. Кнопка Prev вызывает метод MovePrevious, а затем методы ColumnToFile и FileToForm.
   
   
10. Наберите какой-нибудь текст в текстовом поле и нажмите Update - содержимое текстового поля запишется в текущую запись. Кнопка Update вызывает методы FormToFile и FileToColumn, который в свою очередь вызывают метод Update.