'-------------- Anfang Projektdatei BLOBs.vbp  --------------
' Es muss ein Verweis auf 'Microsoft ActiveX Data Objects 2.5 Library' gesetzt 
' werden.
' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3) (comdlg32.ocx)' 
' wird benötigt.
 
'------- Anfang Formular "frmMain" alias frmMain.frm  -------
' Steuerelement: Listen-Steuerelement "lstDateien"
' Steuerelement: Schaltfläche "cmdDelete"
' Steuerelement: Standarddialog-Steuerelement "dlgDialog"
' Steuerelement: Schaltfläche "cmdAddFile"
' Steuerelement: Beschriftungsfeld "lblHinweis"
Option Explicit
 
 
 
Private Cn As ADODB.Connection
Private Rs As ADODB.Recordset
Private Doc As ADODB.Stream
 
 
 
Public Sub Aktualisieren()
 
    On Error Goto Fehler
    lstDateien.Clear
    Rs.MoveFirst
    Do While Not Rs.EOF = True
        lstDateien.AddItem Rs.Fields("Beschreibung").Value
        Rs.MoveNext
    Loop
    Exit Sub
 
Fehler:
    If Err.Number = 3021 Then MsgBox "Keine Datensätze vorhanden", vbInformation
 
End Sub
 
 
 
Private Sub cmdAddFile_click()
 
    On Error Goto Fehler
    Set Doc = New ADODB.Stream
    dlgDialog.ShowOpen
    With Doc
        .Type = adTypeBinary
        .Open
        .LoadFromFile dlgDialog.FileName
    End With
    Rs.AddNew
    Rs.Fields("File") = Doc.Read
    Rs.Fields("Beschreibung") = InputBox("Beschreibung;")
    Rs.Update
    Call Aktualisieren
    Exit Sub
 
Fehler:
    If Err.Number = 32755 Then Exit Sub
 
End Sub
 
 
 
Private Sub cmdDelete_Click()
 
    Rs.MoveFirst
    Rs.Move lstDateien.ListIndex
    Rs.Delete
    Rs.Update
    Call Aktualisieren
 
End Sub
 
 
 
Private Sub Form_Load()
 
    Set Cn = New ADODB.Connection
    Set Rs = Nothing
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.3.51"
        .ConnectionString = "Data Source=" & App.Path & "\Tips.mdb"
        .Open
    End With
    Set Rs = New ADODB.Recordset
    With Rs
        .Source = "SELECT Beschreibung, File FROM tblTips"
        .LockType = adLockOptimistic
        .CursorType = adOpenStatic
        Set .ActiveConnection = Cn
        .Open
    End With
    Call Aktualisieren
 
End Sub
 
 
 
Private Sub Form_Unload(Cancel As Integer)
 
    Set Rs = Nothing
    Set Cn = Nothing
    Set Doc = Nothing
 
End Sub
 
 
 
Private Sub lstDateien_DblClick()
 
    On Error Goto Fehler
    Set Doc = New ADODB.Stream
    dlgDialog.ShowSave
    With Doc
        .Type = adTypeBinary
        .Open
        Rs.MoveFirst
        Rs.Move lstDateien.ListIndex
        .Write Rs.Fields("File")
        .SaveToFile dlgDialog.FileName
        .Close
    End With
    Exit Sub
 
Fehler:
    If Err.Number = 32755 Then Exit Sub
 
End Sub
 
'-------- Ende Formular "frmMain" alias frmMain.frm  --------
'--------------- Ende Projektdatei BLOBs.vbp  ---------------