VERSION 5.00
Begin VB.Form frmPin 
   BorderStyle     =   1  'Fest Einfach
   Caption         =   "frmPin"
   ClientHeight    =   3480
   ClientLeft      =   45
   ClientTop       =   345
   ClientWidth     =   6600
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3480
   ScaleWidth      =   6600
   StartUpPosition =   3  'Windows-Standard
   Begin VB.PictureBox Picture1 
      Appearance      =   0  '2D
      BackColor       =   &H80000003&
      BorderStyle     =   0  'Kein
      ForeColor       =   &H80000008&
      Height          =   735
      Left            =   240
      ScaleHeight     =   735
      ScaleWidth      =   4215
      TabIndex        =   1
      Top             =   1080
      Width           =   4215
      Begin VB.TextBox txtPin 
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   13.5
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   465
         IMEMode         =   3  'DISABLE
         Left            =   2040
         PasswordChar    =   "*"
         TabIndex        =   0
         Top             =   120
         Width           =   1875
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackColor       =   &H80000013&
         Caption         =   "Kellnerschlüssel:"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   120
         TabIndex        =   2
         Top             =   210
         Width           =   1815
      End
   End
End
Attribute VB_Name = "frmPin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'========================= FORMULAR EREIGNISSE ===================
'=================================================================
Private Sub Form_Load()
frmPin.Width = MDIHauptmenu.Width / 2
frmPin.Height = MDIHauptmenu.Height / 2
frmPin.Top = MDIHauptmenu.Height / 2 - frmPin.Height / 2
frmPin.Left = MDIHauptmenu.Width / 2 - frmPin.Width / 2
frmPin.Picture1.Left = (frmPin.ScaleWidth - frmPin.Picture1.Width) / 2
frmPin.Picture1.Top = frmPin.ScaleHeight / 2 - frmPin.Picture1.Height / 2

End Sub
Private Sub Form_Activate()
frmRaum.TimerTischauswahl.Enabled = False
frmTastenMenu2.TimerMenu2.Enabled = False
Me.txtPin = ""
MDIHauptmenu.lblKellner.Caption = ""
End Sub

Private Sub Form_Unload(Cancel As Integer)
 ShowStartmenue True
 End
End Sub
'========================= TEXT EREIGNISSE ===================
'=============================================================
Private Sub txtPin_KeyUp(KeyCode As Integer, Shift As Integer)
 'Dim b As Integer
 'On Error GoTo 10
 'b = CInt(Me.txtPin.Text)
 If KeyCode = 13 Then Call PrueffePin
 'Exit Sub
'10 MsgBox "Es darf kein Zeichen eingegeben werden"
 '  Me.txtPin.Text = ""
End Sub

'============================ FPROZEDUREN =======================
'================================================================
Sub PrueffePin()
    If Me.KellnerPinAbfrage = True Then
       Me.Visible = False 'Pin ist Korekt
       MDIHauptmenu.lblKellner.Caption = VarKellner
       Call mdlDatenbanken.TabellePicTischAbfragen(frmRaum, VarStation)
    End If
End Sub


Function KellnerPinAbfrage()
Dim objConn As ADODB.Connection
Dim rsKellner As ADODB.Recordset

Set objConn = New ADODB.Connection
Set rsKellner = New ADODB.Recordset

Dim strPath As String

  On Error GoTo err_Handler

  strPath = App.Path
  If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"


  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & VarDatenbank
    .CursorLocation = adUseClient
    .Open
  End With


  With rsKellner
    .ActiveConnection = objConn
    '.CursorLocation = adUseClient
    .LockType = adLockPessimistic
    .Open "Select *FROM Kellner Where Pin1 ='" & Me.txtPin.Text & "' or AdminKey = '" & Me.txtPin.Text & "'"
  End With
  
    If Not rsKellner.EOF = True Then
      If rsKellner.Fields("Status").Value = "aktiviert" Then
        VarKellner = rsKellner.Fields("Mitarbeiter").Value
        KellnerPinAbfrage = True
      Else
        MsgBox "Ihr Zugang ist gesperrt - Bitte informieren Sie Ihren Administrator"
        KellnerPinAbfrage = False
      End If
    Else
      MsgBox "Ihr Kellnerschlüssel(Pin1) ist Falsch - Bitte geben Sie ihn erneut ein"
      Me.txtPin = ""
      KellnerPinAbfrage = False
    End If
    

    Set rsKellner = Nothing
    Set objConn = Nothing
exit_Sub:
  On Error GoTo 0
  Exit Function

err_Handler:
  MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
    
  Resume exit_Sub
Set rsKellner = Nothing
Set objConn = Nothing
End Function