用VB6读写数据库中的图片 -pc6资讯

您的位置：首页 → 技术开发 → ASP技巧 → 用VB6读写数据库中的图片

用VB6读写数据库中的图片 时间：2004/11/7 4:04:00来源：本站整理作者：蓝点我要评论(0): 很多兄弟在这里问关于VB6读写数据库中的图片的问题，在此有一例，希有所启发。

   1，以人名和相关图片为例说明，数据库为Access，有如下字段：Name char,picture OLE object,FileLength

Number。当为ms sql时，将picture改为lob即可。

   2，示例包含control：commom dialog,picture,listbox。

源码如下：

Option Explicit

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

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long,

ByVal lpBuffer As String) As Long

Private Const MAX_PATH = 260

Private m_DBConn As ADODB.Connection

Private Const BLOCK_SIZE = 10000

' 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

Private Sub Form_Load()

Dim db_file As String

Dim rs As ADODB.Recordset

    ' Get the database file name.

    db_file = App.Path

    If Right$(db_file, 1) <> "\" Then db_file = db_file & "\"

    db_file = db_file & "dbpict.mdb"

    ' Open the database connection.

    Set m_DBConn = New ADODB.Connection

    m_DBConn.Open _

        "Provider=Microsoft.Jet.OLEDB.4.0;" & _

        "Data Source=" & db_file & ";" & _

        "Persist Security Info=False"

    ' Get the list of people.

    Set rs = m_DBConn.Execute("SELECT Name FROM People ORDER BY Name", , adCmdText)

    Do While Not rs.EOF

        lstPeople.AddItem rs!Name

        rs.MoveNext

    Loop

    rs.Close

    Set rs = Nothing

End Sub

Private Sub Form_Resize()

    lstPeople.Height = ScaleHeight

End Sub

' 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

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

文章评论

查看所有0条评论>>

热门文章 没有查询到任何记录。