发布时间:2016-12-9 0:10:13 编辑:www.fx114.net 分享查询网我要评论

' 建立表 Ver 表结构为: f001 标识增量字段,f002 nvarchar(50) 文件名,f003 nvarchar(50) 版本号,f004 image 存储文件,f005 datetime 上传日期时间,f006 存储f004中exe文件的最后修改时间,以上字段均非空 ' f007 nvarchar(50)SQL文件名称 ,f008 image SQL文件 ,f009 nvarchar(50)控件文件名称,f010 image 控件文件,f011 nvarchar(50)控件注册文件名,f012 image 控件注册文件‘ '保存为文件 Public Sub SaveToFile(ByVal sFileName As String, Field As String) ' ' Export the file from the database to the passed filename ' Dim iFileNum As Integer Dim lFileLen As Long Dim lChunks As Long Dim lFragment As Long Dim bChunk() As Byte Dim lCount As Long Dim oField As Field Dim oRS As New ADODB.Recordset Const CHUNKSIZE As Long = 16384 ' internal chunksize On Error GoTo ErrorHandler ' ' Get the field from the database ' DBOpen oRS, "select * from ver where f001=(select max(f001) from ver)" If oRS.BOF Or oRS.EOF Then GoTo PROC_EXIT iFileNum = FreeFile ' ' Create the Named File ' Open sFileName For Binary Access Write As iFileNum Set oField = oRS.Fields(Field) ' ' Get the length of the file and the number of chunks required lFileLen = oField.ActualSize lFragment = lFileLen Mod CHUNKSIZE ' ' Write away the chunks to the file lChunks = 0 Do While lChunks 0 Then If Len(Trim(verNo)) = Len(Trim(rs.Fields("f003"))) Then If Trim(verNo) 4 Then .Fields("f006").value = mdteOrigDate .Update .Close End With PROC_EXIT: Exit Sub ErrorHandler: Set Res = Nothing Call ShowError("frmTransfer", "insertToTable", err.Number, err.Description, "Y") End Sub Private Function GetFileName() As String On Error GoTo vbErrorHandler If Len(CommonDialog1.InitDir) = 0 Then CommonDialog1.InitDir = App.Path End If CommonDialog1.CancelError = True CommonDialog1.DialogTitle = "文件存入数据库" CommonDialog1.FileName = "" CommonDialog1.Filter = "All Files|" & PrjName CommonDialog1.Flags = cdlOFNExplorer + cdlOFNHideReadOnly CommonDialog1.ShowOpen GetFileName = CommonDialog1.FileName Exit Function vbErrorHandler: If err.Number = 32755 Then GetFileName = "" Exit Function Else MsgBox err.Number & " " & err.Source & " " & err.Description, vbCritical, App.ProductName End If End Function Private Sub AddFile() On Error GoTo vbErrorHandler sFilename = GetFileName() Exit Sub vbErrorHandler: MsgBox err.Number & " " & err.Description & " " & err.Source & "::ctlFileDetails_AddFile" End Sub