VERSION 5.00 Begin VB.Form frmLogin BorderStyle = 3 'Fixed Dialog Caption = "Login" ClientHeight = 1875 ClientLeft = 1575 ClientTop = 3420 ClientWidth = 5505 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 1107.812 ScaleMode = 0 'User ScaleWidth = 5168.896 ShowInTaskbar = 0 'False Begin VB.OptionButton optConnectionType Caption = "DAO" Height = 255 Index = 1 Left = 360 TabIndex = 7 Top = 720 Width = 735 End Begin VB.OptionButton optConnectionType Caption = "ADO" Height = 255 Index = 0 Left = 360 TabIndex = 6 Top = 360 Value = -1 'True Width = 735 End Begin VB.TextBox txtUserName Height = 345 Left = 2850 TabIndex = 1 Top = 240 Width = 2325 End Begin VB.CommandButton cmdOK Caption = "OK" Default = -1 'True Height = 390 Left = 1560 TabIndex = 4 Top = 1320 Width = 1140 End Begin VB.CommandButton cmdCancel Cancel = -1 'True Caption = "Cancel" Height = 390 Left = 3000 TabIndex = 5 Top = 1320 Width = 1140 End Begin VB.TextBox txtPassword Height = 345 IMEMode = 3 'DISABLE Left = 2850 PasswordChar = "*" TabIndex = 3 Top = 705 Width = 2325 End Begin VB.Frame Frame1 Caption = "Connection Type" Height = 975 Left = 120 TabIndex = 8 Top = 120 Width = 1575 End Begin VB.Label lblLabels Alignment = 1 'Right Justify Caption = "&User Name:" Height = 270 Index = 0 Left = 1890 TabIndex = 0 Top = 255 Width = 855 End Begin VB.Label lblLabels Alignment = 1 'Right Justify Caption = "&Password:" Height = 270 Index = 1 Left = 1905 TabIndex = 2 Top = 705 Width = 840 End Attribute VB_Name = "frmLogin" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Sub cmdCancel_Click() 'Set the global variable to false 'to denote a failed login. LoginSucceeded = False Me.Hide End Sub Private Sub cmdOK_Click() SelectedConnectionType = Not optConnectionType(ConnectionType.ADO).Value 'Check for correct password. If AttemptConnection Then 'Place code to here to pass the success to the calling sub. 'Setting a global variable is the easiest method. LoginSucceeded = True Me.Hide Else MsgBox "Login falied. Make sure user name and password are correct.", vbOKOnly + vbCritical, "Login" txtPassword.SetFocus SendKeys "{Home}+{End}" End If End Sub Private Function AttemptConnection() As Boolean ' This function attempts to login to database to make sure ' that connection credential are correct. This function also ' demonstrates use of an ADO connection object. On Error GoTo ErrorTrap ' Build ADO and DAO conneciton strings. ' ADO will use OLE-DB provider; DAO uses ODBCDirect. ' NOTE: ' This connection assumes that you have set up and ODBC data source ' called "NorthwindMSDE" and are connecting to a database called "NorthwindCS." ' NorthwindCS is sample MSDE database included with Microsoft Access/2000. ADOConnectionString = "Provider=MSDASQL;Persist Security Info=False;User ID=" & txtUserName.Text & ";Password=" & txtPassword.Text & ";Initial Catalog=NorthwindCS;Data Source=NorthwindMSDE;Connect Timeout=15" DAOConnectionString = "ODBC;DATABASE=NorthwindCS;UID=" & txtUserName.Text & ";PWD=" & txtPassword.Text & ";DSN=NorthwindMSDE" Select Case SelectedConnectionType Case ConnectionType.ADO Dim adoConnection As ADODB.Connection Set adoConnection = CreateObject("ADODB.Connection") ' Build a connection object. If no errors ' result, we'll assume that the connection worked ' and user credentials are valid. With adoConnection .ConnectionString = ADOConnectionString .Open AttemptConnection = True .Close End With ' Clean up. Set adoConnection = Nothing Case ConnectionType.DAO Dim wrkODBC As DAO.Workspace Dim daoConnection As DAO.Connection ' Build a workspace object and then build a connection object. ' If no errors result, we'll assume that the connection worked ' and user credentials are valid. Set wrkODBC = CreateWorkspace("NewODBCWorkspace", "admin", "", dbUseODBC) Set daoConnection = wrkODBC.OpenConnection("Northwind", , False, DAOConnectionString) AttemptConnection = True ' Clean up. daoConnection.Close wrkODBC.Close Set daoConnection = Nothing Set wrkODBC = Nothing End Select Exit Function ErrorTrap: ' Account for errors here. AttemptConnection = False End Function