adomain.frm

数据库sql200和vb在一起的数据库查询代码呵工程

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00C0C0C0&
   Caption         =   "ADO Introductory Sample"
   ClientHeight    =   5865
   ClientLeft      =   1770
   ClientTop       =   1665
   ClientWidth     =   8520
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   5865
   ScaleWidth      =   8520
   Begin VB.TextBox txtQuery 
      Height          =   732
      Left            =   1320
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   17
      Top             =   2400
      Width           =   6495
   End
   Begin VB.ListBox List2 
      Height          =   1230
      ItemData        =   "adomain.frx":0000
      Left            =   1320
      List            =   "adomain.frx":0007
      TabIndex        =   16
      Top             =   3360
      Width           =   6492
   End
   Begin VB.Frame frmAuthorization 
      Caption         =   "Authorization:"
      Height          =   2052
      Left            =   4200
      TabIndex        =   9
      Top             =   120
      Width           =   3855
      Begin VB.OptionButton optSSAuth 
         Caption         =   "Use S&QL Server authentication"
         Height          =   252
         Left            =   240
         TabIndex        =   19
         Top             =   720
         Width           =   3252
      End
      Begin VB.OptionButton optWinNTAuth 
         Caption         =   "Use &Windows NT authentication"
         Height          =   252
         Left            =   240
         TabIndex        =   18
         Top             =   360
         Width           =   2892
      End
      Begin VB.TextBox txtPassword 
         Height          =   288
         Left            =   1320
         TabIndex        =   13
         Top             =   1560
         Width           =   2292
      End
      Begin VB.TextBox txtUserName 
         Height          =   288
         Left            =   1320
         TabIndex        =   12
         Top             =   1080
         Width           =   2292
      End
      Begin VB.Label lblPassword 
         Caption         =   "Password:"
         Height          =   252
         Left            =   240
         TabIndex        =   11
         Top             =   1560
         Width           =   972
      End
      Begin VB.Label lblUserName 
         Caption         =   "&Login name:"
         Height          =   252
         Left            =   240
         TabIndex        =   10
         Top             =   1080
         Width           =   972
      End
   End
   Begin VB.CommandButton cmdExecute 
      Caption         =   "Execute"
      Height          =   372
      Left            =   4560
      TabIndex        =   8
      Top             =   5160
      Width           =   1452
   End
   Begin VB.Frame frmConnectionInfo 
      Caption         =   "Connection:"
      Height          =   2052
      Left            =   240
      TabIndex        =   3
      Top             =   120
      Width           =   3732
      Begin VB.TextBox txtDatabaseName 
         Height          =   288
         Left            =   1200
         TabIndex        =   7
         Top             =   1200
         Width           =   2172
      End
      Begin VB.TextBox txtServerName 
         Height          =   288
         Left            =   1200
         TabIndex        =   6
         Top             =   600
         Width           =   2172
      End
      Begin VB.Label Label2 
         Caption         =   "Database:"
         Height          =   255
         Left            =   240
         TabIndex        =   5
         Top             =   1200
         Width           =   855
      End
      Begin VB.Label Label1 
         Caption         =   "Server:"
         Height          =   255
         Left            =   240
         TabIndex        =   4
         Top             =   600
         Width           =   855
      End
   End
   Begin VB.CommandButton cmdConnect 
      Caption         =   "Connect"
      Height          =   372
      Left            =   720
      TabIndex        =   2
      Top             =   5160
      Width           =   1572
   End
   Begin VB.CommandButton cmdDisconnect 
      Caption         =   "Disconnect"
      Height          =   372
      Left            =   2640
      TabIndex        =   1
      Top             =   5160
      Width           =   1572
   End
   Begin VB.CommandButton cmdClear 
      Caption         =   "Clear"
      Height          =   372
      Left            =   6360
      TabIndex        =   0
      Top             =   5160
      Width           =   1572
   End
   Begin VB.Label lblQueryResults 
      Caption         =   "Results:"
      Height          =   252
      Left            =   480
      TabIndex        =   15
      Top             =   3960
      Width           =   612
   End
   Begin VB.Label lblQueryEntry 
      Caption         =   "Query:"
      Height          =   252
      Left            =   480
      TabIndex        =   14
      Top             =   2640
      Width           =   612
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuItemExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "&Edit"
      Begin VB.Menu mnuEditItem 
         Caption         =   "Cu&t"
         Index           =   0
         Shortcut        =   ^X
      End
      Begin VB.Menu mnuEditItem 
         Caption         =   "&Copy"
         Index           =   1
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuEditItem 
         Caption         =   "&Paste"
         Index           =   2
         Shortcut        =   ^V
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "&Help"
      Begin VB.Menu mnuAboutItem 
         Caption         =   "&About ADO Introductory Sample"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'This sample application uses ADO to connect to and query a SQL Server data source
'through SQLOLEDB.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim cn As New ADODB.Connection

Dim Msg As String
Dim Response As String

Dim errcase As Integer
   
Const Title = "Server Connection"
Const MsgConnSucc = "Connection to server successful."
Const MsgConnUn = "No server connection."

Private Sub Form_Load()
    buttonsConnectClosed
    optWinNTAuth.Value = True
    WinNTAuthOptionsOn
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If cn.State = adStateOpen Then
      cn.Close
    End If
    End
End Sub

Private Sub cmdConnect_Click()
    ' Connect to server through SQL Server OLE DB Provider.
    
    Dim ServerName As String
    Dim DatabaseName As String
    Dim UserName As String
    Dim Password As String

    On Error GoTo ErrorConnect:

    ' Clear the error log display.
    Form2.lstErrors.Clear
    
    ' Put text box values into connection variables.
    
     ServerName = txtServerName.Text
     DatabaseName = txtDatabaseName.Text
     UserName = txtUserName.Text
     Password = txtPassword.Text
     
     ' Set connection properties.
    cn.ConnectionTimeout = 25
    cn.Provider = "sqloledb"
    cn.Properties("Data Source").Value = ServerName
    cn.Properties("Initial Catalog").Value = DatabaseName
    
    ' Decision code for login authorization type: WinNT or SQL Server.
    If optWinNTAuth.Value = True Then
        cn.Properties("Integrated Security").Value = "SSPI"
    Else
        cn.Properties("User ID").Value = UserName
        cn.Properties("Password").Value = Password
    End If
    
    ' Change mousepointer while trying to open database.
    Screen.MousePointer = vbHourglass
    
    ' Open the database.
    cn.Open
    
    ' Change mousepointer back to the default after open.
    Screen.MousePointer = vbDefault
    
    ' Notify user that connection was successful.
    Response = MsgBox(MsgConnSucc, vbOKOnly, Title)
    
    ' Enable buttons for performing queries; disable others.
    buttonsConnectOpen
    
    Exit Sub
   
ErrorConnect:
    
    ' Error checking. Connection successful.
    If cn.State = adStateOpen Then
        errcase = 1
    End If
    
    ' Error checking. Connection unsuccessful.
    If cn.State <> adStateOpen Then
        errcase = 2
    End If
    
    ' Go to general error-logging routine.
    ErrorLog
 
 End Sub