vb6

[colmar]

Is it possible to store photographs within a database made with the visual data manager?

[AndreRet]

What database are you using, access, sql, mysql?

[colmar]

I will be using Microsoft Access 7MDB within the visual data manager in VB6.
Thank you for any advice you might be able to give. Also I am a novice programmer.

[AndreRet]

Sorry for this, you ARE using VS Data Manager and not VB6?

[colmar]

Sorry if I seem a numpty but the visual data manager is in the add ins in vb6.
Once I have made the database I will then connect to it using visual basic and the jet engine.

[AndreRet]

There is a difference in using VS Data Man. The below code will work fine using VB6.:)

Option Explicit
 
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
 
'Purpose     :  Saves pictures in image boxes (or similiar) to a field in a recordset
'Inputs      :  oPictureControl                 A control containing an image
'               adoRS                           ADO recordset to add the image to
'               sFieldName                      The field name in adoRS, to add the image to
'Outputs     :  Returns True if succeeded in updating the recordset
'Notes       :  The field specified in sFieldName, must have a binary field type (ie. OLE Object in access)
'               Save the image at the currect cursor location in the recordset.
'Revisions   :
 
Public Function SavePictureToDB(oPictureControl As Object, adoRS As ADODB.Recordset, sFieldName As String) As Boolean
    Dim oPict As StdPicture
    Dim sDir As String, sTempFile As String
    Dim iFileNum As Integer
    Dim lFileLength As Long
    Dim abBytes() As Byte
    Dim iCtr As Integer
 
    On Error GoTo ErrHandler
 
    Set oPict = oPictureControl.Picture
    If oPict Is Nothing Then
        SavePictureToDB = False
        Exit Function
    End If
 
    'Save picture to temp file
    sTempFile = FileGetTempName
    SavePicture oPict, sTempFile
 
    'read file contents to byte array
    iFileNum = FreeFile
    Open sTempFile For Binary Access Read As #iFileNum
    lFileLength = LOF(iFileNum)
    ReDim abBytes(lFileLength)
    Get #iFileNum, , abBytes()
    'put byte array contents into db field
    adoRS.Fields(sFieldName).AppendChunk abBytes()
    Close #iFileNum
 
    'Don't return false if file can't be deleted
    On Error Resume Next
    Kill sTempFile
    SavePictureToDB = True
    Exit Function
 
ErrHandler:
    SavePictureToDB = False
    Debug.Print Err.Description
End Function
 
 
'Purpose     :  Loads a Picture, saved as binary data in a database, from a recordset into a picture control.
'Inputs      :  oPictureControl                 A control to load the image into
'               adoRS                           ADO recordset to add the image to
'               sFieldName                      The field name in adoRS, to add the image to
'Outputs     :  Returns True if succeeded in loading the image
'Notes       :  Loads the image at the currect cursor location in the recordset.
 
 
Public Function LoadPictureFromDB(oPictureControl As Object, adoRS As ADODB.Recordset, sFieldName As String) As Boolean
    Dim oPict As StdPicture
    Dim sDir As String
    Dim sTempFile As String
    Dim iFileNum As Integer
    Dim lFileLength As Long
    Dim abBytes() As Byte
    Dim iCtr As Integer
 
    On Error GoTo ErrHandler
    sTempFile = FileGetTempName
 
    iFileNum = FreeFile
    Open sTempFile For Binary As #iFileNum
    lFileLength = LenB(adoRS(sFieldName))
 
    abBytes = adoRS(sFieldName).GetChunk(lFileLength)
    Put #iFileNum, , abBytes()
    Close #iFileNum
 
    oPictureControl.Picture = LoadPicture(sTempFile)
 
    Kill sTempFile
    LoadPictureFromDB = True
    Exit Function
 
ErrHandler:
    LoadPictureFromDB = False
    Debug.Print Err.Description
End Function
 
 
'Purpose     :  The FileGetTempName function returns a name of a temporary file.
'Inputs      :  [sFilePrefix]               The prefix of the file name.
'Outputs     :  Returns the name of the next free temporary file name (and path).
'Notes       :  The filename is the concatenation of specified path and prefix strings,
'               a hexadecimal string formed from a specified integer, and the .TMP extension
 
 
Function FileGetTempName(Optional sFilePrefix As String = "TMP") As String
    Dim sTemp As String * 260, lngLen As Long
    Static ssTempPath As String
 
    If LenB(ssTempPath) = 0 Then
        'Get the temporary path
        lngLen = GetTempPath(260, sTemp)
        'strip the rest of the buffer
        ssTempPath = Left$(sTemp, lngLen)
        If Right$(ssTempPath, 1) <> "\" Then
            ssTempPath = ssTempPath & "\"
        End If
    End If
 
    'Get a temporary filename
    lngLen = GetTempFileName(ssTempPath, sFilePrefix, 0, sTemp)
    'Remove all the unnecessary chr$(0)'s
    FileGetTempName = Left$(sTemp, InStr(1, sTemp, Chr$(0)) - 1)
End Function
 
 
'SAMPLE USAGE
'NOTE : Add a PictureBox control to a form before running this code
Sub TestLoadPicture()
    Dim sConn As String
    Dim oConn As New ADODB.Connection
    Dim oRs As New ADODB.Recordset
 
    On Error GoTo ErrFailed
    sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyPhotos.MDB;Persist Security Info=False"
 
    oConn.Open sConn
    oRs.Open "SELECT * FROM Copies", oConn, adOpenKeyset, adLockOptimistic
    'If oRs.EOF = False Then
        LoadPictureFromDB Picture2, oRs, "EmpPhoto"
    'End If
    oRs.Close
    Exit Sub
ErrFailed:
    MsgBox "Error " & Err.Description
End Sub
 
'SAMPLE USAGE
'NOTE : Add a PictureBox control to a form before running this code
Sub TestSavePicture()
    Dim sConn As String
    Dim oConn As New ADODB.Connection
    Dim oRs As New ADODB.Recordset
 
    On Error GoTo ErrFailed
    sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\192.168.0.199\cserver\EmployeeCopies.MDB;Persist Security Info=False"
 
    oConn.Open sConn
    oRs.Open "SELECT * FROM Copies", oConn, adOpenKeyset, adLockOptimistic
    'If oRs.EOF = False Then
        oRs.AddNew
        SavePictureToDB Picture1, oRs, "EmpPhoto"
        oRs.Update
        MsgBox "saved"
    'End If
    oRs.Close
    Exit Sub
ErrFailed:
    MsgBox "Error " & Err.Description
End Sub
 
Private Sub Command1_Click()
Call TestLoadPicture
End Sub
 
Private Sub Command2_Click()
Call TestSavePicture
End Sub