Advertisement
3_2004-2005 Databases/ Data Access/ DAO/ ADO #134813

Store Binary files in a database

Here are two functions that will allow you to read and write a Large Binary Object (BLOB) to and from a database. This could be used to store and retrieve images, documents, etc inside the database it self. This is great for those of use that have a lot of Binary files around that we want to keep in a central place that can be backed up and protected with the same security that a database offers. This code will work with *ANY* database that ADO can connect to.

AI

Shrnutí AI: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Zdrojový kód
original-source
'***************************************************************
' Abstract: Writes a BLOB datafield to a file. If the Data Field is
'  big I would recommend that you set bUseStream = False.
'
' Input: strFullPath: Full path to the destination file
'  objField: Field object that contains the BLOB data.
'  bUseStream: (Optional) True = Use Stream methode, False = Use GetChunk
'  lngChunkSize: (Optional) Specifies the Chunk size to fetch with each GetChunk
'
' Output: True on success, False on failure
'***************************************************************
Public Function BLOBToFile(ByVal strFullPath As String, ByRef objField As ADODB.Field, Optional ByVal bUseStream As Boolean = True, Optional ByVal lngChunkSize As Long = 8192) As Boolean
On Error Resume Next
Dim objStream As ADODB.Stream
Dim intFreeFile As Integer
Dim lngBytesLeft As Long
Dim lngReadBytes As Long
Dim byBuffer() As Byte
 If bUseStream Then
 Set objStream = New ADODB.Stream
 With objStream
 .Type = adTypeBinary
 .Open
 .Write objField.Value
 .SaveToFile strFullPath, adSaveCreateOverWrite
 End With
 DoEvents
 Else
 If Dir(strFullPath) <> "" Then
 Kill strFullPath
 End If
 lngBytesLeft = objField.ActualSize
 intFreeFile = FreeFile
 Open strFullPath For Binary As #intFreeFile
 Do Until lngBytesLeft <= 0
 lngReadBytes = lngBytesLeft
 If lngReadBytes > lngChunkSize Then
 lngReadBytes = lngChunkSize
 End If
 byBuffer = objField.GetChunk(lngReadBytes)
 Put #intFreeFile, , byBuffer
 lngBytesLeft = lngBytesLeft - lngReadBytes
 DoEvents
 Loop
 Close #intFreeFile
 End If
 If Err.Number <> 0 Or Err.LastDllError <> 0 Then
 BLOBToFile = False
 Else
 BLOBToFile = True
 End If
End Function
'***************************************************************
' Abstract: Writes a binary file to a BLOB datafield. If the file
'  is big I would recommend that you set bUseStream = False.
'
' Input: strFullPath: Full path to the source file
'  objField: Field object that will contain the BLOB data.
'  bUseStream: (Optional) True = Use Stream methode, False = Use GetChunk
'  lngChunkSize: (Optional) Specifies the Chunk size to fetch with each GetChunk
'
' Output: True on success, False on failure
'***************************************************************
Public Function FileToBLOB(ByVal strFullPath As String, ByRef objField As ADODB.Field, Optional ByVal bUseStream As Boolean = True, Optional ByVal lngChunkSize As Long = 8192) As Boolean
On Error Resume Next
Dim objStream As ADODB.Stream
Dim intFreeFile As Integer
Dim lngBytesLeft As Long
Dim lngReadBytes As Long
Dim byBuffer() As Byte
Dim varChunk As Variant
 If bUseStream Then
 Set objStream = New ADODB.Stream
 With objStream
 .Type = adTypeBinary
 .Open
 .LoadFromFile strFullPath
 objField.Value = .Read(adReadAll)
 End With
 Else
 With objField
 '<<--If the field does not support Long Binary data'-->>
 '<<--then we cannot load the data into the field.-->>
 If (.Attributes And adFldLong) <> 0 Then
 intFreeFile = FreeFile
 Open strFullPath For Binary Access Read As #intFreeFile
 lngBytesLeft = LOF(intFreeFile)
 Do Until lngBytesLeft <= 0
  If lngBytesLeft > lngChunkSize Then
  lngReadBytes = lngChunkSize
  Else
  lngReadBytes = lngBytesLeft
  End If
  ReDim byBuffer(lngReadBytes)
  Get #intFreeFile, , byBuffer()
  objField.AppendChunk byBuffer()
  lngBytesLeft = lngBytesLeft - lngReadBytes
  DoEvents
 Loop
 Close #intFreeFile
 Else
 Err.Raise -10000, "FileToBLOB", "The Database Field does not support Long Binary Data."
 End If
 End With
 End If
 
 If Err.Number <> 0 Or Err.LastDllError <> 0 Then
 FileToBLOB = False
 Else
 FileToBLOB = True
 End If
End Function
Původní komentáře (3)
Obnoveno z Wayback Machine