请问哪位大哥有AppendChunk的例子（真对图片操作），我好急，我在线等，给高高分

Question

'BeginAppendChunkVB    'To integrate this code
    'replace the data source and initial catalog values
    'in the connection string
    
Public Sub AppendChunkX()    'recordset and connection variables
   Dim Cnxn As ADODB.Connection
   Dim strCnxn As String
   Dim rstPubInfo As ADODB.Recordset
   Dim strSQLPubInfo As String
    'record variables
   Dim strPubID As String
   Dim strPRInfo As String
   Dim lngOffset As Long
   Dim lngLogoSize As Long
   Dim varLogo As Variant
   Dim varChunk As Variant
   Dim strMsg As String
   
   Const conChunkSize = 100   ' Open a connection
   Set Cnxn = New ADODB.Connection
   strCnxn = "Provider=sqloledb;Data Source=MyServer;Initial Catalog=Pubs;User Id=sa;Password=; "
   Cnxn.Open strCnxn
   
   ' Open the pub_info table with a cursor that allows updates
   Set rstPubInfo = New ADODB.Recordset
   strSQLPubInfo = "pub_info"
   rstPubInfo.Open strSQLPubInfo, Cnxn, adOpenKeyset, adLockOptimistic, adCmdTable
   
   ' Prompt for a logo to copy
   strMsg = "Available logos are : " & vbCr & vbCr
   Do While Not rstPubInfo.EOF
      strMsg = strMsg & rstPubInfo!pub_id & vbCr & _
         Left(rstPubInfo!pr_info, InStr(rstPubInfo!pr_info, ",") - 1) & _
         vbCr & vbCr
      rstPubInfo.MoveNext
   Loop
   
   strMsg = strMsg & "Enter the ID of a logo to copy:"
   strPubID = InputBox(strMsg)
   
   ' Copy the logo to a variable in chunks
   rstPubInfo.Filter = "pub_id = '" & strPubID & "'"
   lngLogoSize = rstPubInfo!logo.ActualSize
   Do While lngOffset < lngLogoSize
      varChunk = rstPubInfo!logo.GetChunk(conChunkSize)
      varLogo = varLogo & varChunk
      lngOffset = lngOffset + conChunkSize
   Loop
   
   ' Get data from the user
   strPubID = Trim(InputBox("Enter a new pub ID" & _
                            " [must be > 9899 & < 9999]:"))
   strPRInfo = Trim(InputBox("Enter descriptive text:"))   ' Add the new publisher to the publishers table to avoid
   ' getting an error due to foreign key constraint
   Cnxn.Execute "INSERT publishers(pub_id, pub_name) VALUES('" & _
                  strPubID & "','Your Test Publisher')"
   
   ' Add a new record, copying the logo in chunks
   rstPubInfo.AddNew
   rstPubInfo!pub_id = strPubID
   rstPubInfo!pr_info = strPRInfo   lngOffset = 0 ' Reset offset
   Do While lngOffset < lngLogoSize
      varChunk = LeftB(RightB(varLogo, lngLogoSize - lngOffset), _
         conChunkSize)
      rstPubInfo!logo.AppendChunk varChunk
      lngOffset = lngOffset + conChunkSize
   Loop
   rstPubInfo.Update
   
    ' Show the newly added data
   MsgBox "New record: " & rstPubInfo!pub_id & vbCr & _
      "Description: " & rstPubInfo!pr_info & vbCr & _
      "Logo size: " & rstPubInfo!logo.ActualSize   ' Delete new records because this is a demo
   rstPubInfo.Requery
   Cnxn.Execute "DELETE FROM pub_info " & _
      "WHERE pub_id = '" & strPubID & "'"   Cnxn.Execute "DELETE FROM publishers " & _
      "WHERE pub_id = '" & strPubID & "'"    ' clean up
   rstPubInfo.Close
   Cnxn.Close
   Set rstPubInfo = Nothing
   Set Cnxn = NothingEnd Sub
'EndAppendChunkVB

Answer 1

我原来的类模块，Sql7/2000的、ADO的，可用来存二进制文件（Word文档没有问题）VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "FilePic"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'<CSCC>
'--------------------------------------------------------------------------------
'    Component  : FilePic
'    Project    : Person_Manage
'
'    Description: [type_description_here]
'
'    Modified   :
'--------------------------------------------------------------------------------
'</CSCC>
  Option ExplicitPrivate filename As String
Private mFiledName As String
Private WithEvents mRstRule As ADODB.Recordset
Attribute mRstRule.VB_VarHelpID = -1
Private mFileName As StringPrivate mcnnServer As ADODB.Connection'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Person_Manage
' Procedure  :       ServerConnection
' Description:       [type_description_here]
' Created by :       Administrator
' Machine    :       ZHANGPI
' Date-Time  :       2002-07-10-11:36:27
'
' Parameters :       oConnection (ADODB.Connection)
'--------------------------------------------------------------------------------
'</CSCM>
Public Property Let ServerConnection(oConnection As ADODB.Connection)    'If IsObject(oConnection) Then
    Set mcnnServer = New ADODB.Connection
    Set mcnnServer = oConnection
    '    MsgBox mcnnServer.ConnectionString
    ' MsgBox mcnnServer.ConnectionString
    'End IfEnd Property'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Person_Manage
' Procedure  :       SaveToAdo
' Description:       [type_description_here]
' Created by :       Administrator
' Machine    :       ZHANGPI
' Date-Time  :       2002-07-10-11:36:27
'
' Parameters :       oFileName (String)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function SaveToAdo(ByVal oFileName As String) As Boolean    '文件到字段
    On Error Resume Next
SaveToAdo = True
    Dim FL As Long '文件长度
    Dim Chunks As Integer, Fragment As Long
    Dim Chunk() As Byte, i As Integer
    Const ChunkSize As Long = 32768
    mFileName = oFileName
    '如果没有打开新的，就不用保存法规文档字段
    Open mFileName For Binary Access Read As #1
    FL = LOF(1)      '文件中数据的长度    If FL = 0 Then        MsgBox "文件" & mFileName & "长度为0.", vbInformation, "保存错误"
        Close #1
        SaveToAdo = False
        Exit Function    End If    Chunks = FL \ ChunkSize
    Fragment = FL Mod ChunkSize
    ReDim Chunk(Fragment)
    Get #1, , Chunk()
    mRstRule(mFiledName).AppendChunk Chunk()
    ReDim Chunk(ChunkSize)    For i = 1 To Chunks        Get #1, , Chunk()
        mRstRule(mFiledName).AppendChunk Chunk()    Next i    Close #1
    mRstRule.Update
    '这里不须要mRstRule.Update,因为之后有这一语句
    ' mblnWordChange = False
    SaveToAdo = True
    Exit Function
Err_SaveToAdo:
    Close #1
    SaveToAdo = FalseEnd Function'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Person_Manage
' Procedure  :       ReadFromAdo
' Description:       [type_description_here]
' Created by :       Administrator
' Machine    :       ZHANGPI
' Date-Time  :       2002-07-10-11:36:27
'
' Parameters :       oFileName (String)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function ReadFromAdo(ByVal oFileName As String) As Boolean    'On Error Resume Next
    '从字段读到文件
    On Error GoTo Err_ReadFromAdo
    Dim FL As Long '文件长度
    Dim Chunks As Integer, Fragment As Long
    Dim Chunk() As Byte, i As Integer
    Static title As Long
    Dim fileHandle As Long
    
    title = title + 1
    ' Const ChunkSize As Long = 32768
    Dim ChunkSize As Long
    FL = mRstRule(mFiledName).ActualSize
    ChunkSize = FL
    '如果字段'Lvalue'中长度为0，则读取失败    If FL = 0 Then        ReadFromAdo = False
        Exit Function    End If
    
    fileHandle = FreeFile
    filename = oFileName  'mTempFileName & Trim(Str(title))
    Open filename For Binary Access Write As fileHandle
    Chunks = FL \ ChunkSize
    Fragment = FL Mod ChunkSize
    ' ReDim Chunk(Fragment)
    ' Chunk() = mRstRule(mfiledname).GetChunk(Fragment)
    ' Put fileHandle, , Chunk()
    ReDim Chunk(ChunkSize)
    ' For i = 1 To Chunks
    Chunk() = mRstRule(mFiledName).GetChunk(ChunkSize)
    Put fileHandle, , Chunk()
    ' Next i
    Close fileHandle
    ReadFromAdo = True
    Exit Function
Err_ReadFromAdo:
    Close fileHandle
    ReadFromAdo = False
    '    PowerError Err.Number, Err.Source, Err.Description, "读取数据错误"End Function
    
'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Person_Manage
' Procedure  :       OpenRecordSet
' Description:       [type_description_here]
' Created by :       Administrator
' Machine    :       ZHANGPI
' Date-Time  :       2002-07-10-11:36:27
'
' Parameters :       oA0100 (String)
'                    oB0110 (String)
'                    oTypeid (String)
'                    oId (Integer)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function OpenRecordSet(ByVal oA0100 As String, ByVal oB0110 As String, ByVal oTypeid As String, ByVal oId As Integer) As Boolean    On Error GoTo Err_OpenRecordSet
    OpenRecordSet = True
    
    Set mRstRule = New ADODB.Recordset    With mRstRule        Set .ActiveConnection = mcnnServer
        .CursorType = adOpenForwardOnly
        .LockType = adLockPessimistic ' = adLockOptimistic
        .Source = "Select * From AMEDIA Where typeid='" & oTypeid & "' and a0100='" & oA0100 & "' and b0110='" & oB0110 & "' and id=" & oId
        .Open        If .RecordCount <> 1 Then
            .AddNew
            .Fields("typeid").Value = oTypeid
            .Fields("a0100").Value = oA0100
            .Fields("b0110").Value = oB0110
            .Fields("id").Value = oId
        End If        ''
        '            '新建准备    End With
    
    mFiledName = "AMEDIA" 'oFdName
    
    Exit Function
    
Err_OpenRecordSet:
    
    OpenRecordSet = FalseEnd Function'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Person_Manage
' Procedure  :       DeleteRecordSet
' Description:       [type_description_here]
' Created by :       Administrator
' Machine    :       ZHANGPI
' Date-Time  :       2002-07-10-11:36:27
'
' Parameters :       oA0100 (String)
'                    oB0110 (String)
'                    oTypeid (String)
'                    oId (Integer)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function DeleteRecordSet(ByVal oA0100 As String, ByVal oB0110 As String, ByVal oTypeid As String, ByVal oId As Integer) As Boolean    On Error Resume Next
    Dim ss As String
    ss = "delete From AMEDIA Where typeid='" & oTypeid & "' and a0100='" & oA0100 & "' and b0110='" & oB0110 & "' and id=" & oId
    mcnnServer.Execute ss
  
End Function

Answer 2

Dim rs As New Recordset
    Dim lngLogoSize As Long     '图片长度
    Dim f As Object               '表单
    rp.buffer = True
    Set f = GetUploadForm(rq.BinaryRead(rq.TotalBytes))
    rs.Open "table", Cn, adOpenKeyset, adLockOptimistic, adCmdTable
        If CheckForm(rsp, f) Then 
            With rs
                .AddNew
                .Fields("a") = f("a")
                .Fields("b") = f("b")
                .Fields("c").AppendChunk f("c")
                .Update
                End With
        Else
            HandError "不合法输入", "输入值和数据库字段数据类型冲突"
        End If '2
    Set rs = Nothing