VB6将文件保存到数据库中

一卡通产品介绍：首页-一卡通设备批发-淘宝网淘宝, 店铺, 旺铺, 一卡通设备批发https://shop73172356.taobao.com/

将图片文件保存到MSSQL数据库的Image类型

Private Sub Image1_DblClick()
On Error GoTo OpenCancel
Dim rst As New ADODB.Recordset
Dim bytedata() As Byte
Dim NumBlocks As Long
Dim FileLength As Long
Dim LeftOver As Long
Dim SourceFile As Long
Const Blocksize = 4096
Dim i As Long
Dim answ As Long

If Trim(Text4.Text) <> "" Then
    rst.CursorLocation = adUseClient
    rst.Open "select * from zg where zgbh='" & Trim(Text4.Text) & "'", cn, adOpenDynamic, adLockOptimistic
    If rst.RecordCount > 0 Then
        ComDialog.Filter = "JPG文件  (*.jpg)|*.jpg|BMP文件  (*.bmp)|*.bmp|GIF文件  (*.gif)|*.gif|所有文件 *.*|*.*"
        ComDialog.InitDir = App.Path & "\"
        ComDialog.ShowOpen
        If Trim(ComDialog.filename) <> "" Then
            Image1.Picture = LoadPicture(Trim(ComDialog.filename))
            SourceFile = FreeFile
            Open Trim(ComDialog.filename) For Binary Access Read As SourceFile
            FileLength = LOF(SourceFile)
            If FileLength = 0 Then
               Close SourceFile
            Else
               answ = MsgBox("是否要保存当前的相片？", vbQuestion + vbOKCancel, "提示：")
               If answ = vbOK Then
                    NumBlocks = FileLength \ Blocksize
                    LeftOver = FileLength Mod Blocksize
                    ReDim bytedata(Blocksize)
                    For i = 1 To NumBlocks
                        Get SourceFile, , bytedata()
                        rst.Fields("phon").AppendChunk bytedata()
                    Next i
                    ReDim bytedata(LeftOver)
                    Get SourceFile, , bytedata()
                    rst.Fields("phon").AppendChunk bytedata()
                    Close SourceFile
                    rst.Update
               Else
                    Close SourceFile
                    Image1.Picture = LoadPicture("")
               End If
            End If
        End If
    End If
Else
    MsgBox "请先选择一位持卡人后，再为其选择保存相片！", vbCritical, "提示："
End If
Exit Sub
OpenCancel:

End Sub

读取MSSql数据库的Image字段中的图片文件并显示 

Private Sub dispphon()
On Error GoTo OpenCancel
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
rst.Open "select * from zg where zgbh='" & Trim(Text4.Text) & "'", cn, adOpenDynamic, adLockOptimistic
Image1.Picture = LoadPicture("")
If Not IsNull(rst.Fields("phon")) Then
   Dim stm As ADODB.Stream
   Set stm = New ADODB.Stream
   stm.Type = adTypeBinary
   stm.Open
   stm.Write rst.Fields("phon").Value
   stm.SaveToFile App.Path & "\temp.jpg", adSaveCreateOverWrite
   stm.Close
   Set stm = Nothing
   Image1.Picture = LoadPicture(App.Path & "\temp.jpg")
   Exit Sub
Else
   Image1.Picture = Image3.Picture
End If
Exit Sub
OpenCancel:
   stm.Close
   Set stm = Nothing
End Sub

将文件保存到MYSQL数据库的MediumBlob类型

Public Sub UpFile(ByVal Upfilestr As String, fileid As Integer)
Dim FilName As String
Dim thiscn As New ADODB.Connection
Dim mysqlstor As New ADODB.Command
Dim newid As Long

Dim bytedata() As Byte
Dim NumBlocks As Long
Dim FileLength As Long
Dim LeftOver As Long
Dim SourceFile As Long
Const Blocksize = 4096

On Error GoTo err1
DoEvents

FilName = Upfilestr    

thiscn.Open thiscnstr
If thiscn.State = 1 Then
      If Len(Dir(FilName)) > 0 Then
            Dim fver As String
            Dim fso As FileSystemObject
            Set fso = New FileSystemObject
            fver = fso.GetFileVersion(FilName)      '获得现在文件的版本号
        
            Dim rst As New ADODB.Recordset
            rst.CursorLocation = adUseClient
            rst.Open "select Id,FileSize,FileInfoBit,FileVer from prtscsys where id=" & fileid, thiscn, adOpenDynamic, adLockOptimistic
            If rst.RecordCount > 0 Then
                  GetFileNum = FreeFile
                  Open FilName For Binary Access Read As GetFileNum
                  FileLength = LOF(GetFileNum)
                  If FileLength = 0 Then
                     Close GetFileNum
                  Else
                     NumBlocks = FileLength \ Blocksize
                     LeftOver = FileLength Mod Blocksize
                     ReDim bytedata(Blocksize)
                     For i = 1 To NumBlocks
                          Get GetFileNum, , bytedata()
                          rst.Fields("FileInfoBit").AppendChunk bytedata()
                     Next i
                     ReDim bytedata(LeftOver)
                     Get GetFileNum, , bytedata()
                     rst.Fields("FileInfoBit").AppendChunk bytedata()
                     rst.Fields("FileSize") = FileLength
                     rst.Fields("FileVer") = fver
                     rst.Update
                     Close GetFileNum
                  End If
            End If
      End If
      thiscn.Close
End If
Exit Sub

err1:
  thiscn.Close
  Close GetFileNum
End Sub

读取保存在MYSQL数据库MediumBlob字段内的文件 

Public Sub DownFile(ByVal fileid As Integer)
Dim thiscn As New ADODB.Connection
Dim Length As Long

Dim WinHandle
Dim SendInf As String
Dim qqWindow As String * 26
Dim ParHandle As Long
Dim Ustr As String
Dim myClassName As String 

On Error GoTo err1

DoEvents
thiscn.Open thiscnstr
If thiscn.State = 1 Then
    Dim rst As New ADODB.Recordset
    rst.CursorLocation = adUseClient
    DoEvents
    rst.Open "select FileInfoBit from  prtscsys where Id=" & fileid, thiscn, adOpenDynamic, adLockOptimistic
    If Not IsNull(rst.Fields("FileInfoBit")) Then
       Dim stm As ADODB.Stream
       Set stm = New ADODB.Stream
       stm.Type = adTypeBinary
       stm.Open
       stm.Write rst.Fields("FileInfoBit").Value
       
       If fileid = 1 Then
            stm.SaveToFile runexefile, adSaveCreateOverWrite
       ElseIf fileid = 2 Then
            stm.SaveToFile jianchfile, adSaveCreateOverWrite
       End If
       
       stm.Close
       Set stm = Nothing
    End If
    
    thiscn.Close
End If

Exit Sub

err1:
    thiscn.Close
End Sub