frmsqlserverslogin.frm

CodeWizardRC2.zip for Rainbow Souce Code

VERSION 5.00
Begin VB.Form frmSQLServersLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "SQL Server Login"
   ClientHeight    =   2385
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4275
   ControlBox      =   0   'False
   Icon            =   "frmSQLServersLogin.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2385
   ScaleWidth      =   4275
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdDisconnect 
      Caption         =   "Disconnect"
      Height          =   375
      Left            =   1500
      TabIndex        =   10
      Top             =   1980
      Width           =   1275
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Height          =   375
      Left            =   60
      TabIndex        =   9
      Top             =   1980
      Width           =   1275
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   3000
      TabIndex        =   8
      Top             =   1980
      Width           =   1275
   End
   Begin VB.ComboBox txtServer 
      Height          =   315
      Left            =   1680
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   60
      Width           =   2295
   End
   Begin VB.CheckBox chkAuthentication 
      Caption         =   "Use NT Authentication"
      Height          =   375
      Left            =   1680
      TabIndex        =   1
      Top             =   420
      Value           =   1  'Checked
      Width           =   2295
   End
   Begin VB.Frame Frame1 
      Enabled         =   0   'False
      Height          =   1035
      Left            =   60
      TabIndex        =   4
      Top             =   840
      Width           =   4155
      Begin VB.TextBox txtUsername 
         Height          =   315
         Left            =   1620
         TabIndex        =   2
         Top             =   240
         Width           =   2355
      End
      Begin VB.TextBox txtPasswd 
         Height          =   315
         IMEMode         =   3  'DISABLE
         Left            =   1620
         PasswordChar    =   "*"
         TabIndex        =   3
         Top             =   600
         Width           =   2355
      End
      Begin VB.Label Label2 
         Alignment       =   1  'Right Justify
         Caption         =   "Password:"
         Enabled         =   0   'False
         Height          =   195
         Left            =   480
         TabIndex        =   6
         Top             =   600
         Width           =   1035
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         Caption         =   "Username:"
         Enabled         =   0   'False
         Height          =   195
         Left            =   480
         TabIndex        =   5
         Top             =   300
         Width           =   1035
      End
   End
   Begin VB.Label Label3 
      Alignment       =   1  'Right Justify
      Caption         =   "SQL Server:"
      Height          =   255
      Left            =   180
      TabIndex        =   7
      Top             =   60
      Width           =   1215
   End
End
Attribute VB_Name = "frmSQLServersLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
'EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
'MERCHANTIBILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.Option Explicit

Private sUsername As String
Private sPasswd As String
'Use the SQLServer object to connect to a specific server
Private oSQLServer As SQLDMO.SQLServer
Attribute oSQLServer.VB_VarHelpID = -1

'Determine is NT Authentication is to be used or not
Private Sub chkAuthentication_Click()
If chkAuthentication.Value = vbChecked Then
  'This assumes a trusted connection
  Frame1.Enabled = False
  Label1.Enabled = False
  Label2.Enabled = False
Else
  'This assumes a login is required
  Frame1.Enabled = True
  Label1.Enabled = True
  Label2.Enabled = True
End If
End Sub

Private Sub cmdCancel_Click()
  Unload Me
End Sub

Private Sub cmdDisconnect_Click()
  'When done with the connection to SQLServer you must Disconnect
  If Not goSQLServer Is Nothing Then
  oSQLServer.DisConnect
  Set oSQLServer = Nothing
  End If
End Sub

Private Sub cmdOK_Click()
On Error GoTo ErrorHandler

Set oSQLServer = New SQLDMO.SQLServer

oSQLServer.LoginTimeout = -1 '-1 is the ODBC default (60) seconds
'Connect to the Server
If chkAuthentication Then
  With oSQLServer
  'Use NT Authentication
    .LoginSecure = True
  'Do not reconnect automatically
    .AutoReConnect = False
  'Now connect
    .Connect txtServer.Text
  End With
Else
  With oSQLServer
  'Use SQL Server Authentication
    .LoginSecure = False
  'Do not reconnect automatically
    .AutoReConnect = False
  'Use SQL Security
    .Connect txtServer.Text, sUsername, sPasswd
  End With
End If
'
Set oSQLServerActive = oSQLServer
'MsgBox "Your Login: " & oSQLServer.Login
'Show next form

frmDMOObjectExplorer.Show
Me.Hide

Exit Sub

ErrorHandler:
MsgBox "Error: " & Err.Number & " " & Err.Description, vbOKOnly, "Login Error"

End Sub

Private Sub Form_Load()
  Dim i As Integer
  'Show the message events
  gbShowCommandEvents = True
  'Use the SQL DMO Application Object to find the available SQL Servers
  Set oSQLServerDMOApp = New SQLDMO.Application
  
  Dim namX As SQLDMO.NameList
  Set namX = oSQLServerDMOApp.ListAvailableSQLServers
  For i = 1 To namX.Count
    txtServer.AddItem namX.Item(i)
  Next
  
  On Error Resume Next
  'Show top server
  txtServer.ListIndex = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
  If Not oSQLServer Is Nothing Then
    'When done with the connection to SQLServer you must Disconnect
    oSQLServer.DisConnect
  End If
  
  Set oSQLServerActive = Nothing
  Set oSQLServer = Nothing
  Set oSQLServerDMOApp = Nothing
End Sub

Private Sub txtPasswd_Change()
  sPasswd = txtPasswd.Text
End Sub

Private Sub txtUsername_Change()
  sUsername = txtUsername.Text
End Sub