VB 5/6-Tipp 0577: Bilder in Tabelle mit ADO speichern

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
' Es muss ein Verweis auf 'Microsoft ActiveX Data Objects 2.0 Library' gesetzt werden.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"


'#########################################################
'
'     ADO_Bilder_Memo   by peter.k.sauer@web.de 01.2003
'
'     Bitmap in einer Access speichern
'---------------------------------------------------------
'     benötigt wird eine Tabelle 'Bilder' mit dem Aufbau
'
'     BI_ID       AutoWert
'     BI_Nummer   Long
'     BI_Bild     Memo
'----------------------------------------------------------
'     Verweis setzen auf Microsoft ActiveX Data Objects 2.x
'----------------------------------------------------------

Option Explicit

Private Cn As New ADODB.Connection

Private Sub Command1_Click()

   Dim sSQL As String
   Dim Bild As String
   Dim FNr As Integer
   Dim i As Long
   Dim Rs As New ADODB.Recordset
   
      FNr = FreeFile
      Open App.Path & "\test.bmp" For Binary As #FNr
      i = LOF(FNr)
      Bild = Space(i)
      Get #FNr, , Bild
      Close #FNr
      
      'Delete all Records
      sSQL = "Delete * From Bilder"
      Cn.Execute sSQL
      
           
      'einfügen über Recordset, über Insert
      'nicht möglich wegen Sonderzeichen Chr(39) Chr(34)
      sSQL = "Select * From Bilder Where BI_Nummer < 0"
      With Rs
         .CursorLocation = adUseClient
         .CursorType = adOpenKeyset
         .LockType = adLockOptimistic
         .ActiveConnection = Cn
         .Open sSQL

         .AddNew
         .Fields("BI_Nummer").Value = 4711
         .Fields("BI_Bild").Value = Bild
         .Update
         .Close
      End With
      Set Rs = Nothing
      
      MsgBox "Bild eingefügt"
End Sub

Private Sub Command2_Click()

   Dim Rs As New ADODB.Recordset
   Dim sSQL As String
   Dim FNr As Integer
   Dim mFile As String
   
      sSQL = "Select * From Bilder Where BI_Nummer = 4711"
      With Rs
         .CursorLocation = adUseClient
         .CursorType = adOpenKeyset
         .LockType = adLockReadOnly
         .ActiveConnection = Cn
         .Open sSQL
         
         If .RecordCount > 0 Then
            FNr = FreeFile
            
            mFile = App.Path & "\dummy.bmp"
            Open mFile For Output As #FNr
            Print #FNr, .Fields("BI_Bild").Value;
            Close #FNr
            Set Picture1.Picture = LoadPicture(mFile)
            Kill mFile
         End If
        .Close
      End With
      Set Rs = Nothing
      
End Sub

Private Sub Form_Load()

      With Cn
         .CursorLocation = adUseClient
         .Mode = adModeShareDenyNone
         .Provider = "Microsoft.Jet.OLEDB.4.0"
         .ConnectionString = "Data Source=" & App.Path & "\test.mdb"
         .Open
      End With
      
      Command1.Caption = "Bild in Tabelle"
      Command2.Caption = "Bild anzeigen"
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------