• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 648
  • Last Modified:

Need sample VB 6.0 code of adding an attachment (graphic file) to a table in an Oracle database.

I need to add an enhancement to an existing application.  The enhancement is to allow attaching a file (pdf, gif, jpg, etc) to the database.  All the information for the table will have to be inserted with the actual file (blob).  I have created the following table in the database but I don't have a clue of how to add the file to it in VB6.0.

I'm looking for a quick and simple way of doing it in VB6.0.  Please help?

The LotID, TestID and SeqNo info will be available when this function/sub is run...

Any help would be greatly appreciated!

the following table:  Attachments

Field Name             Constraint             DataType                          Description
==========================================================================
LotID      PK      NOT NULL      NUMBER(10)      Lot identifier  LotID in LotRecords table
TestID      PK      NOT NULL      NUMBER(10)      Test identifier  DBID in Tests table
SeqNo      PK      NOT NULL      NUMBER(10)      Sequence identifier
FName            NOT NULL      VARCHAR2(256)       Name of the file (no drive or path information).
FExt            NOT NULL      VARCHAR2(5)      File name extension (pdf, gif, jpg, etc)
FCreate            NOT NULL      DATE            Date/time stamp when file was created
FAttached            NOT NULL      DATE            Date/time stamp when file was attached
EmployeeID      NOT NULL      NUMBER(10)      Who attached the file
FImage            NOT NULL      BLOB            Associated binary data or binary file image
0
BeckyBair
Asked:
BeckyBair
  • 2
1 Solution
 
mdouganCommented:
OK, here is a bit of code hacked from one of my applications that read and wrote image data to a blob in the database.  This particular sample was using an Access database, but I'm pretty sure I've used the exact same code on Oracle (with different connection logic).  There is probably more here than you need, the procedures to look at are LoadPhoto and SaveToDB.  

LoadPhoto takes the data out of the blob field using the GetChunk method into a byte array, then saves the byte array to a temporary disk file, then loads a picturebox on the form from that temp file.  

The SaveToDB takes data from a BMP, JPG or whatever, disk file, reads it into a byte array, then uses AppendChunk to write the data to a recordset field, then Update to update the row in the database.

In this sample, users are loaded into a flexgrid. When there is a different row highlighted in the grid, then we search for that user in the RSPROFILES recordset and display their detail on the form.  If there is a photo value, it is displayed in a picturebox.  If the user wants to change the photo, they click a button that will allow the user to browse for a photo file, then it will immediately update that row in the recordset with the blob data and display the photo on the screen.

One caveat, is that if your file is larger than the default ChunkSize (which I think is 64K) then you may need to call AppendChunk or GetChunk repeatedly to get or append all of the data.  I think I have another sample of this in a previously asked question here on EE, but, that would have been from several years ago, so, don't know if it is still available.

The code assumes that you have an ADODB.Connection object named CN that is already opened.
Option Explicit
 
' These constants are used for the Users Table
Private Const PROFILE_ID = 0
Private Const PROFILE_FIRST_NAME = 1
Private Const PROFILE_MIDDLE_NAME = 2
Private Const PROFILE_LAST_NAME = 3
Private Const PROFILE_LOGON_NAME = 4
Private Const PROFILE_BIRTHDATE = 5
 
' These are the main global variables for the form
Private RS As ADODB.Recordset
Private RSPROFILES As ADODB.Recordset
Private bChanged As Boolean
 
 
Private Sub Form_Load()
' This procedures executes when the form is loaded
Dim i As Long
 
    On Error GoTo ErrorRtn
    
' Load all of the Enabled users
    LoadUsers
        
ExitRtn:
    Exit Sub
ErrorRtn:
    MsgBox Err.Description, vbExclamation, Err.Number & ""
    GoTo ExitRtn
 
End Sub
 
 
Private Sub LoadUsers()
' This procedure is used to load the Users Table
Dim sSQL As String
Dim sTemp As String
Dim i As Long
 
    On Error GoTo ErrorRtn
    
    sSQL = "SELECT USERS.USER_ID,"
    sSQL = sSQL & " USERS.FIRST_NAME,"
    sSQL = sSQL & " USERS.MIDDLE_NAME,"
    sSQL = sSQL & " USERS.LAST_NAME,"
    sSQL = sSQL & " USERS.LOGON_NAME,"
    sSQL = sSQL & " USERS.LOGON_PASSWORD,"
    sSQL = sSQL & " USERS.BIRTH_DATE,"
    sSQL = sSQL & " USERS.DESCRIPTION,"
    sSQL = sSQL & " USERS.ENABLED,"
    sSQL = sSQL & " USERS.ACTIVE,"
    sSQL = sSQL & " USERS.PHOTO"
    sSQL = sSQL & " FROM USERS"
    sSQL = sSQL & " WHERE USERS.ENABLED = TRUE"
'    sSQL = sSQL & " AND USERS.ACTIVE = TRUE"
    sSQL = sSQL & " ORDER BY USERS.LAST_NAME"
    Set RSPROFILES = New ADODB.Recordset
    
    RSPROFILES.CursorLocation = adUseClient
    
' Open the recordset dynamically, so that it might be updated if necessary
    RSPROFILES.Open sSQL, CN, adOpenDynamic, adLockOptimistic
       
'    If RSPROFILES.Supports(adUpdate) Or RSPROFILES.Supports(adUpdateBatch) Then
'        MsgBox "Update is OK"
'    End If
        
    If RSPROFILES.State = adStateOpen Then
        If Not RSPROFILES.EOF And Not RSPROFILES.BOF Then
            RSPROFILES.MoveLast
            RSPROFILES.MoveFirst
            tblUsers.Rows = RSPROFILES.RecordCount + 1
            i = 1
            tblUsers.Redraw = False
            
' Set up the column formats for the User Table
            Set mProfileFormat = Nothing
            mProfileFormat = Array(KEYFMTMASK, "", "", "", "", DATEFMTMASK)
 
            While Not RSPROFILES.EOF
                tblUsers.TextMatrix(i, PROFILE_ID) = Format(RSPROFILES("USER_ID").Value, mProfileFormat(PROFILE_ID)) & ""
                tblUsers.TextMatrix(i, PROFILE_FIRST_NAME) = RSPROFILES("FIRST_NAME").Value & ""
                tblUsers.TextMatrix(i, PROFILE_MIDDLE_NAME) = RSPROFILES("MIDDLE_NAME").Value & ""
                tblUsers.TextMatrix(i, PROFILE_LAST_NAME) = RSPROFILES("LAST_NAME").Value & ""
                tblUsers.TextMatrix(i, PROFILE_LOGON_NAME) = RSPROFILES("LOGON_NAME").Value & ""
                tblUsers.TextMatrix(i, PROFILE_BIRTHDATE) = Format(RSPROFILES("BIRTH_DATE").Value, mProfileFormat(PROFILE_BIRTHDATE)) & ""
                i = i + 1
                RSPROFILES.MoveNext
            Wend
        End If
        RSPROFILES.MoveFirst
' Highlight the first row in the table
        If tblUsers.Rows > 1 Then
            tblUsers.Row = 1
            tblUsers.Col = 0
            tblUsers.RowSel = 1
            tblUsers.ColSel = tblUsers.Cols - 1
            tblUsers_RowColChange
        End If
    End If
        
ExitRtn:
    Set CMD = Nothing
    tblUsers.Redraw = True
    
    Exit Sub
ErrorRtn:
    MsgBox Err.Description, vbExclamation, Err.Number & ""
    GoTo ExitRtn
    
End Sub
 
Private Sub tblUsers_RowColChange()
    On Error GoTo ErrorRtn
    
' If the highlighted user has been changed, then prompt the user to save the changes
    If bChanged And cmdSave.Enabled = True Then
        If MsgBox("The current profile has been changed.  Do you wish to save your changes?", vbQuestion + vbYesNo, "Save Changes") = vbYes Then
            cmdSave_Click
        End If
    End If
    
' Position the recordset on the same user the table has highlighted
    RSPROFILES.MoveFirst
    RSPROFILES.Find "USER_ID = " & tblUsers.TextMatrix(tblUsers.Row, 0)
 
' Fill the screen from the highlight
    txtFirstName.Text = RSPROFILES("FIRST_NAME").Value & ""
    txtMiddleName.Text = RSPROFILES("MIDDLE_NAME").Value & ""
    txtLastName.Text = RSPROFILES("LAST_NAME").Value & ""
    txtLogonName.Text = RSPROFILES("LOGON_NAME").Value & ""
    txtPassword.Text = RSPROFILES("LOGON_PASSWORD").Value & ""
    txtBirthDate.Text = RSPROFILES("BIRTH_DATE").Value & ""
    txtDescription.Text = RSPROFILES("DESCRIPTION").Value & ""
    chkEnabled.Value = Abs(RSPROFILES("ENABLED").Value)
    
' Use the special logic to load the photo from the database
    LoadPhoto
        
' Reset the changed flag
    bChanged = False
        
ExitRtn:
    Exit Sub
ErrorRtn:
    MsgBox Err.Description, vbExclamation, Err.Number & ""
    GoTo ExitRtn
    
End Sub
 
 
Public Sub LoadPhoto()
' This procedure is used to load the image control with the data from the Photo column in the database
Dim lngImageSize As Long
Dim lngOffset As Long
Dim bytChunk() As Byte
Dim intFile As Integer
Dim strTempPic As String
Const conChunkSize = 100
Dim strImage As String
 
    On Error GoTo ErrorRtn
    
' Make sure you have a valid row
    If Not (RSPROFILES.BOF And RSPROFILES.EOF) Then
            
' Make sure you have a valid photo
        If IsNull(RSPROFILES("PHOTO").Value) Then
            imgPhoto.Picture = LoadPicture("")
            GoTo ExitRtn
        End If
        
        'Make sure the temporary file
        'doesn't exist already
        strTempPic = App.Path & "\TempPic.dat"
        On Error Resume Next
        If Len(Dir(strTempPic)) > 0 Then
           Kill strTempPic
        End If
        On Error GoTo ErrorRtn
    
        'Open the temporary file to save the BLOB to
        intFile = FreeFile
        Open strTempPic For Binary As #intFile
    
        'Read the binary data into
        'the byte variable array
        lngImageSize = RSPROFILES("PHOTO").ActualSize
        
' Clear out the picture and exit
        If lngImageSize = 0 Then
            imgPhoto.Picture = LoadPicture("")
            Exit Sub
        End If
        
' Get the photo chunks at a time until the whole thing has been retrieved
        Do While lngOffset < lngImageSize
           bytChunk() = RSPROFILES("PHOTO").GetChunk(conChunkSize)
           Put #intFile, , bytChunk()
           lngOffset = lngOffset + conChunkSize
        Loop
        Close #intFile
    
        'After loading the image, get
        'rid of the temporary file
        imgPhoto.Picture = LoadPicture(strTempPic)
        On Error Resume Next
        Kill strTempPic
    End If
 
ExitRtn:
    Exit Sub
ErrorRtn:
    imgPhoto.Picture = LoadPicture("")
    MsgBox Err.Description, vbExclamation, Err.Number & ""
    Close #intFile
    GoTo ExitRtn
 
End Sub
 
Private Sub cmdBrowseForPhoto_Click()
    SaveToDB
End Sub
 
 
Private Sub SaveToDB()
' This procedure is used to load an image from the disk into the image control, and to immediatly update the database
Dim bytBLOB() As Byte
Dim strImagePath As String
Dim intNum As Integer
 
    On Error GoTo ErrorRtn
 
' Set the filters to valid file types
    cdlCommon.Filter = "*.bmp|*.bmp|*.jpg|*.jpg|*.gif|*.gif"
    cdlCommon.ShowOpen
    
' Get the name of the external picture file
    If cdlCommon.FileName <> "" Then
        strImagePath = cdlCommon.FileName
    Else
        Exit Sub
    End If
 
 
' Load the Photo column with chunks and then update
    With RSPROFILES
        intNum = FreeFile
        Open strImagePath For Binary As #intNum
        ReDim bytBLOB(FileLen(strImagePath))
        Get #intNum, , bytBLOB
        Close #1
        .Fields("PHOTO").AppendChunk bytBLOB
        .Update
    End With
 
' Make sure that the image control is also loaded with the picture file
    imgPhoto.Picture = LoadPicture(strImagePath)
 
ExitRtn:
    Exit Sub
ErrorRtn:
    MsgBox Err.Description, vbExclamation, Err.Number & ""
    GoTo ExitRtn
    
End Sub
 
 
Private Sub Form_Unload(Cancel As Integer)
' This procedure runs when the form is unloaded
Dim sSQL As String
 
    On Error Resume Next
    
    
    RSPROFILES.Close
    Set RSPROFILES = Nothing
    
    Set CMD = Nothing
    
    CN.Close
    Set CN = Nothing
    
End Sub

Open in new window

0
 
mdouganCommented:
I did a search using my user id   "mdougan"  as a search word along with "AppendChunk" and found some of those old past questions that I'd answered.  One thing I read, which I don't think is in this code, is that I said that when issuing the Update statement for the row, use UpdateBatch instead of Update.

But, I also found another solution using a stream object that works better than the appendchunk method.  This example was for SQL Server, but it should work for Oracle too.

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_20284068.html

0
 
BeckyBairAuthor Commented:
Thank you for your help!
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now