VB6将文件保存到数据库中

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

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

Private Sub Image1_DblClick()On Error GoTo OpenCancelDim rst As New ADODB.RecordsetDim bytedata() As ByteDim NumBlocks As LongDim FileLength As LongDim LeftOver As LongDim SourceFile As LongConst Blocksize = 4096Dim i As LongDim answ As LongIf 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 IfElse    MsgBox "请先选择一位持卡人后，再为其选择保存相片！", vbCritical, "提示："End IfExit SubOpenCancel:End Sub

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

Private Sub dispphon()On Error GoTo OpenCancelDim rst As New ADODB.Recordsetrst.CursorLocation = adUseClientrst.Open "select * from zg where zgbh='" & Trim(Text4.Text) & "'", cn, adOpenDynamic, adLockOptimisticImage1.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 SubElse   Image1.Picture = Image3.PictureEnd IfExit SubOpenCancel:   stm.Close   Set stm = NothingEnd Sub

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

Public Sub UpFile(ByVal Upfilestr As String, fileid As Integer)Dim FilName As StringDim thiscn As New ADODB.ConnectionDim mysqlstor As New ADODB.CommandDim newid As LongDim bytedata() As ByteDim NumBlocks As LongDim FileLength As LongDim LeftOver As LongDim SourceFile As LongConst Blocksize = 4096On Error GoTo err1DoEventsFilName = Upfilestr    thiscn.Open thiscnstrIf 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 ThenClose GetFileNum    ElseNumBlocks = FileLength \ BlocksizeLeftOver = FileLength Mod BlocksizeReDim bytedata(Blocksize)For i = 1 To NumBlocks     Get GetFileNum, , bytedata()     rst.Fields("FileInfoBit").AppendChunk bytedata()Next iReDim bytedata(LeftOver)Get GetFileNum, , bytedata()rst.Fields("FileInfoBit").AppendChunk bytedata()rst.Fields("FileSize") = FileLengthrst.Fields("FileVer") = fverrst.UpdateClose GetFileNum    End If     End If      End If      thiscn.CloseEnd IfExit Suberr1:  thiscn.Close  Close GetFileNumEnd Sub

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

Public Sub DownFile(ByVal fileid As Integer)Dim thiscn As New ADODB.ConnectionDim Length As LongDim WinHandleDim SendInf As StringDim qqWindow As String * 26Dim ParHandle As LongDim Ustr As StringDim myClassName As String On Error GoTo err1DoEventsthiscn.Open thiscnstrIf 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")) ThenDim stm As ADODB.StreamSet stm = New ADODB.Streamstm.Type = adTypeBinarystm.Openstm.Write rst.Fields("FileInfoBit").ValueIf fileid = 1 Then     stm.SaveToFile runexefile, adSaveCreateOverWriteElseIf fileid = 2 Then     stm.SaveToFile jianchfile, adSaveCreateOverWriteEnd Ifstm.CloseSet stm = Nothing    End If thiscn.CloseEnd IfExit Suberr1:    thiscn.CloseEnd Sub