很多兄弟在这里问关于VB6读写数据库中的图片的问题，在此有一例，希有所启发。   1，以人名和相关图片为例说明，数据库为Access，有如下字段：Name char,picture OLE object,FileLength Number。当为ms sql时，将picture改为lob即可。   2，示例包含control：commom dialog,picture,listbox。源码如下：Option ExplicitPrivate Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As LongPrivate Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As LongPrivate Const MAX_PATH = 260Private m_DBConn As ADODB.ConnectionPrivate Const BLOCK_SIZE = 10000' Return a temporary file name.Private Function TemporaryFileName() As StringDim temp_path As StringDim temp_file As StringDim 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 FunctionPrivate Sub Form_Load()Dim db_file As StringDim 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 = NothingEnd SubPrivate Sub Form_Resize()    lstPeople.Height = ScaleHeightEnd Sub' Display the clicked person.Private Sub lstPeople_Click()Dim rs As ADODB.RecordsetDim bytes() As ByteDim file_name As StringDim file_num As IntegerDim file_length As LongDim num_blocks As LongDim left_over As LongDim block_num As LongDim 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 = vbDefaultEnd SubPrivate Sub mnuRecordAdd_Click()Dim rs As ADODB.RecordsetDim person_name As StringDim file_num As StringDim file_length As StringDim bytes() As ByteDim num_blocks As LongDim left_over As LongDim 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 引用 :http://www.edufans.com/html/ASP/Asp_skills/2006/200609172444.html

评论