请教如何用VB6。0来读写图形字段？

两个解答都是使用adodb.stream来完成的

shawls的解答
---------------------------------------------------------------

Private  Sub  Command3_Click()
Dim  c  As  New  ADODB.Connection
c.Open    "Provider=Microsoft.Jet.OLEDB.4.0;Data  Source=C:\1.mdb;Persist  Security  Info=False  "
c.Execute    "create  table  a  (b  longbinary)  "
End  Sub

Private  Sub  Command4_Click()
       Set  b  =  New  ADODB.Recordset
       Set  c  =  New  ADODB.Stream


               c.Mode  =  adModeReadWrite

       c.Type  =  adTypeBinary
       c.Open
       c.LoadFromFile    "c:\1.bmp  "

       b.Open    "select  *  from  a  ",    "Provider=Microsoft.Jet.OLEDB.4.0;Data  Source=C:\1.mdb;Persist  Security  Info=False  ",  adOpenDynamic,  adLockOptimistic
       b.AddNew

       b.Fields.Item(0).Value  =  c.Read()


       b.Update

       b.Close
       Set  b  =  New  ADODB.Recordset
       b.Open    "select  *  from  a  ",    "Provider=Microsoft.Jet.OLEDB.4.0;Data  Source=C:\1.mdb;Persist  Security  Info=False  ",  adOpenKeyset,  adLockOptimistic
       MsgBox  b.RecordCount

       b.MoveLast

       c.Write  (b.Fields.Item(0).Value)

       c.SaveToFile    "c:\aa.bmp  ",  adSaveCreateOverWrite

       Picture1.Picture  =  LoadPicture(  "c:\aa.bmp  ")
End  Sub

w18ly的解答
---------------------------------------------------------------

'Use  ADODB.Stream  Method
'After  ADO  2.6
'Import  the  Image  to  SQLServer
Private  Sub  ImportBLOB(cn  As  ADODB.Connection)

       Dim  rs  As  New  ADODB.Recordset
       Dim  stm  As  ADODB.Stream

       Set  stm  =  New  ADODB.Stream

       '  Skip  any  table  not  found  errors
       On  Error  Resume  Next
       cn.Execute    "drop  table  BinaryObject  "

       On  Error  GoTo  0
       'Create  the  BinaryObject  table
       cn.Execute    "create  table  BinaryObject    "  &  _
                                   "(blob_id  int  IDENTITY(1,1),    "  &  _
                                     "blob_filename  varchar(256),    "  &  _
                                     "blob_object  image)  "

       rs.Open    "Select  *  from  BinaryObject  where  1=2  ",  cn,  adOpenKeyset,  adLockOptimistic
       'Read  the  binary  files  from  disk
       stm.Type  =  adTypeBinary
       stm.Open
       stm.LoadFromFile  App.Path  &    "\BLOBsample.jpg  "

       rs.AddNew
       rs!blob_filename  =  App.Path  &    "\BLOBsample.jpg  "
       rs!blob_object  =  stm.Read

       'Insert  the  binary  object  in  the  table
       rs.Update

       rs.Close
       stm.Close

       Set  rs  =  Nothing
       Set  stm  =  Nothing

End  Sub
'Display  the  image  on  image  control
Private  Sub  DisplayBLOB(cn  As  ADODB.Connection)

       Dim  rs  As  New  ADODB.Recordset

       '  Select  the  only  image  in  the  table
       rs.Open    "Select  *  from  BinaryObject  where  blob_id  =  1  ",  cn

       '  Set  the  DataSource  to  the  recordset
       Set  imgBinaryData.DataSource  =  rs
       'Set  the  DataField  to  the  BLOB  field
       imgBinaryData.DataField  =  rs!blob_object.Name

       'Release  the  recordset
       rs.Close
       Set  rs  =  Nothing

End  Sub
用VB6读写数据库中的图片关键词：VBScript   很多兄弟在这里问关于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 Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH = 260Private m_DBConn As ADODB.ConnectionPrivate 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 SubPrivate 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
我写的两个函数
iFileNumber是一个以Binary方式打开的文件号
fdObject是一个图形字段Public Function FileStreamToField(iFileNumber As Integer, fdObject) As Integer
'将文件写入数据库
Dim ss As String * 129
Dim sChunkHolder() As Byte
Dim lChunkCount As Long
Dim lChunkRemainder As Long
Dim i As Long    ReDim sChunkHolder(CHUNK_SIZE - 1) As Byte
    lChunkCount = (LOF(iFileNumber) - Seek(iFileNumber) + 1) \ CHUNK_SIZE ' 取块数
    lChunkRemainder = (LOF(iFileNumber) - Seek(iFileNumber) + 1) Mod CHUNK_SIZE

    For i = 0 To lChunkCount - 1

        Get iFileNumber, , sChunkHolder
        fdObject.AppendChunk (sChunkHolder)

    Next
    If lChunkRemainder > 0 Then

        ReDim sChunkHolder(lChunkRemainder - 1) As Byte
        Get iFileNumber, , sChunkHolder
        fdObject.AppendChunk (sChunkHolder)

    End If
    FileStreamToField = 0

End FunctioniFileNumber是一个以Binary方式打开的文件号
fdObject是一个图形字段
Public Function FieldToFileStream(iFileNumber As Integer, fdObject) As Integer
'从数据库生成文件
Dim sChunkHolder() As Byte
Dim lChunkCount As Long
Dim lChunkRemainder As Long
Dim i As Long    ReDim sChunkHolder(CHUNK_SIZE - 1) As Byte
    lChunkCount = fdObject.ActualSize \ CHUNK_SIZE
    lChunkRemainder = fdObject.ActualSize Mod CHUNK_SIZE
    For i = 0 To lChunkCount - 1

        sChunkHolder = fdObject.GetChunk(CHUNK_SIZE)
        Put iFileNumber, , sChunkHolder

    Next

    If lChunkRemainder > 0 Then

        ReDim sChunkHolder(lChunkRemainder - 1) As Byte
        sChunkHolder = fdObject.GetChunk(lChunkRemainder)
        Put iFileNumber, , sChunkHolder

    End If
    FieldToFileStream = 0

End Function

调试易

请教如何用VB6。0来读写图形字段？

解决方案 »