howto_database_picture.html

Databasing picture files

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

    <FONT COLOR="#008000">' Open the picture file.</FONT>
    file_num = FreeFile
    Open dlgPicture.FileName For Binary Access Read As _
        #file_num

    file_length = LOF(file_num)
    If file_length &gt; 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 " &amp; _
            "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 &gt; 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</FONT></PRE>
              </TD></TR>

              <!-- Text content -->
              <TR><TD>&nbsp;<BR></TD></TR>
              <TR><TD>
To retreive a picture, the program selects the appropriate database record. It uses the TemporaryFileName function to get a temporary file name and opens the file. It then uses GetChunk to read the data from the database in blocks and writes the blocks into the file. The program then uses LoadPicture to load the file, and Kill to remove it.
              </TD></TR>

              <!-- Code content -->
              <TR><TD>&nbsp;<BR></TD></TR>
              <TR>
                <TD BACKGROUND="computer_paper.jpg">
                  <PRE><FONT NAME="Courier New" POINT-SIZE="10" SIZE="2"><FONT COLOR="#008000">' Display the clicked person.</FONT>
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

    <FONT COLOR="#008000">' Get the record.</FONT>
    Set rs = m_DBConn.Execute("SELECT * FROM People WHERE " &amp; _
        "Name='" &amp; _
        lstPeople.Text &amp; "'", , adCmdText)
    If rs.EOF Then Exit Sub

    <FONT COLOR="#008000">' Get a temporary file name.</FONT>
    file_name = TemporaryFileName()

    <FONT COLOR="#008000">' Open the file.</FONT>
    file_num = FreeFile
    Open file_name For Binary As #file_num

    <FONT COLOR="#008000">' Copy the data into the file.</FONT>
    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 &gt; 0 Then
        bytes() = rs!Picture.GetChunk(left_over)
        Put #file_num, , bytes()
    End If

    Close #file_num

    <FONT COLOR="#008000">' Display the picture file.</FONT>
    picPerson.Picture = LoadPicture(file_name)
    picPerson.Visible = True

    Width = picPerson.Left + picPerson.Width + Width - _
        ScaleWidth
    hgt = picPerson.Top + picPerson.Height + Height - _
        ScaleHeight
    If hgt &lt; 1440 Then hgt = 1440
    Height = hgt

    Kill file_name
    Screen.MousePointer = vbDefault
End Sub

<FONT COLOR="#008000">' Return a temporary file name.</FONT>
Private Function TemporaryFileName() As String
Dim temp_path As String
Dim temp_file As String
Dim length As Long

    <FONT COLOR="#008000">' Get the temporary file path.</FONT>
    temp_path = Space$(MAX_PATH)
    length = GetTempPath(MAX_PATH, temp_path)
    temp_path = Left$(temp_path, length)

    <FONT COLOR="#008000">' Get the file name.</FONT>
    temp_file = Space$(MAX_PATH)
    GetTempFileName temp_path, "per", 0, temp_file
    TemporaryFileName = Left$(temp_file, InStr(temp_file, _
        Chr$(0)) - 1)
End Function</FONT></PRE>
              </TD></TR>

              <!-- Text content -->
              <TR><TD>&nbsp;<BR></TD></TR>
              <TR><TD>
You could use a similar technique to save and restore other types of files. For example, you could restore an executable program and then execute it.
              </TD></TR>

              <!-- *************** -->
              <!-- Download button -->
              <!-- *************** -->

              <TR><TD><FONT SIZE="-2">&nbsp;</FONT></TD></TR>
              <TR><TD ALIGN="Center"><A HREF="HowTo/howto_database_picture.zip"><IMG SRC="download.jpg" BORDER="0"></A></TD></TR>
              <TR><TD><FONT SIZE="-2">&nbsp;</FONT></TD></TR>

            </TABLE> <!-- End content table -->
          </TD>
        </TR> <!-- End row containing menu column and content -->
      </TABLE> <!-- End table containing menu column and content -->
    </TD></TR>

    <!-- ****** -->
    <!-- Footer -->
    <!-- ****** -->
    <TR><TD WIDTH="100%">
      <TABLE WIDTH="100%" BORDER="0" BGCOLOR="#87CEFA" CELLSPACING="0" CELLPADDING="0">
        <!-- Top row -->
        <TR>
          <TD BGCOLOR="#E1F3FF" ALIGN="Right" WIDTH="16"><IMG SRC="blue_ul.jpg" WIDTH="16" HEIGHT="16"></TD>
          <TD BACKGROUND="blue_um.jpg" COLSPAN="2" ALIGN="Center"><FONT SIZE="-2">
            Copyright &copy; 1997-2003 Rocky Mountain Computer Consulting, Inc. &nbsp; All rights reserved.
          </FONT></TD>
          <TD BGCOLOR="#E1F3FF"><IMG SRC="blue_ur.jpg" WIDTH="16" HEIGHT="16"></TD>
        </TR>

        <!-- Bottom row -->
        <TR>
          <TD BGCOLOR="#E1F3FF" ALIGN="Right" WIDTH="16"><IMG SRC="blue_ll.jpg" WIDTH="16" HEIGHT="16"></TD>
          <TD BACKGROUND="blue_lm.jpg"><FONT SIZE="-2">
            &nbsp;<SCRIPT LANGUAGE=JavaScript>document.write(document.URL)</SCRIPT></FONT></TD>
          <TD BACKGROUND="blue_lm.jpg" ALIGN="Right"><FONT SIZE="-2">
            Updated <SCRIPT LANGUAGE=JavaScript>document.write(document.lastModified)</SCRIPT> &nbsp;
          </FONT></TD>
          <TD BGCOLOR="#E1F3FF"><IMG SRC="blue_lr.jpg" WIDTH="16" HEIGHT="16"></TD>
        </TR>
      </TABLE>
    </TD></TR>
  </TABLE> <!-- End table containing banner, menu column + content, and footer -->

</BODY>
</HTML>