Simpan Image dalam Database SQL Server

Bagi anda yang memerlukan cara penyimpanan image dalam bentuk BLOB kemudian disimpan dalam SQL Server. Berikut ini cara penyimpanannya .
Pada contoh dibawah ini imgPhoto(1).Tag menunjukkan Lokasi dan nama file

Private Sub cmdSave_Click()
    Dim rc      As New ADODB.Recordset
    Dim strSQL  As String

    strSQL = "SELECT * FROM Person "
    strSQL = strSQL & "WHERE PersonID = '" & mPersonID & "' "
    rc.Open strSQL, gdbData, 3, 3

    '/* Khusus untuk field gambar, kita isi berdasarkan _
        gambar yang kita muat dengan fungsi konversiGambar

    If imgPhoto(1).Tag  "" Then
Call FileToBlob(imgPhoto(1).Tag, rc!Photo, rc.Fields("Photo").ActualSize)
    End If

    '/* Simpan data
    rc.Update
    rc.Close
End Sub

Tambahkan 1 (satu) buah module dengan nama modBLOB

Option Explicit

Const BLOCK_SIZE = 16384

Public 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  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