General |
6.85 Testare un login al server SQL7 o MSDE. |
Pietro Bonaventi |
[MSAccess 2000] Questa funzione utilizzando la maschera di Login di Harry Evans presente in questo sito, permette di testare un login al server SQL7 o MSDE. Se l'id e la password immessi nella maschera sono presenti nel database accetta il login altrimenti dopo 3 tentativi chiude il progetto Access. Partendo da un progetto MSAccess collegato a SQL7 oppure a Msde e dopo aver aggiunto la form e i moduli dell'esempio di Harry Evans sarà possibile testare una connessione a SQL7 oppure a MSDE. Non è previsto eventuale controllo con trusted NT. Option Compare Database Option Explicit Public numerotentativi As Integer Public Function Test() Dim strUser As String Dim strPsw As String Dim cnn1 As New ADODB.Connection Dim cmd As New ADODB.Command Dim STRTOSQL As String Dim Msg, Style, Title, Response As String Dim DB As String Dim SERVER As String Dim formtoopen As String 'indicare il nome del db sul server DB = "NORTHWIND" 'indicare il nome del server SERVER = "SERVER" 'indicare il nome della form di apertura formtoopen = "MENU" Msg = "Il nome utente oppure la password non sono state riconosciute" Style = vbOKOnly + vbCritical Title = "Accesso negato" On Error GoTo Err If GetLogin(strUser, strPsw) Then STRTOSQL = "Provider=SQLOLEDB.1;Password=" & strPsw & ";Persist Security Info=True;User ID=" & _ strUser & ";Initial Catalog=" & DB & ";Data Source=" & SERVER cnn1.Open STRTOSQL Set cmd.ActiveConnection = cnn1 If CurrentProject.IsConnected Then DoCmd.OpenForm formtoopen Exit Function Else While Not numerotentativi = 2 cnn1.Close CurrentProject.CloseConnection Response = MsgBox(Msg, Style, Title) If Response = vbOK Then numerotentativi = numerotentativi + 1 GoTo uscita End If Wend DoCmd.Quit End If Else If strPsw = "" Then STRTOSQL = "Provider=SQLOLEDB.1;Password="""";Persist Security Info=True;User ID=" & _ strUser & ";Initial Catalog=" & DB & ";Data Source=" & SERVER Else STRTOSQL = "Provider=SQLOLEDB.1;Password=" & strPsw & ";Persist Security Info=True;User ID=" & _ strUser & ";Initial Catalog=" & DB & ";Data Source=" & SERVER End If cnn1.Open STRTOSQL Set cmd.ActiveConnection = cnn1 If CurrentProject.IsConnected Then DoCmd.OpenForm formtoopen Exit Function Else While Not numerotentativi = 2 cnn1.Close CurrentProject.CloseConnection Response = MsgBox(Msg, Style, Title) If Response = vbOK Then numerotentativi = numerotentativi + 1 GoTo uscita End If Wend DoCmd.Quit End If End If Err: While Not numerotentativi = 2 Response = MsgBox(Msg, Style, Title) If Response = vbOK Then numerotentativi = numerotentativi + 1 GoTo uscita End If Wend DoCmd.Quit uscita: Call Test End Function |