formwiz.frm

关于VB模块的

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "RDO数据库应用程序"
   ClientHeight    =   5040
   ClientLeft      =   60
   ClientTop       =   348
   ClientWidth     =   4344
   LinkTopic       =   "Form1"
   ScaleHeight     =   5040
   ScaleWidth      =   4344
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame1 
      Height          =   4095
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   4095
      Begin VB.TextBox Text_Top 
         Height          =   285
         Left            =   960
         TabIndex        =   0
         Top             =   600
         Width           =   2415
      End
      Begin VB.TextBox Text_Bot 
         Height          =   285
         IMEMode         =   3  'DISABLE
         Left            =   960
         PasswordChar    =   "*"
         TabIndex        =   2
         Top             =   1800
         Width           =   2415
      End
      Begin VB.TextBox Text_Mid 
         Height          =   285
         Left            =   960
         TabIndex        =   1
         Top             =   1200
         Width           =   2415
      End
      Begin VB.ListBox List1 
         Height          =   1584
         Left            =   120
         TabIndex        =   8
         Top             =   240
         Width           =   3855
      End
      Begin VB.Label Label_Top 
         Caption         =   "Server"
         Height          =   255
         Left            =   960
         TabIndex        =   11
         Top             =   360
         Width           =   2415
      End
      Begin VB.Label Label_Bot 
         Caption         =   "Password"
         Height          =   255
         Left            =   960
         TabIndex        =   10
         Top             =   1560
         Width           =   2415
      End
      Begin VB.Label Label_Mid 
         Caption         =   "Login ID"
         Height          =   255
         Left            =   960
         TabIndex        =   9
         Top             =   960
         Width           =   2415
      End
      Begin VB.Label Label2 
         BackColor       =   &H8000000E&
         BorderStyle     =   1  'Fixed Single
         Height          =   1695
         Left            =   120
         TabIndex        =   7
         Top             =   2280
         Width           =   3855
      End
      Begin VB.Label Label1 
         BackColor       =   &H8000000E&
         BorderStyle     =   1  'Fixed Single
         Height          =   1935
         Left            =   120
         TabIndex        =   6
         Top             =   240
         Width           =   3855
      End
   End
   Begin VB.CommandButton Command_Cancel 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2280
      TabIndex        =   5
      Top             =   4560
      Width           =   1215
   End
   Begin VB.CommandButton Command_Next 
      Caption         =   "Next-->"
      Height          =   375
      Left            =   720
      TabIndex        =   3
      Top             =   4560
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim en As rdoEnvironment
Dim en2 As rdoEnvironment
Dim cn As rdoConnection
Dim cn2 As rdoConnection
Dim rsA As rdoResultset

Dim sServer As String
Dim sLoginID As String
Dim sPassword As String

Dim nState As Integer

' Displayed by Form_load
Const sCase0_UpperText = "这个程序将演示如何使用RDO编写数据库应用程序！"
Const sCase0_LowerText = "下一步将创建rdoEnvironment对象！"

'Displayed by The Next Click
Const sCase1_LowerText = "创建rdoEnvironment对象成功，下一步将创建第二个rdoEnvironment对象"

Const sCase2_UpperText = "创建第二个rdoEnvironment对象成功."
Const sCase2_LowerText = "下一步将通过DSN连接到数据库！"

Const sCase3_LowerText = "通过DSN连接到数据库成功，下一步将不通过DSN连接到数据库！"

Const sCase4_UpperText = "不通过DSN连接到数据库成功！"
Const sCase4_LowerText = "下一步创建rdoResultset对象."

Const sCase5_LowerText = "下一步将用SQL语句创建一个rdoResultset对象！ "

Const sCase6_LowerText = "输入CA、WA或者UT来创建一个rdoResultset对象！"

Const sCase7_LowerText = "创建rdoResultset对象成功，下一步将创建表department"

Const sCase8_UpperText = "创建department表成功."
Const sCase8_LowerText = "下一步创建keyset游标类型的rdoResultset对象，并添加50条记录."

Const sCase9_UpperText = "添加纪录成功."
Const sCase9_LowerText = "下一步将更新50条记录."

Const sCase10_UpperText = "更新50条记录成功."
Const sCase10_LowerText = "下一步将删除50条记录."

Const sCase11_UpperText = "删除50条记录成功."
Const sCase11_LowerText = "下一步将用SQL语句INSERT添加50条记录."

Const sCase12_UpperText = "添加纪录成功."
Const sCase12_LowerText = "下一步将使用SQL语句UPDATE更新记录."

Const sCase13_UpperText = "更新记录成功."
Const sCase13_LowerText = "下一步将使用SQL语句DELETE删除纪录."

Const sCase14_LowerText = "删除记录成功，下一步将调用存储过程."

Const sCase15_LowerText = "存储过程调用成功，下一步将演示错误处理."

Const sCase16_UpperText = "演示错误处理成功."
Const sCase16_LowerText = "下一步将演示RDO处理多个数据集的能力."

Const sCase17_LowerText = "演示成功." & vbCrLf & vbCrLf _
    & "下一步将开始异步查询."

Const sCase18_UpperText = "异步查询成功."
Const sCase18_LowerText = "下一步将演示服务器端游标."

Const sCase19_LowerText = "服务器端游标使用成功." & vbCrLf & vbCrLf _
    & "下一步将演示异步查询的结果。"

Const sCase20_LowerText = "下一步将结束RDO应用程序的演示."

Const sCase21_UpperText = "演示结束."
Const sCase21_LowerText = "Press Next to reset the Wizard or Cancel to end this program."
Private Sub InitRDO()

    MousePointer = vbHourglass
    'Allocate the environment
    Set en = rdoEngine.rdoEnvironments(0)
    MousePointer = vbDefault
    
End Sub
Private Sub Create2ndRDOEnv()
    
    MousePointer = vbHourglass
    'Allocate the environment
    Set en2 = rdoCreateEnvironment("ENV2", Text_Mid.Text, Text_Bot.Text)
    MousePointer = vbDefault
    
End Sub
Private Sub OpenRDOConnectionDSN()
   
    MousePointer = vbHourglass
   'Allocate the connection
    Set cn = en.OpenConnection("", rdDriverComplete)
    MousePointer = vbDefault
    
End Sub
Private Sub OpenRDOConnectionNoDSN()
    Dim sConn As String
    
    Screen.MousePointer = vbHourglass
    sConn = "Driver=SQL Server;SERVER=" & sServer & ";UID=" & sLoginID & ";PWD=" & sPassword & ";DATABASE=pubs"
    Set cn2 = en.OpenConnection("", rdDriverNoPrompt, False, sConn)
    Screen.MousePointer = vbDefault

End Sub

Private Sub RDOQuery()
    Dim rs As rdoResultset
    Dim cl As rdoColumn
    Dim sTextLine As String
    Dim sFixedString As String * 15
    
    Screen.MousePointer = vbHourglass
    List1.Clear
    
    Set rs = cn.OpenResultset("Select au_lname, au_fname From authors", rdOpenForwardOnly)
    
    For Each cl In rs.rdoColumns
        sFixedString = cl.Name
        sTextLine = sTextLine & sFixedString & vbTab
    Next
    
    List1.AddItem sTextLine
    DoEvents
   
    Do
        sTextLine = ""
        For Each cl In rs.rdoColumns
            sFixedString = cl.Value
            sTextLine = sTextLine & sFixedString & vbTab
        Next
        
        List1.AddItem sTextLine
        DoEvents
        
        rs.MoveNext
        
    Loop Until rs.EOF = True
    
    rs.Close
        
    Screen.MousePointer = vbDefault

End Sub
Private Sub RDOQueryPS()
 
    Dim ps As rdoPreparedStatement
    Dim rs As rdoResultset
    Dim cl As rdoColumn
    Dim sSQL As String
    Dim sFixedString As String * 15
    Dim sTextLine As String
    
    Screen.MousePointer = vbHourglass
    List1.Clear
    
    sSQL = "Select au_lname, au_fname, state From authors Where state = ?"
    
    Set ps = cn2.CreatePreparedStatement("", sSQL)
    ps.rdoParameters(0).Direction = rdParamInput
    ps.rdoParameters(0) = Text_Mid.Text
    
    Set rs = ps.OpenResultset(rdOpenKeyset, rdConcurRowVer)
    
    For Each cl In rs.rdoColumns
        sFixedString = cl.Name
        sTextLine = sTextLine & sFixedString & vbTab
    Next
    
    List1.AddItem sTextLine
    DoEvents
             
    While Not rs.EOF
        sTextLine = vbNullString
        sFixedString = rs!au_lname
        sTextLine = sTextLine & sFixedString & vbTab
        sFixedString = rs!au_Fname
        sTextLine = sTextLine & sFixedString & vbTab
        sFixedString = rs!state
        sTextLine = sTextLine & sFixedString & vbTab
        List1.AddItem sTextLine
        rs.MoveNext
    Wend
    
    rs.Close
    
    Screen.MousePointer = vbDefault

End Sub
Private Sub CreateTable()

    Dim sSQL As String
    On Error Resume Next
    
    sSQL = "Drop Table department"
    cn.Execute sSQL
       
    On Error GoTo 0
    sSQL = "Create Table department (Dep_ID Int Not Null, Dep_Name Char(25), Primary Key(Dep_ID))"
    cn.Execute sSQL
     
End Sub
Private Sub AddUsingCursor()
    
    Dim rs As rdoResultset
    Dim i As Integer
    
    Screen.MousePointer = vbHourglass
    Set rs = cn.OpenResultset("Select Dep_ID, Dep_Name From department", rdOpenKeyset, rdConcurRowVer)
    
    For i = 0 To 50
        rs.AddNew
        rs!Dep_ID = i
        rs!Dep_Name = "Department " & CStr(i)
        rs.Update
    Next
    
    rs.Close
    
    Screen.MousePointer = vbDefault
    
End Sub
Private Sub UpdateUsingCursor()
    
    Dim rs As rdoResultset
    Dim i As Integer
    
    Screen.MousePointer = vbHourglass
    Set rs = cn.OpenResultset("Select Dep_ID, Dep_Name From department", rdOpenKeyset, rdConcurRowVer)
 
    Do Until rs.EOF
        rs.Edit
        rs!Dep_Name = "Updated " & rs!Dep_Name
        rs.Update
        rs.MoveNext
    Loop
    
    rs.Close
    
    Screen.MousePointer = vbDefault
    
End Sub

Private Sub DeleteUsingCursor()
    
    Dim rs As rdoResultset
    Dim i As Integer
    
    Screen.MousePointer = vbHourglass
    Set rs = cn.OpenResultset("Select Dep_ID, Dep_Name From department", rdOpenKeyset, rdConcurRowVer)
    
    Do Until rs.EOF
        rs.Delete
        rs.MoveNext
    Loop
    
    rs.Close
    
    Screen.MousePointer = vbDefault

End Sub
Private Sub AddUsingInsert()

    Dim ps As rdoPreparedStatement
    Dim sSQL As String
    Dim i As Integer
        
    Screen.MousePointer = vbHourglass
    
    sSQL = "Insert Into department Values( ?, ?)"
    
    Set ps = cn.CreatePreparedStatement("Insert", sSQL)

    For i = 0 To 50
        With cn.rdoPreparedStatements!Insert
            .rdoParameters(0).Value = i
            .rdoParameters(1).Value = "INSERTed Department " & CStr(i)
        End With
        cn.rdoPreparedStatements!Insert.Execute
    Next

    Screen.MousePointer = vbDefault

End Sub
Private Sub UpdateUsingUpdate()

    Dim ps As rdoPreparedStatement
    Dim sSQL As String
        
    Screen.MousePointer = vbHourglass
    
    sSQL = "Update department Set Dep_Name = 'UPDATE' + Substring(Dep_Name, 7, 25)"
    
    Set ps = cn.CreatePreparedStatement("Update", sSQL)

    cn.rdoPreparedStatements!Update.Execute

    Screen.MousePointer = vbDefault

End Sub
Private Sub DeleteUsingDelete()

    Dim ps As rdoPreparedStatement
    Dim sSQL As String
       
    Screen.MousePointer = vbHourglass
    
    sSQL = "Delete department"
    
    Set ps = cn.CreatePreparedStatement("Delete", sSQL)

    cn.rdoPreparedStatements!Delete.Execute

    Screen.MousePointer = vbDefault

End Sub
Private Sub CallSP()
    
    Dim ps As rdoPreparedStatement
    Dim sSQL As String
                   
    Screen.MousePointer = vbHourglass
    
    sSQL = "{ call CountStateRows (? ,?) }"
    
    Set ps = cn.CreatePreparedStatement("", sSQL)
        
    ps.rdoParameters(0).Direction = rdParamInput
    ps.rdoParameters(0).Value = Text_Mid.Text
    ps.rdoParameters(1).Direction = rdParamOutput
    
    ps.Execute
    
    Text_Bot.Text = ps.rdoParameters(1)