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

Se pensate di avere del materiale freeware interessante e volete pubblicarlo, allora leggete qui.