关于如何向sql_server数据库中写入图片的问题！

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 FunctionPublic 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

解决方案 »

免费领取超大流量手机卡，每月29元包185G流量+100分钟通话, 中国电信官方发货

一个完整的类模块。
'<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
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
Dim cnn1 As New ADODB.Connection, rst As New ADODB.Recordset
    If VarPath = "" Then
    '    然后将字节数组的内容写入数据库即可
        Connect_Db cnn1  '建立连接
        sSql = "SELECT * FROM YP_INFO WHERE INFO_CODE='" & VarCode & "'"
        rst.Open sSql, cnn1, adOpenKeyset, adLockOptimistic
        If Not (rst.EOF And rst.BOF) Then
         rst.Fields("INFO_PICT") = ""
          rst.Update
        End If
    Else
     Open VarPath For Binary As #1
        ReDim bit(LOF(1)) As Byte
        Get 1, 1, bit
        Close 1
    '    然后将字节数组的内容写入数据库即可
        Connect_Db cnn1
        sSql = "SELECT * FROM YP_INFO WHERE INFO_CODE='" & VarCode & "'"
        rst.Open sSql, cnn1, adOpenKeyset, adLockOptimistic
        If Not (rst.EOF And rst.BOF) Then
         rst.Fields("INFO_PICT").AppendChunk bit
          rst.Update
        End If
    End If