文件保存到数据库的一个问题！

Question

Set rs1 = New ADODB.Recordset
rs1.Open "select * from ywtc_main where file_name='" + File_name + "'", db, adOpenKeyset, adLockOptimistic
Dim tempFile() As Byte
    
     Open Trim(txtFields(1).Text) For Binary Access Read As #1
     tempFile = InputB(LOF(1), #1)
     Close #1      With rs1
           If .EOF Then
              .AddNew
              .Fields("id") = txtFields(0).Text
              .Fields("file_name") = File_name
              .Fields("wj") = tempFile             
              .Fields("op_time") = Sys_Date
              .Update
           Else
              .Fields("file_name") = File_name
              .Fields("wj") = tempFile
              .Update
           End If
     End With
rs1.Close
保存小于32767字节时，能正常使用，但大于32767时在有的计算机可以正常保存及取出，在多数PC里保存能成功，但读出时是空的，在wj字段里只显示“0x”，谁能解决困扰我很长时间的难题？！（数据库是sql2000）

Answer 1

应使用Field对象的GetChunk和AppendChunk方法。

Answer 2

'将图片字段写入图片文件
Public Function GetImageFile(pField As ADODB.Field) As String
    Const MAX_LENGTH As Long = 100000
    Const GRAPH_FILENAME = "CLPHOTO.jpg"
    Dim tVar As Variant
    Dim tByte() As Byte
    Dim tFileName As String
    
    ReDim tByte(1 To pField.ActualSize)
    tByte = pField.GetChunk(pField.ActualSize)
    tFileName = WIN_DIR + "\" + GRAPH_FILENAME
    
    Open tFileName For Binary Access Write As #1
    Put #1, , tByte
    Close #1
    
    GetImageFile = tFileName
    ReDim tByte(1 To 1)
End Function'将图片文件写入图片字段
Public Sub SaveImageFile(pField As ADODB.Field, pFileName As String)
    Dim tVar As Variant
    Dim tByte() As Byte
    Dim tLng As Long
    
    tLng = FileLen(pFileName)
    ReDim tByte(1 To tLng)
    
    Open pFileName For Binary Access Read As #1
    Get #1, , tByte
    Close #1
    
    Call pField.AppendChunk(tByte)
    ReDim tByte(1 To 1)
End Sub

Answer 3

   改用流控制看看...Public Enum SmRsType
       RsWrite = 1
       RsRead = 2
End Enum'
'读写二进制数据(流)
'函数名:AdoStream
'参数:  M_Conn ADODB连接,TabName 目标数据表,FldName 目标字段,WhereStr 更新条件,
'       FileName 源文件名或由流生成的文件名,RsStyle 记录集的操作类型.W:File to Recode,R:Recode to File
'返回值:
'例:    CALL  AdoStream(P_Cnn,"AchGoods","GdsPhoto","Where gdsid='001'","C:\Tmp.Bmp","W")Public Function AdoStream(M_Conn As ADODB.Connection, _
                          TabName As String, _
                          FldName As String, _
                          Optional WhereStr As String = "", _
                          Optional Filename As String, _
                          Optional RsStyle As SmRsType = RsWrite) As String
    
    Dim StrSql As String
    Dim TmpFileName As String
    Dim Rs As New ADODB.Recordset
    Dim AdoSem As New ADODB.Stream
    Dim ReturnVal As String
    Dim WorkPath As String
    Dim RsType  As Long
    Dim RsStyleStr As String
    
    On Error Resume Next
    
    WorkPath = App.Path
    If Right$(WorkPath, 1) <> "\" Then WorkPath = WorkPath & "\"
    ReturnVal = ""
    AdoSem.Type = adTypeBinary    '流数据类型
    AdoSem.Open                  '打开流
'/-----------------------------------------------------------
    '将流写入记录集
    RsType = RsStyle
    RsStyleStr = Choose(RsType, "W", "R")
    If RsStyleStr = "W" Then
        If Left$(Trim$(UCase$(WhereStr)), Len("where")) <> UCase$("where") Then WhereStr = " Where " & Trim$(WhereStr)
        StrSql = "Select Top 1 [" & TabName & "].[" & FldName & "] From [" & TabName & "] " & WhereStr
        Set Rs = RsOpen(M_Conn, StrSql, False)  '连接式记录集
        If Not (Rs.EOF And Rs.BOF) Then
            Rs.MoveFirst
            AdoSem.LoadFromFile Filename            '将文件LOAD到流
            DoEvents
            Rs.Fields(FldName).AppendChunk AdoSem.Read
            Rs.Update
        End If
        AdoStream = ""
    ElseIf RsStyle = "R" Then
        '/将流从记录集中取出
        If Len(Trim$(Filename)) = 0 Then Filename = "TmpFile.Bmp"
        If Len(Trim$(Dir$(TmpFileName, vbNormal + vbHidden))) > 0 Then Kill Filename
        If Left$(Trim$(UCase$(WhereStr)), Len("where")) <> UCase$("where") Then WhereStr = " Where " & Trim$(WhereStr)
        
        StrSql = "Select Top 1 [" & TabName & "].[" & FldName & "] From [" & TabName & "] " & WhereStr
        Set Rs = RsOpen(M_Conn, StrSql)
        If Not (Rs.EOF And Rs.BOF) Then
            Rs.MoveFirst
            If Not (IsNull(Rs.Fields(FldName))) Then
                TmpFileName = WorkPath & Filename
                AdoSem.Write Rs.Fields(FldName).GetChunk(Rs.Fields(FldName).ActualSize)
                DoEvents
                AdoSem.SaveToFile TmpFileName, IIf(Len(Trim$(Dir$(TmpFileName, vbNormal + vbHidden))) > 0, adSaveCreateOverWrite, adSaveCreateNotExist)
                AdoStream = TmpFileName
            Else
                AdoStream = ""
            End If
        Else
            AdoStream = ""
        End If
    End If
    AdoSem.Close: Set AdoSem = Nothing
    Rs.Close: Set Rs = Nothing
    Err.Clear
End Function