form1.vb

Visual Basic 传统数据访问模式ADO

Option Explicit On
Option Strict On
Imports ADODB
Imports MSDataGridLib

Public Class Form1

    Private m_oRecordset As ADODB.Recordset
    Private m_sConnStr As String
    Private m_flgPriceUpdated As Boolean
    Private m_Table As DataTable


    Private Sub cmdGetData_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdGetData.Click

        GetData()

        If Not m_oRecordset Is Nothing Then
            If m_oRecordset.State = ObjectStateEnum.adStateOpen Then

                '设置按钮的状态
                cmdGetData.Enabled = False
                cmdExamineData.Enabled = True

            End If
        End If

    End Sub

    Private Sub GetData()

        On Error GoTo GetDataError

        m_sConnStr = "Provider='SQLOLEDB';Data Source='HZIEE-559BBB790\SQLEXPRESS';" & _
                    "Initial Catalog='SuperMarket';Integrated Security='SSPI';"

        '实例化Connection类并打开Connection对象
        Dim oConnection1 As Connection = New Connection
        oConnection1.CursorLocation = CursorLocationEnum.adUseClient
        oConnection1.Open(m_sConnStr)

        Dim sSQL As String = "SELECT 编号, 名称, 产地, 价格 " & _
                 "FROM Product"

        '实例化并打开Recordset对象
        m_oRecordset = New Recordset
        m_oRecordset.Open(sSQL, oConnection1, CursorTypeEnum.adOpenStatic, _
                            LockTypeEnum.adLockBatchOptimistic, CommandTypeEnum.adCmdText)

        m_oRecordset.MarshalOptions = MarshalOptionsEnum.adMarshalModifiedOnly

        '断开Recordset连接
        m_oRecordset.ActiveConnection = Nothing
        oConnection1.Close()
        oConnection1 = Nothing

        '把数据源绑定到DataGrid控件上
        grdDisplay1.DataSource = CType(m_oRecordset, msdatasrc.DataSource)

        Exit Sub

GetDataError:
        If Err.Number <> 0 Then

            Dim Msg As String = "Error # " & Str(Err.Number) & " was generated by " _
       & Err.Source & ControlChars.CrLf & Err.Description
            MsgBox(Msg, MsgBoxStyle.Information, "错误")

        End If

        If Not oConnection1 Is Nothing Then
            If oConnection1.State = ConnectionState.Open Then
                oConnection1.Close()
            End If
            oConnection1 = Nothing
        End If
    End Sub

    Private Sub cmdExamineData_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdExamineData.Click

        ExamineData()
        '设置按钮的状态，用户只能执行一次“显示信息”按钮
        cmdExamineData.Enabled = False
        cmdEditData.Enabled = True

    End Sub

    Private Sub ExamineData()

        On Error GoTo ExamineDataErr

        Dim vBookmark As Object = Nothing

        Dim iNumRecords As Integer = m_oRecordset.RecordCount

        DisplayMsg("当前记录集中共有 " & CStr(iNumRecords) & _
                    " 条记录。")

        '遍历Recordset打印Recordset的AbsolutePosition的属性值.
        DisplayMsg("****** 开始绝对位置遍历 ******")

        Do While Not m_oRecordset.EOF
            ' 为了后面显示这条记录，现在把它保存到vBookmark中
            If m_oRecordset.AbsolutePosition = 3 Then _
                vBookmark = m_oRecordset.Bookmark

            DisplayMsg(CType(m_oRecordset.AbsolutePosition, String))

            m_oRecordset.MoveNext()
        Loop

        DisplayMsg("****** 结束绝对位置遍历 ******" & vbCrLf)

        '使用我们设置的bookmark返回第三条记录.
        m_oRecordset.Bookmark = vBookmark
        MsgBox(vbCr & "使用书签返回到位置 " & _
                m_oRecordset.AbsolutePosition, , _
                "数据操作")

        '显示所有字段的元数据
        WalkFields()

        '设置过滤器
        MsgBox("过滤器为 (产地='北京')", _
                vbOKOnly, "数据操作")

        m_oRecordset.Filter = "产地='北京'"

        Exit Sub

ExamineDataErr:
        HandleErrs("数据检查", CType(m_oRecordset.ActiveConnection, Connection))
    End Sub

    Private Sub WalkFields()

        On Error GoTo WalkFieldsErr

        Dim iFldCnt As Integer
        Dim oFields As Fields
        Dim oField As Field
        Dim sMsg As String

        oFields = m_oRecordset.Fields

        DisplayMsg("****** 遍历字段开始******")

        For iFldCnt = 0 To (oFields.Count - 1)
            oField = oFields(iFldCnt)
            sMsg = ""
            sMsg = sMsg & oField.Name
            sMsg = sMsg & vbTab & "类型： " & GetTypeAsString(oField.Type)
            sMsg = sMsg & vbTab & "定义大小： " & oField.DefinedSize
            sMsg = sMsg & vbTab & "实际大小： " & oField.ActualSize

            grdDisplay1.SelStartCol = CType(iFldCnt, Short)
            grdDisplay1.SelEndCol = CType(iFldCnt, Short)
            DisplayMsg(sMsg)
            MsgBox(sMsg, , "数据操作")
        Next iFldCnt

        DisplayMsg("****** 遍历字段结束******" & vbCrLf)

        '清除
        oField = Nothing
        oFields = Nothing
        Exit Sub

WalkFieldsErr:
        oField = Nothing
        oFields = Nothing

        If Err.Number <> 0 Then
            MsgBox(Err.Source & "-->" & Err.Description, , "错误")
        End If
    End Sub

    Private Function GetTypeAsString(ByVal dtType As DataTypeEnum) As String

        '得到数据类型的名称
        Dim str As String = Nothing
        Select Case dtType
            Case DataTypeEnum.adChar
                str = "adChar"
            Case DataTypeEnum.adVarChar
                str = "adVarChar"
            Case DataTypeEnum.adVarWChar
                str = "adVarWChar"
            Case DataTypeEnum.adCurrency
                str = "adCurrency"
            Case DataTypeEnum.adInteger
                str = "adInteger"
        End Select

        Return str

    End Function

    Private Sub HandleErrs(ByVal sSource As String, ByRef m_oConnection As ADODB.Connection)
        DisplayMsg(sSource & "中ADO (OLE) 错误 ")
        DisplayMsg(vbTab & "错误号： " & Err.Number)
        DisplayMsg(vbTab & "描述： " & Err.Description)
        DisplayMsg(vbTab & "源： " & Err.Source)

        If Not m_oConnection Is Nothing Then
            If m_oConnection.Errors.Count <> 0 Then
                DisplayMsg("数据提供者错误")
                Dim oError1 As ADODB.Error
                For Each oError1 In m_oConnection.Errors
                    DisplayMsg(vbTab & "错误号： " & oError1.Number)
                    DisplayMsg(vbTab & "描述： " & oError1.Description)
                    DisplayMsg(vbTab & "源： " & oError1.Source)
                    DisplayMsg(vbTab & "本地错误：" & oError1.NativeError)
                    DisplayMsg(vbTab & "SQL状态： " & oError1.SQLState)
                Next oError1
                m_oConnection.Errors.Clear()
                oError1 = Nothing
            End If
        End If

        MsgBox("错误的详细信息参看txtDisplay1控件。", , _
               "数据操作")

        Err.Clear()
    End Sub

    Private Sub DisplayMsg(ByVal sText As String)
        txtDisplay1.Text = (txtDisplay1.Text & vbCrLf & sText)
    End Sub

    Private Sub cmdEditData_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdEditData.Click

        EditData()
        '设置按钮的状态
        cmdEditData.Enabled = False
        cmdUpdateData.Enabled = True

    End Sub

    Private Sub EditData()

        On Error GoTo EditDataErr

        '北京的产品价格增加１０％
        MsgBox("对于所有 产地 =‘北京’的记录，价格增长10%" & vbCr _
            , , "数据操作")

        m_oRecordset.MoveFirst()

        Dim cVal As Decimal
        Do While Not m_oRecordset.EOF
            cVal = CType(m_oRecordset.Fields("价格").Value, Decimal)
            m_oRecordset.Fields("价格").Value = (cVal * 1.1)
            m_oRecordset.MoveNext()
        Loop

        Exit Sub

EditDataErr:
        HandleErrs("编辑数据", CType(m_oRecordset.ActiveConnection, Connection))
    End Sub

    Private Sub cmdUpdateData_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdUpdateData.Click

        UpdateData()

        '使更新按钮失效
        cmdUpdateData.Enabled = False

    End Sub

    Private Sub UpdateData()
        On Error GoTo UpdateDataErr

        Dim oConnection2 As New ADODB.Connection

        MsgBox("删除过滤器(adFilterNone)。", , "数据操作")
        m_oRecordset.Filter = FilterGroupEnum.adFilterNone

        'grdDisplay1.DataSource = Nothing
        grdDisplay1.DataSource = CType(m_oRecordset, msdatasrc.DataSource)

        MsgBox("应用过滤器(adFilterPendingRecords)。", , "数据操作")
        m_oRecordset.Filter = FilterGroupEnum.adFilterPendingRecords

        grdDisplay1.DataSource = Nothing
        grdDisplay1.DataSource = CType(m_oRecordset, msdatasrc.DataSource)

        DisplayMsg("*** 更新数据前‘价格’字段的值 ***")

        ' 显示第一条记录的初始值和当前值
        If m_oRecordset.Supports(CursorOptionEnum.adMovePrevious) Then
            m_oRecordset.MoveFirst()
            DisplayMsg("初始值   = " & _
                m_oRecordset.Fields("价格").OriginalValue.ToString())
            DisplayMsg("当前值           = " & _
                m_oRecordset.Fields("价格").Value.ToString())
        End If

        oConnection2.ConnectionString = m_sConnStr
        oConnection2.Open()

        m_oRecordset.ActiveConnection = oConnection2
        m_oRecordset.UpdateBatch()

        m_flgPriceUpdated = True

        DisplayMsg("*** 更新数据后‘价格’字段的值 ***")

        If m_oRecordset.Supports(CursorOptionEnum.adMovePrevious) Then
            m_oRecordset.MoveFirst()
            DisplayMsg("初始值   = " & _
                m_oRecordset.Fields("价格").OriginalValue.ToString())
            DisplayMsg("当前值           = " & _
                m_oRecordset.Fields("价格").Value.ToString())
        End If

        MsgBox("请和txtDisplay1里的值进行比较。", , _
               "数据操作")

        'Clean up
        oConnection2.Close()
        oConnection2 = Nothing
        Exit Sub

UpdateDataErr:
        If Err.Number <> 0 Then
            HandleErrs("数据更新", oConnection2)
        End If

        If Not oConnection2 Is Nothing Then
            If oConnection2.State = ConnectionState.Open Then oConnection2.Close()
            oConnection2 = Nothing
        End If
    End Sub


    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        m_Table = New DataTable

        cmdGetData.Enabled = True
        cmdExamineData.Enabled = False
        cmdEditData.Enabled = False
        cmdUpdateData.Enabled = False

        grdDisplay1.AllowAddNew = False
        grdDisplay1.AllowDelete = False
        grdDisplay1.AllowUpdate = False
        m_flgPriceUpdated = False

    End Sub

    Private Sub Form1_Unload(ByVal Cancel As Integer)

    End Sub


    Private Sub Form1_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
        'On Error GoTo ErrHandler

        Dim oConnection3 As New ADODB.Connection
        Dim sSQL As String
        Dim lAffected As Object = New Object

        '取消我们所做的改变
        If m_flgPriceUpdated Then
            sSQL = "UPDATE Product SET 价格 = 价格/1.1 " & _
                "WHERE 产地 like '北京'"

            oConnection3.Open(m_sConnStr)
            oConnection3.Execute(sSQL, lAffected, CommandType.Text)

            MsgBox("恢复原来价格，共有 " & CStr(lAffected) & _
                " 记录受影响。", , "数据操作")
        End If

        '清除
        m_oRecordset.Close()
        'm_oRecordset = Nothing

        oConnection3.Close()
        oConnection3 = Nothing
        Exit Sub

ErrHandler:

        If Not oConnection3 Is Nothing Then
            If oConnection3.State = ConnectionState.Open Then oConnection3.Close()
            oConnection3 = Nothing
        End If
        If Not m_oRecordset Is Nothing Then
            If m_oRecordset.State = ConnectionState.Open Then m_oRecordset.Close()
            m_oRecordset = Nothing
        End If
    End Sub
End Class