Hi,
ich habe mein MS Access 2000 Frontend MySQL au PostGreSQL umgestellt. Bis auf ein Problem mit den ehemaligen blob-Daten geht auch alles. Für die bilter nutze ich nun bytea und geife folgendermaßend lesend und schreibend mittels ADO 2.7 über PG-ODBC Vers.8.03.04.00 (UNICODE) drauf zu:
schreiben:
Public Function InsertPixFile(strQuelle As String, strPixFile, ID As Variant)
On Error GoTo Err_InsertPixFile
'Diese Prozedur speichert eine Datei (strPixFile) unter dem Namen in strName in
'der Tabelle Bilder binär im Feld "Bild"
Dim pix() As Byte
Dim rs As ADODB.Recordset
Dim strSQL As String
Dim F As Integer
F = FreeFile
If Nz(ID) = "" Then Exit Function
Open strPixFile For Binary As #F
ReDim pix(LOF(F))
Get #F, , pix()
Close #F
Select Case strQuelle
Case "Paket"
strSQL = "SELECT Bild AS Pic, BildName AS PicName FROM tbl_P_Paket " _
& "WHERE Deleted=0 AND ID_Paket=" & ID
Case "Sparepart"
strSQL = "SELECT picture AS Pic, picturename AS PicName FROM spareparts_details " _
& "WHERE id_spareparts_details=" & ID
Case "NIK_Anlagen"
strSQL = "SELECT document AS Pic, document_name AS PicName FROM tbl_kunden_documents " _
& "WHERE id_kunden_documents=" & ID
Case "Spareparts_Dokument"
strSQL = "SELECT document AS Pic, document_name AS PicName FROM spareparts_documents " _
& "WHERE id_spareparts_documents=" & ID
Case "Pakete_Dokument"
strSQL = "SELECT document AS Pic, document_name AS PicName FROM tbl_p_documents " _
& "WHERE id_p_documents=" & ID
End Select
Set rs = New ADODB.Recordset
Set rs = clsODBC.GetSQL(strSQL)
With rs
If .RecordCount = 0 Then
MsgBox "Bitte speichern Sie Ihre Eingaben bevor Sie ein Bild/Datei hinzufügen.", _
vbOKOnly + vbInformation, "Speichern"
Else
'Binär speichern
rs("Pic").AppendChunk pix()
rs("PicName") = Mid(strPixFile, InStrRev(strPixFile, "\") + 1)
.Update
End If
.Close
Set rs = Nothing
End With
Exit_InsertPixFile:
Erase pix
Set rs = Nothing
Exit Function
Err_InsertPixFile:
Reset
FehlerAufnahme strModul, "InsertPixFile"
Resume Exit_InsertPixFile
End Function
lesen:
Public Function CreatePix(strQuelle As String, ByRef strPicName As String, ID As Long) As StdPicture
On Error GoTo Err_CreatePix
Dim rs As ADODB.Recordset
Dim pix() As Byte
Dim lSize As Long
Dim strSQL As String
Dim Resultat As Double
Dim F As Integer
F = FreeFile
If ID = 0 Then Exit Function
Select Case strQuelle
Case "Paket"
strSQL = "SELECT Bild AS Pic, BildName AS PicName FROM tbl_P_Paket WHERE Deleted=0 AND ID_Paket=" & ID
Case "Sparepart"
strSQL = "SELECT picture AS Pic, picturename AS PicName FROM spareparts_details " _
& "WHERE id_spareparts_details=" & ID
Case "Tyres"
strSQL = "SELECT picture AS Pic, picturename AS PicName FROM spareparts_details " _
& "WHERE id_spareparts_details=" & ID
Case "Anlagen_Kunden"
strSQL = "SELECT document AS Pic, document_name AS PicName FROM tbl_kunden_documents " _
& "WHERE id_kunden_documents=" & ID
Case "Anlagen_Pakete"
strSQL = "SELECT document AS Pic, document_name AS PicName FROM tbl_p_documents " _
& "WHERE id_p_documents=" & ID
Case "Anlagen_Spareparts"
strSQL = "SELECT document AS Pic, document_name AS PicName FROM spareparts_documents " _
& "WHERE id_spareparts_documents=" & ID
End Select
Set rs = New ADODB.Recordset
Set rs = clsODBC.GetSQL(strSQL)
With rs
If .RecordCount > 0 Then
lSize = rs("Pic").ActualSize
If Not lSize = 0 Then
ReDim pix(lSize)
pix() = rs("Pic").GetChunk(lSize) 'Binärdaten in Arry laden
Set CreatePix = BytesToPicture(pix) 'Siehe Funktion im Modul mdlArrayToStdPicture
strPicName = rs("PicName")
'Das passiert bei nicht unterstützten Bildformaten
If CreatePix Is Nothing Then MsgBox "Das Bildformat wird nicht unterstützt oder die " _
& "Anlage ist nicht vorhanden oder defekt. Laden Sie die Anlage neu!", _
vbOKOnly + vbCritical, "Anlage kann nicht angezeigt werden"
End If
Else
Erase pix
End If
.Close
Set rs = Nothing
End With
If Left(strQuelle, 8) = "Anlagen_" Then
Open GetSpecFolder(CSIDL_PERSONAL) & "\Anlagen_" & strPicName For Binary As #F
Put #F, , pix
Close #F
MsgBox "Die Anlage wurde unter '" & GetSpecFolder(CSIDL_PERSONAL) & "\Anlagen_" & strPicName _
& "' abgelegt. Es wird nun versucht diese Anlage zur Anzeige zu bringen. Sollte dies " _
& "nicht gelingen, verfügen Sie über keinen geeignetten Viewer für dieses Dateiformat.", _
vbOKOnly + vbInformation, "Anlage anzeigen"
Resultat = ShellExecute(0, "open", GetSpecFolder(CSIDL_PERSONAL) & "\Anlagen_" & strPicName, "", "", vbNormalFocus)
End If
Exit_CreatePix:
Erase pix
Set rs = Nothing
Exit Function
Err_CreatePix:
FehlerAufnahme strModul, "CreatePix"
Resume Exit_CreatePix
End Function
die Datenbankabfrage geschieht so:
Public Function GetSQL(ByVal strSQL As String) As ADODB.Recordset
On Error GoTo Err_GetSQL
'Ausführen SQL-Abfrage
Set GetSQL = New ADODB.Recordset
GetSQL.CursorLocation = adUseClient
GetSQL.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic 'adOpenDynamic, adLockOptimistic
Exit_Err_GetSQL:
Exit Function
Err_GetSQL:
MsgBox "Fehler Nummer " & Err.Number & " (" & Err.description & ") in 'GetSQL' aufgetreten"
Resume Exit_Err_GetSQL
End Function
Bei .AppendChunk und .GetChunk erhalte ich jeweis den Fehler “3219 Der Vorgang ist in diesem Zusammenhang nicht zugelassen.”
Komisch ist auch dass bei lSize = rs(“Pic”).ActualSize immer 255 raus kommt, was nicht sein kann. Hat jemand eine Idee dazu?
Danke Sylvio
. Ich kodiere die binäre Datei mit Base64 und lege sie als Text in die Datenbank. Sie wird zwar 1/3 größer aber ich bin unabhängig vom Datenbanktyp binary (longblob, bytea,…). Rückwärtz wird der Text wieder dekodiert und in ein Array umgewandelt, das dann direkt zur Anzeige oder in eine Datei gespeichert werden kann. Das ganze geht so ähnlich wie bei Email-Anlagen.