Хранение изображений в базе данных

Для записи изображения в базу данных из файла, используется функция ReadBLOB. А для считывания изображения из базы данных в файл используется аналогичная функция WriteBLOB.

Функция ReadBlob возвращает количество байт, записанных в базе данных. Source - файл рисунка который, будет записан в базе, T - таблица, или запрос в поле которого будет добавлен файл рисунка, sField - имя Поля, таблицы (Т), для записи данных (в поле с этим именем будет cделана запись). Кратко о работе функции: берётся файл, разбивается на блоки максимального размера (BlockSize = 32768), затем данные блоками считываются из файла и вставляются в OLE поле базы данных. Функция WriteBLOB работает также, но сначала данные блоками размера BlockSize, считываются из базы текущей записи и сохраняются в файле. Перейдём к коду:

Option Explicit  Private Const BlockSize = 32768  Function ReadBLOB(Source As String, T As Recordset, sField As String) Dim NumBlocks As Integer 'счётчик количества блоков Dim SourceFile As Integer Dim i As Integer Dim FileLength As Long Dim LeftOver As Long Dim byteData() As Byte  On Error GoTo Err_ReadBLOB 'если ошибка, то надо перейти на обработчик ошибок  SourceFile = FreeFile Open Source For Binary Access Read As SourceFile 'открытие файла  'получение длинны файла FileLength = LOF(SourceFile) If FileLength = 0 Then ReadBLOB = 0 Exit Function End If  'вычисление кол-во блоков, которые будут записаны в базу NumBlocks = FileLength \ BlockSize LeftOver = FileLength Mod BlockSize 'вычисляем остаток  If LeftOver > 0 Then 'если есть остаток, то запись из файла в базу 'данных с размером остатка  ReDim byteData(0 To LeftOver - 1) 'изменение массива для считывания данных Get SourceFile, , byteData 'считывание данных из файла 'T.Edit T(sField).AppendChunk (byteData) 'запись в базу 'T.Update End If  'записываем данные блоками, размером BlockSize ReDim byteData(0 To BlockSize - 1) For i = 1 To NumBlocks 'считывание и запись в базу Get SourceFile, , byteData 'считывание данных из файла T(sField).AppendChunk (byteData) 'запись в базовое поле Next i  Close SourceFile ReadBLOB = FileLength 'возвращение функцией размер записанных данных Exit Function  Err_ReadBLOB: ReadBLOB = -Err 'возвращение номера ошибки MsgBox Err.Description, , Err.Number 'если нужно - сообщение об ошибке Exit Function  End Function  Function WriteBLOB(T As Recordset, sField As String, Destination As String) Dim NumBlocks As Integer, DestFile As Integer, i As Integer Dim FileLength As Long, LeftOver As Long Dim byteData() As Byte      On Error GoTo Err_WriteBLOB      'размер записанных данных FileLength = T(sField).FieldSize() If FileLength = 0 Then WriteBLOB = 0 Exit Function End If  'вычисление количества блоков для записи NumBlocks = FileLength \ BlockSize LeftOver = FileLength Mod BlockSize      'очистка содержимого файла DestFile = FreeFile Open Destination For Output As DestFile Close DestFile  'открытие файла Open Destination For Binary As DestFile      'если есть остаток, то запись в файл данных из базы с размером остатка If LeftOver > 0 Then byteData() = T(sField).GetChunk(0, LeftOver) Put DestFile, , byteData End If  'запись в файл всех данных, которые остались блоками размером ' по BlockSize каждый For i = 1 To NumBlocks byteData() = T(sField).GetChunk((i - 1) * BlockSize + LeftOver, BlockSize) Put DestFile, , byteData Next i Close DestFile WriteBLOB = FileLength Exit Function  Err_WriteBLOB: WriteBLOB = -Err MsgBox Err.Description, vbCritical, Err.Number Exit Function  End Function