title image


Smiley so z.b


'in deinem startmodul



Option Explicit

Public db As Connection

Public DataBasePath As String   

Sub Main()



    DataBasePath = "E:\Databases\IVS.mdb"

    

    Set db = New Connection

    PassWort = "deindbpasswort" ' wenn nötig

    db.CursorLocation = adUseClient

    db.Provider = "Microsoft.Jet.OLEDB.4.0"

    db.Properties("Jet OLEDB:Database Password") = PassWort

    db.Open DataBasePath

    

    Dim fLogin As New frmLogin

    fLogin.Show vbModal

    If Not fLogin.OK Then

        'Anmeldung fehlgeschlagen. Anwendung wird beendet.

        

        End

    End If

    Unload fLogin



    'dein MainFormular laden



end sub





' in deiner loginform heißt hier frmLogin

Public rsuser As New ADODB.Recordset

'trägt den windows usernamen in die usertextbox ein

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long

Public OK As Boolean



Private Sub Form_Load()

    Dim sBuffer As String

    Dim lSize As Long

    Dim strcn As String



    rsuser.Open "Users", db, adOpenDynamic, adLockOptimistic

    

    sBuffer = Space$(255)

    lSize = Len(sBuffer)

    Call GetUserName(sBuffer, lSize)

    If lSize > 0 Then

        txtUserName.Text = Left$(sBuffer, lSize)

    Else

        txtUserName.Text = vbNullString

    End If

    Me.ZOrder 0

End Sub



Private Sub cmdCancel_Click()

    OK = False

    Me.Hide

End Sub



Private Sub cmdOK_Click()



On Error GoTo err:

    rsuser.MoveFirst

    rsuser.Find "User = '" & txtUserName.Text & "'" 'user suchen

    

    If txtPassword.Text = rsuser!pass Then ' passwort überprüfen

        OK = True 'login auf korrekt setzten

        Me.Hide  

        Exit Sub

    End If

err:

        MsgBox "Ungültiges Kennwort, versuchen Sie es erneut!", , "Anmelden"

        txtPassword.SetFocus

        txtPassword.SelStart = 0

        txtPassword.SelLength = Len(txtPassword.Text)

    

End Sub Code eingefügt mit Syntaxhighlighter 1.16



verweis zu MS Active Dataobjects 2.x nicht vergessen
acc akut


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: