Attribute VB_Name = "Module_Sauve_Image"
Option Explicit

Const BLOCK_SIZE = 32384


'**********************************************************************************
'*                    Pour Extraire le fichier de la base de donnée
'**********************************************************************************
Public Sub BlobToFile(ByRef Fld As ADODB.Field, ByVal FName As String, Optional FieldSize As Long = -1, _
                      Optional Threshold As Long = 1048576)
   Dim F As Long
   Dim bData() As Byte
   Dim sData As String

' Assumes file does Not exist
' Data canNot exceed approx. 2Gb in size

   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

Private Sub WriteFromBinary(ByVal F As Long, ByRef Fld As ADODB.Field, ByVal FieldSize As Long)
   Dim Data() As Byte
   Dim 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

Private Sub WriteFromUnsizedBinary(ByVal F As Long, ByRef Fld As ADODB.Field)
   Dim Data() As Byte
   Dim 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

Private Sub WriteFromText(ByVal F As Long, ByRef Fld As ADODB.Field, ByVal FieldSize As Long)
   Dim Data As String
   Dim CharsRead As Long

   Do While FieldSize <> CharsRead
      If FieldSize - CharsRead < BLOCK_SIZE Then
         Data = Fld.GetChunk(FieldSize - BLOCK_SIZE)
         CharsRead = FieldSize
      Else
         Data = Fld.GetChunk(BLOCK_SIZE)
         CharsRead = CharsRead + BLOCK_SIZE
      End If
      Put #F, , Data
   Loop
End Sub

Private Sub WriteFromUnsizedText(ByVal F As Long, ByRef Fld As ADODB.Field)
   Dim Data As String
   Dim Temp As Variant

   Do
      Temp = Fld.GetChunk(BLOCK_SIZE)
      If IsNull(Temp) Then Exit Do
      Data = Temp
      Put #F, , Data
   Loop While Len(Temp) = BLOCK_SIZE
End Sub


'**********************************************************************************
'*                    Pour sauvegarder le fichier dans la base de donnée
'**********************************************************************************

' Assumes file exists
' Assumes calling routine does the UPDATE
' File canNot exceed approx. 2Gb in size
Public Sub FileToBlob(ByVal FName As String, ByRef Fld As ADODB.Field, Optional Threshold As Long = 1048576)
   Dim F As Long
   Dim Data() As Byte
   Dim FileSize As Long
   
   F = FreeFile
   Open FName For Binary As #F
       FileSize = LOF(F)
       Select Case Fld.Type
            Case adLongVarBinary
               If FileSize > 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

Private Sub ReadToBinary(ByVal F As Long, ByRef Fld As ADODB.Field, ByVal FileSize As Long)
   Dim Data() As Byte
   Dim 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

Private Sub ReadToText(ByVal F As Long, ByRef Fld As ADODB.Field, ByVal FileSize As Long)
   Dim Data As String
   Dim 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



