Sub ReadPictureFromRec(Rec As ADODB.Recordset, ByVal FieldName As String, PictureBoxORImage As Object)
On Error Resume Next
Dim chunk() As Byte
Dim i, Chunks, FragMent As Integer
Const ChunkSize As Integer = 16384
Dim fl As Long
DATAFILE = 1
Open IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\") & "picFILETEMP.tep" For Binary Access Write As DATAFILE
fl = Rec(FieldName).ActualSize
Chunks = fl \ ChunkSize
FragMent = fl Mod ChunkSize
ReDim chunk(FragMent)
chunk() = Rec(FieldName).GetChunk(fl)
Put DATAFILE, , chunk()
For i = 1 To Chunks
ReDim chunk(ChunkSize)
chunk() = Rec(FieldName).GetChunk(ChunkSize)
Put DATAFILE, , chunk()
Next
Close DATAFILE
PictureBoxORImage.Picture = LoadPicture("")
PictureBoxORImage.Picture = LoadPicture(IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\") & "picFILETEMP.tep")
Kill IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\") & "picFILETEMP.tep"
End Sub
Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Sub SavePictureToRec(rs As ADODB.Recordset, ByVal FieldName As String, ByVal FileName As String)
On Error Resume Next
Dim Length As Long, f As Integer
Length = FileLen(FileName)
ReDim bArray(Length + 12) As Byte, bArray2(Length) As Byte
bArray(0) = &H6C: bArray(1) = &H74
RtlMoveMemory bArray(4), Length, 4
f = FreeFile
Open FileName For Binary As #f
Get #f, , bArray2
Close #1
RtlMoveMemory bArray(8), bArray2(0), Length
rs(FieldName).AppendChunk bArray
End Sub