谁能告诉我，怎么将图片存在sql server中，然后在取出来。

Question

存文件到数据库
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 Function
ErrorHandle:
    AddFile = False
End 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 Sub
ErrorHandle:
    
End Sub

Answer 1

Const BLOCKSIZE = 4096 '每次读写块的大小
Private Sub SaveToDB(ByRef fld As ADODB.Field, diskfile As String) 'diskfile图片路径，fld 存放图片的字段
    Dim byteData() As Byte '定义数据块数组
    Dim NumBlocks As Long '定义数据块个数
    Dim FileLength As Long '标识文件长度
    Dim LeftOver As Long '定义剩余字节长度
    Dim SourceFile As Long '定义自由文件号
    Dim i As Long '定义循环变量
    SourceFile = FreeFile '提供一个尚未使用的文件号
On Error GoTo err:    Open diskfile For Binary Access Read As SourceFile '打开文件
    FileLength = LOF(SourceFile) '得到文件长度
    If FileLength = 0 Then '判断文件是否存在
      Close SourceFile
      MsgBox diskfile & " 无 内 容 或 不 存 在 !"
    Else
      NumBlocks = FileLength \ BLOCKSIZE '得到数据块的个数
      LeftOver = FileLength Mod BLOCKSIZE '得到剩余字节数
      fld.Value = Null
      ReDim byteData(BLOCKSIZE) '重新定义数据块的大小
      For i = 1 To NumBlocks
        Get SourceFile, , byteData() ' 读到内存块中
        fld.AppendChunk byteData() '写入FLD
      Next i
       ReDim byteData(LeftOver) '重新定义数据块的大小
       Get SourceFile, , byteData() '读到内存块中
      fld.AppendChunk byteData() '写入FLD
       Close SourceFile '关闭源文件
    End If
    Exit Sub
err:
 MsgBox err.Number & "        " & err.Description
End Sub
Private Sub GetFromDb(PFld As ADODB.Field, diskfile As String)
    Dim byteData() As Byte '定义数据块数组
    Dim NumBlocks As Long '定义数据块个数
    Dim FileLength As Long '标识文件长度
    Dim LeftOver As Long '定义剩余字节长度
    Dim SourceFile As Long '定义自由文件号
    Dim i As Long '定义循环变量
    
On Error GoTo err:
    FileLength = PFld.ActualSize
    NumBlocks = FileLength \ BLOCKSIZE '得到数据块的个数
    LeftOver = FileLength Mod BLOCKSIZE '得到剩余字节数
    SourceFile = FreeFile '提供一个尚未使用的文件号
    
    Open diskfile For Binary As SourceFile
              ReDim byteData(BLOCKSIZE)
                For i = 1 To NumBlocks
                    byteData(i) = PFld.GetChunk(BLOCKSIZE)
                    Put SourceFile, , byteData(i)
                Next
                
                If LeftOver <> 0 Then
                    ReDim btyBlock(LeftOver)
                    
                    byteData() = PFld.GetChunk(LeftOver)
                    Put SourceFile, , byteData()
                End If
    Close SourceFile
    Exit Sub
err:
    MsgBox err.Number & "        " & err.Description
End Sub