form1.frm

将二进制文件存入数据库实例 名称文件保存到数据库

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "将二进制文件存入数据库实例"
   ClientHeight    =   1605
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4335
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1605
   ScaleWidth      =   4335
   StartUpPosition =   3  '窗口缺省
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   210
      Top             =   1050
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdSave2DB 
      Caption         =   "保存到数据库"
      Height          =   330
      Left            =   2520
      TabIndex        =   5
      Top             =   1155
      Width           =   1695
   End
   Begin VB.CommandButton Command1 
      Caption         =   "..."
      Height          =   330
      Left            =   3780
      TabIndex        =   4
      Top             =   630
      Width           =   435
   End
   Begin VB.TextBox Text2 
      Height          =   270
      Left            =   1050
      TabIndex        =   3
      Top             =   630
      Width           =   2640
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   1050
      TabIndex        =   2
      Top             =   210
      Width           =   2640
   End
   Begin VB.Label Label2 
      Caption         =   "文件："
      Height          =   225
      Left            =   210
      TabIndex        =   1
      Top             =   630
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "名称："
      Height          =   225
      Left            =   210
      TabIndex        =   0
      Top             =   210
      Width           =   750
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'使用AppendChunk方法将二进制文件数据存入数据库实例
Const BLOCKSIZE = 4096
Private Sub SaveToDB(ByRef Fld 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
    '判断文件是否存在
    If Dir(DiskFile) <> "" Then
        SourceFile = FreeFile
        '打开二进制文件
        Open DiskFile For Binary Access Read As SourceFile
        FileLength = LOF(SourceFile)
        '判断文件是否空
        If FileLength = 0 Then
            Close SourceFile
            MsgBox DiskFile & "文件无内容，请重新指定文件！", vbExclamation, "注意"
        Else
            '得到数据块的个数
            NumBlocks = FileLength \ BLOCKSIZE
            '得到剩余字节数
            LeftOver = FileLength Mod BLOCKSIZE
            Fld.Value = Null
            ReDim byteData(BLOCKSIZE)
            For i = 1 To NumBlocks
                Get SourceFile, , byteData()
                '用Appendchunk方法将byteData()数据写入FLD
                Fld.AppendChunk byteData()
                DoEvents
            Next i
            '将剩余数据写入FLD
            ReDim byteData(LeftOver)
            Get SourceFile, , byteData()
            Fld.AppendChunk byteData()
            Close SourceFile
        End If
    Else
        MsgBox "文件不存在，请重新指定文件！", vbExclamation, "注意"
    End If
End Sub
Private Function GetFileName() As String
    
    CommonDialog1.CancelError = True
On Error GoTo CancelErr
    CommonDialog1.Filter = "所有文件(*.*)|*.*"
    CommonDialog1.ShowOpen
    GetFileName = CommonDialog1.FileName
    Exit Function
CancelErr:
    GetFileName = ""
    
End Function
Private Sub cmdSave2DB_Click()
    Call Save2DB
End Sub
Private Sub Save2DB()
    '建立一个ADO数据连接
    Dim DataConn As New ADODB.Connection
    Dim DataRec As New ADODB.Recordset
    Dim strSQL As String
    
'若数据库连接出错，则转向ConnectionERR
On Error GoTo ConnectionERR
    
    '建立一个连接字串
    '这个连接串可能根据数据库配置的不同而不同
    DataConn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;"
    DataConn.ConnectionString = DataConn.ConnectionString & "Persist Security Info=False;"
    DataConn.ConnectionString = DataConn.ConnectionString & "Initial Catalog=tempdb;"
    DataConn.ConnectionString = DataConn.ConnectionString & "Data Source=localhost"
    '建立数据库连接
    DataConn.Open
    
'若RecordSet建立出错，则转向RecordsetERR
On Error GoTo RecordSetERR
    
    strSQL = "SELECT * FROM Temp "
    DataRec.Open strSQL, DataConn, adOpenDynamic, adLockOptimistic
    If DataRec.EOF Then DataRec.AddNew
    
On Error GoTo OtherERR
    
    DataRec.Fields("Name").Value = Text1.Text
    Call SaveToDB(DataRec.Fields("Binary"), Text2.Text)
    DataRec.Update
    Exit Sub

ConnectionERR:
    '错误处理程序
    MsgBox "数据库连接错误，" & Err.Description, vbCritical, "出错"
    Exit Sub
    
RecordSetERR:
    MsgBox "RecordSet生成错误，" & Err.Description, vbCritical, "出错"
    DataConn.Close
    Exit Sub
    
OtherERR:
    MsgBox "其他错误，" & Err.Description, vbCritical, "出错"
    
    DataRec.Close
    DataConn.Close
End Sub

Private Sub Command1_Click()
    Text2.Text = GetFileName
End Sub