dbpack_sample.bas

数据库连接封装控件 可以连接Access

Attribute VB_Name = "DBPack_Sample"
Option Explicit

Private Sub TestRecord()
    Dim objTest As New DBPool
    If Not objTest.ConnectDB Then Exit Sub
    objTest.Record.AddField "ID"
    objTest.Record.AddField "Product"
    objTest.Record.AddNew
    objTest.Record.value("ID") = 12
    objTest.Record.value("product") = "test1"
    objTest.Record.AddNew
    objTest.Record.value("ID") = 0
    objTest.Record.value("product") = "Test2"
    objTest.Record.TableName = "Products"
    objTest.BeginTrans
    If objTest.Record.Save Then
        If MsgBox("是否要保存更改到数据库", vbYesNo) = vbYes Then
            objTest.CommitTrans
        Else
            objTest.RollbackTrans
        End If
        
    End If
    objTest.CommitTrans
End Sub

Private Sub TestDBPool()
    '要运行该模块,请在工程中引用DBPACK.DLL,然后在对应连接的数据库里建一张名为Products的表,
    '包含字段ID(Identify col),Product(varchar)

    Dim DBPoolTest As New DBPack.DBPool, var As Variant, varField(1) As Variant

    '定义字段集合数组
    varField(0) = "ID"
    varField(1) = "Product"

    '取得一个数组
    var = DBPoolTest.ExecuteSQL("Select * From Product", ReturnArray)

    '开始一个事务
    DBPoolTest.BeginTrans

    '以下演示如何新增,插入,删除一张表的的某条记录,可熟练使用数组灵活定位记录

    '插入记录的操作
    If IsArray(var) Then
        ReDim Preserve var(1, UBound(var, 2) + 1) As Variant
    Else
        ReDim var(1, 0) As Variant
    End If
    var(0, UBound(var, 2)) = 0
    var(1, UBound(var, 2)) = InputBox("This test insert one record,Pls input product name.")

    If DBPoolTest.Save(var, varField, 1, "Products") Then
        MsgBox "插入一条记录成功"
    Else
        MsgBox "错误描述:" & DBPoolTest.ErrDescription & vbCrLf & "错误号:" & DBPoolTest.ErrNo

    End If

    '修改记录
    var = DBPoolTest.ExecuteSQL("Select * From Products", 2)

    If IsArray(var) Then
        var(1, UBound(var, 2)) = InputBox("Input new name of product:" & var(1, UBound(var, 2)))

        If DBPoolTest.Save(var, varField, 1, "Products") Then
            MsgBox "修改一条记录成功"
        Else
            MsgBox "错误描述:" & DBPoolTest.ErrDescription & vbCrLf & "错误号:" & DBPoolTest.ErrNo
        End If

    End If

    '删除记录
    var = DBPoolTest.ExecuteSQL("Select * From Products", 2)
    If IsArray(var) Then
        If MsgBox("Do you want to delete product:" & var(1, UBound(var, 2)) & "?", vbYesNo) = vbYes Then
            var(0, UBound(var, 2)) = -1
            var(1, UBound(var, 2)) = "This test Delete one record"
            If DBPoolTest.Save(var, varField, 1, "Products") Then
                MsgBox "删除一条记录成功"
            Else
                MsgBox "错误描述:" & DBPoolTest.ErrDescription & vbCrLf & "错误号:" & DBPoolTest.ErrNo
            End If
        End If
    End If

    '提交或回滚事务
    If MsgBox("是否保存到数据库?", vbYesNo) = vbYes Then
        DBPoolTest.CommitTrans
    Else
       DBPoolTest.RollbackTrans
    End If
End Sub