formwiz.frm

关于VB模块的

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Begin VB.Form Form1 
   Caption         =   "DAO演示程序"
   ClientHeight    =   4884
   ClientLeft      =   60
   ClientTop       =   348
   ClientWidth     =   4368
   LinkTopic       =   "Form1"
   ScaleHeight     =   4884
   ScaleWidth      =   4368
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame1 
      Height          =   4095
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   4095
      Begin MSFlexGridLib.MSFlexGrid Grid 
         Height          =   1935
         Left            =   120
         TabIndex        =   11
         Top             =   240
         Width           =   3855
         _ExtentX        =   6795
         _ExtentY        =   3408
         _Version        =   393216
         FixedCols       =   0
         AllowUserResizing=   1
      End
      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.Label Label_Top 
         Caption         =   "Server"
         Height          =   255
         Left            =   960
         TabIndex        =   10
         Top             =   360
         Width           =   2415
      End
      Begin VB.Label Label_Bot 
         Caption         =   "Password"
         Height          =   255
         Left            =   960
         TabIndex        =   9
         Top             =   1560
         Width           =   2415
      End
      Begin VB.Label Label_Mid 
         Caption         =   "Login ID"
         Height          =   255
         Left            =   960
         TabIndex        =   8
         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            =   2400
      TabIndex        =   5
      Top             =   4320
      Width           =   1215
   End
   Begin VB.CommandButton Command_Next 
      Caption         =   "Next-->"
      Height          =   375
      Left            =   600
      TabIndex        =   3
      Top             =   4320
      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 ws As Workspace
Dim db As Database
Dim rs As Recordset
Dim td As TableDef

Dim nState As Integer
Dim sServer As String
Dim sLoginID As String
Dim sPassword As String

' Displayed by Form_load
Const sCase0_UpperText = "DAO应用程序"
Const sCase0_LowerText = "单击NEXT开始连接数据库"

Const sCase1_LowerText = "输入用户名和密码，连接到PUBS数据库."

Const sCase2_UpperText = "采用连接表方式连接数据库成功！"
Const sCase2_LowerText = "单击Next创建一个数据库，然后删除。"

Const sCase3_UpperText = "创建数据库成功！"
Const sCase3_LowerText = "单击Next用OPENDATABASE方法连接数据库。"

'Const sCase4_UpperText = "You have successfully connected to SQL Server using the OpenDatabase method and selecting a DSN"
Const sCase4_LowerText = "连接数据库，并选择数据."

'Const sCase5_UpperText = "You have successfully connected to SQL Server using a DSN-less OpenDatabase connection."
Const sCase5_LowerText = "查找state为CA的第一条记录."

Const sCase6_LowerText = "查找state为CA的记录."

Const sCase7_LowerText = "查找state为CA的最后一条记录."

Const sCase8_LowerText = "显示满足条件的记录集."

Const sCase9_UpperText = "在pubs数据库中创建department表."
Const sCase9_LowerText = "下一步为departement表添加50条记录."

Const sCase10_UpperText = "成功下一步为departement表添加50条记录."
Const sCase10_LowerText = "下一步为departement表更新50条记录."

Const sCase11_UpperText = "成功为departement表更新50条记录."
Const sCase11_LowerText = "下一步为departement表删除50条记录."

Const sCase12_UpperText = "成功为departement表删除50条记录."
Const sCase12_LowerText = "下一步使用SQLPassthrough为departement表添加50条记录."

Const sCase13_UpperText = "成功使用SQLPassthrough为departement表添加50条记录."
Const sCase13_LowerText = "下一步下一步使用SQLPassthrough为departement表更新50条记录."

Const sCase14_UpperText = "成功使用SQLPassthrough为departement表更新50条记录."
Const sCase14_LowerText = "下一步下一步使用SQLPassthrough为departement表删除50条记录."

Const sCase15_UpperText = "成功下一步使用SQLPassthrough为departement表删除50条记录."
Const sCase15_LowerText = "下一步演示错误处理方法！"

Const sCase16_UpperText = "成功演示错误处理方法！."
Const sCase16_LowerText = "下一步完成DAO数据库应用程序演示."


Private Sub ConnectLinkedTable()

    MousePointer = vbHourglass
        
    On Error GoTo Errorhandler
    Set db = OpenDatabase("sqllink.mdb")
    'Set db = OpenDatabase("sql.mdb")
    
        
        Set td = db.TableDefs("authors")
        td.Connect = "ODBC;Driver=SQL Server;UID=" & sLoginID & _
            ";PWD=" & sPassword & _
            ";SERVER=" & sServer & _
            ";DATABASE=pubs"
        Set rs = db.OpenRecordset("Select * From authors")
        
        Do Until rs.EOF
            Debug.Print rs(0), rs(1), rs(2)
            rs.MoveNext
        Loop
        
        rs.Close
        db.Close
        
    MousePointer = vbDefault
    
    Exit Sub
        
Errorhandler:
        MsgBox "Access连接表没有正确连接到SQL Server数据库pubs,请正确创建Access连接表！", vbOKOnly, "错误"
    
        
        
        
        
        
    MousePointer = vbDefault
End Sub
Private Sub CreateLinkedTable()

    MousePointer = vbHourglass
    
    Set ws = DBEngine.Workspaces(0)
    Set db = ws.CreateDatabase _
        ("newlink.mdb", dbLangGeneral, dbVersion30)
    Set td = db.CreateTableDef("authors")
    td.Connect = "ODBC;Driver=SQL Server;UID=" & sLoginID & _
        ";PWD=" & sPassword & _
        ";SERVER=" & sServer & _
        ";DATABASE=pubs"
    td.SourceTableName = "dbo.authors"
    db.TableDefs.Append td
    Set rs = db.OpenRecordset("Select * From authors")
    
    Do Until rs.EOF
        Debug.Print rs(0), rs(1), rs(2)
        rs.MoveNext
    Loop
            
    rs.Close
    db.Close
    ws.Close
    Kill ("newlink.mdb")
    
    MousePointer = vbDefault
    
End Sub

Private Sub DAOQuery()
    
    Dim ws As Workspace
    Dim rs As Recordset
    Dim fld As Field
    Dim nRow As Integer
    
    Screen.MousePointer = vbHourglass
    
    Set ws = Workspaces(0)
    Set db = ws.OpenDatabase _
        ("", dbDriverComplete, False, "ODBC;UID=" & sLoginID & _
        ";PWD=" & sPassword & ";DATABASE=pubs")
    Set rs = db.OpenRecordset("Select * From authors", dbOpenDynaset)
    
    ' Setup the grid
    Grid.Cols = rs.Fields.Count
    Grid.Rows = 1
    Grid.Row = 0
    
    
    
    'Setup the Grid headings
     For Each fld In rs.Fields
         Grid.Col = fld.OrdinalPosition
         Grid.Text = fld.Name
    Next fld
    
    rs.MoveLast
    Grid.Rows = rs.RecordCount + 1
    Grid.Row = 0
    rs.MoveFirst
    
    ' Move through each row in the record set
    Do Until rs.EOF
        
        Grid.Row = Grid.Row + 1
        
        'Loop through all fields
        For Each fld In rs.Fields
            Grid.Col = fld.OrdinalPosition
            Grid.Text = fld.Value
        Next fld
    
        rs.MoveNext
    Loop
       
    rs.Close
        
    Screen.MousePointer = vbDefault

End Sub
Private Sub DAORecordSetFindFirst()
    
    Dim rs As Recordset
    Dim fld As Field
    Dim sCriteria As String
    
    Screen.MousePointer = vbHourglass
    
    'Use the open database object named db
    Set rs = db.OpenRecordset("Select * From authors", dbOpenDynaset)
    
    'Setup the find criteria
    sCriteria = "state = 'CA'"
    
    ' Populate the Recordset
    rs.MoveLast
    ' Find the first matching record
    rs.FindFirst sCriteria
    If rs.NoMatch Then
        MsgBox "No records found for " & sCriteria
        Screen.MousePointer = vbDefault
        Exit Sub
    End If

    ' Setup the grid
    Grid.Cols = rs.Fields.Count
    Grid.Rows = 2
    Grid.Row = 0
    
    'Setup the Grid headings
     For Each fld In rs.Fields
         Grid.Col = fld.OrdinalPosition
         Grid.Text = fld.Name
    Next fld
    
    Grid.Row = Grid.Row + 1
    
    'Display one row in the grid
    For Each fld In rs.Fields
        Grid.Col = fld.OrdinalPosition
        Grid.Text = fld.Value
    Next fld
    
    rs.Close
                    
    Screen.MousePointer = vbDefault

End Sub

Private Sub DAORecordSetFindNext()
    Dim fld As Field
    Dim sCriteria As String
    
    Screen.MousePointer = vbHourglass
    
    'Use the open database object named db
    Set rs = db.OpenRecordset("Select * From authors", dbOpenDynaset)
    
    ' Setup the grid
    Grid.Cols = rs.Fields.Count
    Grid.Rows = 1
    Grid.Row = 0
    
    'Setup the Grid headings
     For Each fld In rs.Fields
         Grid.Col = fld.OrdinalPosition
         Grid.Text = fld.Name
    Next fld
    
    'Setup the find criteria
    sCriteria = "state = 'CA'"
    
    ' Find the first matching record
    rs.FindFirst sCriteria
    
    Do While rs.NoMatch = False
        'Display the current record in the grid
        Grid.Rows = Grid.Rows + 1
        Grid.Row = Grid.Rows - 1
        
        For Each fld In rs.Fields
            Grid.Col = fld.OrdinalPosition
            Grid.Text = fld.Value
        Next fld
        rs.FindNext sCriteria
   Loop
                
    Screen.MousePointer = vbDefault
 
 End Sub
 Private Sub DAORecordsetFindLast()
    Dim fld As Field
    Dim sCriteria As String
    
    Screen.MousePointer = vbHourglass
    
    ' Setup the grid
    Grid.Cols = rs.Fields.Count
    Grid.Rows = 1
    Grid.Row = 0
    
    'Setup the find criteria
    sCriteria = "state = 'CA' And city = 'Oakland'"
    
    ' Find the first matching record
    ' Use the open recordset named rs
    rs.FindLast sCriteria
    If rs.NoMatch Then
        MsgBox "No records found for " & sCriteria
        Screen.MousePointer = vbDefault
        Exit Sub
    End If
                
    ' Find the first matching records in the open recordset
    Do While rs.NoMatch = False
        'Display the current record in the grid
        If rs.NoMatch = True Then Exit Do
        
        Grid.Rows = Grid.Rows + 1
        Grid.Row = Grid.Rows - 1
        
        For Each fld In rs.Fields
            Grid.Col = fld.OrdinalPosition
            Grid.Text = fld.Value
        Next fld
        rs.FindPrevious sCriteria
    Loop
    
    rs.Close
                
    Screen.MousePointer = vbDefault
 End Sub
 
 Private Sub DAOLimitedRecordSet()
 
    Dim ws As Workspace
    Dim db As Database
    Dim rs As Recordset
    Dim fld As Field
    Dim nRow As Integer
    Dim sSQL As String
    
    Screen.MousePointer = vbHourglass
    
    sSQL = "Select * From authors " _
        & "Where state = 'CA' And city = 'Oakland'"
    
    Set ws = Workspaces(0)
    Set db = ws.OpenDatabase("", dbDriverNoPrompt, False, _
        "ODBC;Driver=SQL Server;UID=" & sLoginID & _
        ";PWD=" & sPassword & _
        ";Server=" & sServer & _
        ";Database=pubs")
    Set rs = db.OpenRecordset(sSQL, dbOpenDynaset)
    
    DisplayDynasetGrid rs, Grid, 1
    
    rs.Close
        
    Screen.MousePointer = vbDefault

 End Sub
 

Private Sub CreateTable()

    Dim sSQL As String
    On Error Resume Next
    
    Screen.MousePointer = vbHourglass
    
    sSQL = "Drop Table department"
    db.Execute sSQL, dbSQLPassThrough
       
    On Error GoTo 0
    sSQL = "Create Table department " _
        & "(Dep_ID Int Not Null, Dep_Name Char(25), Primary Key(Dep_ID))"
    db.Execute sSQL, dbSQLPassThrough
    
    Screen.MousePointer = vbDefault
     
End Sub
Private Sub AddUsingRecordset()
    
    Dim rs As Recordset
    Dim i As Integer
    Dim sSQL As String
    
    Screen.MousePointer = vbHourglass
    
    ' Make sure no records are retrieved on the SELECT
    sSQL = "Select Dep_ID, Dep_Name From department Where 1 = 2"
    
    'Use the open database object
    Set rs = db.OpenRecordset(sSQL, dbOpenDynaset)
   
    ' Insert 50 records
    For i = 1 To 50
        rs.AddNew
        rs!Dep_ID = i
        rs!Dep_Name = "Department " & CStr(i)
        rs.Update
    Next
    
    ' Display the added records
    DisplayDynasetGrid rs, Grid, 1
       
    rs.Close
    
    Screen.MousePointer = vbDefault
    
End Sub
Private Sub UpdateUsingRecordset()
    
    Dim rs As Recordset
    Dim i As Integer
    Dim sTemp As String