Для записи изображения в базу данных из файла, используется функция 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
|
Источник: hiprog.com |