Hey guys,,here is a code that i got to upload an image,,,,i seriously dont understand wat s going on in this code,,,could some one help me out,,,,pls,,

Private Sub mnuRecordAdd_Click()
Dim rs As ADODB.Recordset
Dim person_name As String
Dim file_num As String
Dim file_length As String
Dim bytes() As Byte
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long
 
    person_name = InputBox("Name")
    If Len(person_name) = 0 Then Exit Sub
 
    dlgPicture.Flags = _
        cdlOFNFileMustExist Or _
        cdlOFNHideReadOnly Or _
        cdlOFNExplorer
    dlgPicture.CancelError = True
    dlgPicture.Filter = "Graphics " & _
        "Files|*.bmp;*.ico;*.jpg;*.gif"
 
    On Error Resume Next
    dlgPicture.ShowOpen
    If Err.Number = cdlCancel Then
        Exit Sub
    ElseIf Err.Number <> 0 Then
        MsgBox "Error " & Format$(Err.Number) & _
            " selecting file." & vbCrLf & Err.Description
        Exit Sub
    End If
 
    ' Open the picture file.
    file_num = FreeFile
    Open dlgPicture.FileName For Binary Access Read As _
        #file_num
 
    file_length = LOF(file_num)
    If file_length > 0 Then
        num_blocks = file_length / BLOCK_SIZE
        left_over = file_length Mod BLOCK_SIZE
 
        Set rs = New ADODB.Recordset
        rs.CursorType = adOpenKeyset
        rs.LockType = adLockOptimistic
        rs.Open "Select Name, Picture, FileLength FROM " & _
            "People", m_DBConn
 
        rs.AddNew
        rs!Name = person_name
        rs!FileLength = file_length
 
        ReDim bytes(BLOCK_SIZE)
        For block_num = 1 To num_blocks
            Get #file_num, , bytes()
            rs!Picture.AppendChunk bytes()
        Next block_num
 
        If left_over > 0 Then
            ReDim bytes(left_over)
            Get #file_num, , bytes()
            rs!Picture.AppendChunk bytes()
        End If
 
        rs.Update
        Close #file_num
 
        lstPeople.AddItem person_name
        lstPeople.Text = person_name
    End If
End Sub

IMAGE RETRIEVAL:

THIS S THE CODE FOR RETRIEVING AN IMAGE,,

' Display the clicked person.
Private Sub lstPeople_Click()
Dim rs As ADODB.Recordset
Dim bytes() As Byte
Dim file_name As String
Dim file_num As Integer
Dim file_length As Long
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long
Dim hgt As Single
 
    picPerson.Visible = False
    Screen.MousePointer = vbHourglass
    DoEvents
 
    ' Get the record.
    Set rs = m_DBConn.Execute("SELECT * FROM People WHERE " & _
        "Name='" & _
        lstPeople.Text & "'", , adCmdText)
    If rs.EOF Then Exit Sub
 
    ' Get a temporary file name.
    file_name = TemporaryFileName()
 
    ' Open the file.
    file_num = FreeFile
    Open file_name For Binary As #file_num
 
    ' Copy the data into the file.
    file_length = rs!FileLength
    num_blocks = file_length / BLOCK_SIZE
    left_over = file_length Mod BLOCK_SIZE
 
    For block_num = 1 To num_blocks
        bytes() = rs!Picture.GetChunk(BLOCK_SIZE)
        Put #file_num, , bytes()
    Next block_num
 
    If left_over > 0 Then
        bytes() = rs!Picture.GetChunk(left_over)
        Put #file_num, , bytes()
    End If
 
    Close #file_num
 
    ' Display the picture file.
    picPerson.Picture = LoadPicture(file_name)
    picPerson.Visible = True
 
    Width = picPerson.Left + picPerson.Width + Width - _
        ScaleWidth
    hgt = picPerson.Top + picPerson.Height + Height - _
        ScaleHeight
    If hgt < 1440 Then hgt = 1440
    Height = hgt
 
    Kill file_name
    Screen.MousePointer = vbDefault
End Sub
 
' Return a temporary file name.
Private Function TemporaryFileName() As String
Dim temp_path As String
Dim temp_file As String
Dim length As Long
 
    ' Get the temporary file path.
    temp_path = Space$(MAX_PATH)
    length = GetTempPath(MAX_PATH, temp_path)
    temp_path = Left$(temp_path, length)
 
    ' Get the file name.
    temp_file = Space$(MAX_PATH)
    GetTempFileName temp_path, "per", 0, temp_file
    TemporaryFileName = Left$(temp_file, InStr(temp_file, _
        Chr$(0)) - 1)
End Function

Recommended Answers

All 3 Replies

Firstly, where does your error occur? What kind of error are you receiving? What database are you using, Access, MySql, Sql Server etc?

i dont hav any error,,,i actually dont understand the code thats my prob.....pls explain the operations,,,pls

I hope the following helps -

Private Sub mnuRecordAdd_Click()

Dim rs As ADODB.Recordset
'Your recordset to get data from a table
Dim person_name As String
'The search criteria to show a specific persons data
Dim file_num As String
'The file to use to retrieve the picture from
Dim file_length As String
'Size of the file to be opened
Dim bytes() As Byte
'Next 3 has to do with the size of the picture
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long
 
    person_name = InputBox("Name")
    'Search criteria to be entered to start the search. In this case the person's name
    If Len(person_name) = 0 Then Exit Sub
    'If no name has been entered, exit sub and let user try again
 
    dlgPicture.Flags = _
        cdlOFNFileMustExist Or _
        cdlOFNHideReadOnly Or _
        cdlOFNExplorer
        'dlgPicture referes to a common dialog control
    dlgPicture.CancelError = True
    'if the user click on cancel, no picture will be loaded and the common
    'dialog window will close
    dlgPicture.Filter = "Graphics " & _
        "Files|*.bmp;*.ico;*.jpg;*.gif"
        'What must the common dialog window open?, In this case, pictures with a bmp
        'jpg, gif or ico file extension
 
    On Error Resume Next
    'If any error, coninue to the next step
    dlgPicture.ShowOpen
    'opens the common dialog window with the extension names in that file as above
    If Err.Number = cdlCancel Then
    'Cancel was selected in dlg window
        Exit Sub
    ElseIf Err.Number <> 0 Then
        MsgBox "Error " & Format$(Err.Number) & _
            " selecting file." & vbCrLf & Err.Description
            'this error will show when an incorrect file extension was selected
            ' as in say a .png picture
        Exit Sub
    End If
 
    ' Open the picture file. To here ALL is still fine
    file_num = FreeFile 'Get the file where the picture resides
    Open dlgPicture.FileName For Binary Access Read As _
        #file_num 'The picture selected in the file it resided
 
    file_length = LOF(file_num)
    If file_length > 0 Then 'must be bigger than 0 otherwise no file was selected
    'or a corrupted picture was selected
        num_blocks = file_length / BLOCK_SIZE 'See TemporaryFileName function below
        left_over = file_length Mod BLOCK_SIZE
 
        Set rs = New ADODB.Recordset 'create recordset
        rs.CursorType = adOpenKeyset
        rs.LockType = adLockOptimistic
        rs.Open "Select Name, Picture, FileLength FROM " & _
            "People", m_DBConn 'sql string
 
        rs.AddNew
        rs!Name = person_name 'person name to be saved to table
        rs!FileLength = file_length 'size of pic to be saved
 
        ReDim bytes(BLOCK_SIZE) 'recall function to avoid errors
        For block_num = 1 To num_blocks
            Get #file_num, , bytes()
            rs!Picture.AppendChunk bytes()
        Next block_num 'Counted all pic blocks and saved to the pic field
        'in the database AS BINARY!!!!
 
        If left_over > 0 Then
            ReDim bytes(left_over)
            Get #file_num, , bytes()
            rs!Picture.AppendChunk bytes()
        End If 'saved the last part of picture
 
        rs.Update 'data saved
        Close #file_num 'close the file where the picture was
 
        lstPeople.AddItem person_name 'populate the listbox.
        lstPeople.Text = person_name
    End If
End Sub

Private Sub lstPeople_Click()

'this is very similar to above with the exception that the picture is now read from the database
'chunk or byte by byte and loaded into a picture box.

Dim rs As ADODB.Recordset
Dim bytes() As Byte
Dim file_name As String
Dim file_num As Integer
Dim file_length As Long
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long
Dim hgt As Single
 
    picPerson.Visible = False
    Screen.MousePointer = vbHourglass
    DoEvents
 
    ' Get the record.
    Set rs = m_DBConn.Execute("SELECT * FROM People WHERE " & _
        "Name='" & _
        lstPeople.Text & "'", , adCmdText)
    If rs.EOF Then Exit Sub
 
    ' Get a temporary file name.
    file_name = TemporaryFileName()
 
    ' Open the file.
    file_num = FreeFile
    Open file_name For Binary As #file_num
 
    ' Copy the data into the file.
    file_length = rs!FileLength
    num_blocks = file_length / BLOCK_SIZE
    left_over = file_length Mod BLOCK_SIZE
 
    For block_num = 1 To num_blocks
        bytes() = rs!Picture.GetChunk(BLOCK_SIZE)
        Put #file_num, , bytes()
    Next block_num
 
    If left_over > 0 Then
        bytes() = rs!Picture.GetChunk(left_over)
        Put #file_num, , bytes()
    End If
 
    Close #file_num
 
    ' Display the picture file.
    picPerson.Picture = LoadPicture(file_name)
    picPerson.Visible = True
 
    Width = picPerson.Left + picPerson.Width + Width - _
        ScaleWidth
    hgt = picPerson.Top + picPerson.Height + Height - _
        ScaleHeight
    If hgt < 1440 Then hgt = 1440
    Height = hgt 'All above covers the size of the picture box to show
    'the picture correctly
 
    Kill file_name
    Screen.MousePointer = vbDefault
End Sub
 
' Return a temporary file name.
Private Function TemporaryFileName() As String

'This gets the path full path name into a string when the
'picture is selected from the common dialog control window.
'It ensures that no errors occur when selecting a picture
'and saving it to your database.


Dim temp_path As String
Dim temp_file As String
Dim length As Long
 
    ' Get the temporary file path.
    temp_path = Space$(MAX_PATH)
    length = GetTempPath(MAX_PATH, temp_path)
    temp_path = Left$(temp_path, length)
 
    ' Get the file name.
    temp_file = Space$(MAX_PATH)
    GetTempFileName temp_path, "per", 0, temp_file
    TemporaryFileName = Left$(temp_file, InStr(temp_file, _
        Chr$(0)) - 1)
End Function

Search google for more information on the common dialog control, path names etc.

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.