如何保存图片于数据库中？

Question

在MSDN中查AppendChunk和GetChunk或在CSDN查以前的贴 ^_^

Answer 1

Sub save_picture(ByVal Mypicture As String)  'Picture的路径
Dim cnn As New ADODB.Connection
Dim rst1 As Recordset
  Dim bit() As Byte   Set rst1 = adoconnect3("db2.mdb", "表1", "*", "")
    
    'If Not (rst1.EOF And rst1.BOF) Then
       If Mypicture = "" Then
        '    然后将字节数组的内容写入数据库即可
            rst1.Fields("Picture") = ""
            rst1.UpdateBatch
       Else
            Open Mypicture For Binary As #1
            ReDim bit(LOF(1)) As Byte
            Get 1, 1, bit
            Close 1
         '    然后将字节数组的内容写入数据库即可
         rst1.AddNew
         rst1.Fields("Picture").AppendChunk bit
         rst1.Fields("Name") = "姓名"
         rst1.UpdateBatch
       End If
    'End If
End Sub

Answer 2

将字段设成长二进制，用AppendChunk和GetChunk存取。
保存路径也可以，但一旦文件移动位置就麻烦了。

Answer 3

用ADO存放文件到数据库Binary字段
存文件到数据库Public Function AddFile() As Boolean    'Return boolean to decide whether refresh files list    Dim strBin As String * 3000    Dim btyGet() As Byte    Dim lngBlockIndex As Long    Dim lngBlocks As Long    Dim lngLastBlock As Long    Dim lngPosition As Long    Dim lngFileLenth As Long    Dim lngIndex As Long        With frmBinary.CommonDialog1        '.InitDir = App.Path        .Filter = "All image files|*.bmp;*.ico;*.jpg;*.gif|Bitmap files|*.bmp|Icon files|*.ico|All files|*.*"        .FileName = ""        On Error GoTo ErrorHandle        .ShowOpen        On Error GoTo 0        If .FileName <> "" Then            Open .FileName For Binary As #1            lngFileLenth = LOF(1)                        lngPosition = 0                        'Get block count for loop            lngBlocks = lngFileLenth \ BlockSize                        'Get lngth of last block for the last read            lngLastBlock = lngFileLenth Mod BlockSize                        rsBinary.AddNew            rsBinary.Fields("typecode") = TypeCode                        For lngBlockIndex = 1 To lngBlocks                ReDim btyGet(BlockSize)                Get #1, , btyGet()                rsBinary.Fields("content").AppendChunk btyGet()                lngPosition = lngPosition + BlockSize            Next            If lngLastBlock > 0 Then                ReDim btyGet(lngLastBlock)                Get #1, , btyGet()                rsBinary.Fields("content").AppendChunk btyGet()            End If                        rsBinary.Update            Close #1                        AddFile = True            MsgBox "Save finished", vbInformation        Else            AddFile = False        End If    End With    Exit FunctionErrorHandle:    AddFile = FalseEnd Function从数据库取文件出来Public Sub SaveFile(ByVal FileID As Long)    Dim lngBlockCount As Long    Dim lngLastBlock As Long    Dim lngI As Long    Dim btyBlock() As Byte    Dim lngResult As Long        If rsBinary.EOF And rsBinary.BOF Then Exit Sub    rsBinary.MoveFirst    rsBinary.Find " id=" & FileID    If Not rsBinary.EOF Then        With frmBinary.CommonDialog1            .FileName ="TempSave"            '.InitDir = App.Path                        'If user cancel save the goto handle            On Error GoTo ErrorHandle            .ShowSave            If .FileName <> "" Then                lngBlockCount = rsBinary.Fields("content").ActualSize \ BlockSize                lngLastBlock = rsBinary.Fields("content").ActualSize Mod BlockSize                                If Dir(.FileName) <> "" Then                    If MsgBox("File " & .FileName & " is exist,overwrite?", vbYesNo + vbQuestion) = vbYes Then                        Kill .FileName                    Else                        Exit Sub                    End If                Else                End If                                    Open .FileName For Binary As #1                                ReDim btyBinary(BlockSize)                                For lngI = 1 To lngBlockCount                    btyBlock() = rsBinary.Fields("content").GetChunk(BlockSize)                    Put #1, , btyBlock                Next                                If lngLastBlock <> 0 Then                    ReDim btyBlock(lngLastBlock)                    btyBlock() = rsBinary.Fields("content").GetChunk(lngLastBlock)                    Put #1, , btyBlock                End If                                Close #1                MsgBox .FileName & " is saved", vbInformation            Else            End If        End With    End If        Exit SubErrorHandle:    End Sub