Кодик на Аксесик VBA
ФОРМА АВТОРИЗАЦИЯ
Private Sub Form_Load()
Dim conn As Object
Dim rs As Object
Dim strConn As String
Dim strSQL As String
Dim Текущая_дата As Date
Dim Логин As String
Dim Дата_последней_авторизации As Date
Текущая_дата = Date
strConn = "Provider=SQLOLEDB;Data Source=DO_ZAVRTA\MS;Initial Catalog=HotelSystem;Integrated Security=SSPI;"
Set conn = CreateObject("ADODB.Connection")
conn.Open strConn
strSQL = "SELECT login, last_auth_date FROM [users] WHERE last_auth_date IS NOT NULL"
Set rs = CreateObject("ADODB.Recordset")
rs.Open strSQL, conn, 1, 3
Do While Not rs.EOF
Логин = rs.Fields("login").Value
Дата_последней_авторизации = rs.Fields("last_auth_date").Value
If Текущая_дата - Дата_последней_авторизации > 30 Then
Dim updateSQL As String
updateSQL = "UPDATE [users] SET is_blocked = 1 WHERE login = '" & Replace(Логин, "'", "''") & "'"
conn.Execute updateSQL
End If
rs.MoveNext
Loop
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub
Private Sub Вход_Click()
Dim conn As Object
Dim rs As Object
Dim strConn As String
Dim strSQL As String
Dim Логин As String
Dim Пароль As String
Dim Права_доступа As String
Dim Блокировка As Boolean
Dim ПопыткиВхода As Integer
Dim ПодтверждениеПароля As Boolean
Логин = Nz(Me.Логин.Value, "")
Пароль = Nz(Me.Пароль.Value, "")
If Trim(Логин) = "" Or Trim(Пароль) = "" Then
MsgBox "Введите логин и пароль"
Exit Sub
End If
strConn = "Provider=SQLOLEDB;Data Source=DO_ZAVRTA\MS;Initial Catalog=HotelSystem;Integrated Security=SSPI;"
Set conn = CreateObject("ADODB.Connection")
conn.ConnectionString = strConn
strSQL = "SELECT * FROM [users] WHERE login = '" & Логин & "'"
Set rs = CreateObject("ADODB.Recordset")
rs.Open strSQL, conn, 1, 3
If rs.EOF Then
MsgBox "Пользователь с таким логином не найден"
Else
Блокировка = Nz(rs("is_blocked"), False)
If Блокировка Then
MsgBox "Ваш аккаунт заблокирован. Обратитесь к администратору."
rs.Close: conn.Close
Exit Sub
End If
If rs("password") = Пароль Then
ТекущийЛогин = Логин
rs("login_attempts") = 0
rs("last_auth_date") = Date
ПодтверждениеПароля = Nz(rs("account_confirmed"), False)
Права_доступа = rs("access_level")
rs.Update
MsgBox "Вы успешно авторизовались"
If Not ПодтверждениеПароля Then
MsgBox "Пожалуйста, смените пароль перед продолжением."
DoCmd.OpenForm "Смена пароля"
End If
Select Case Права_доступа
Case "Администратор"
DoCmd.OpenForm "Главное меню администратора"
Case "Сотрудник"
DoCmd.OpenForm "Главное меню сотрудника"
Case "Клиент"
DoCmd.OpenForm "Главное меню клиента"
Case Else
MsgBox "Неизвестная роль пользователя"
End Select
DoCmd.Close acForm, Me.Name
Else
ПопыткиВхода = Nz(rs("login_attempts"), 0) + 1
rs("login_attempts") = ПопыткиВхода
If ПопыткиВхода >= 3 Then
rs("is_blocked") = True
MsgBox "Ваш аккаунт заблокирован из-за превышения количества неудачных попыток."
Else
MsgBox "Неверный пароль. Осталось попыток: " & (3 - ПопыткиВхода)
End If
rs.Update
End If
End If
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub
Private Sub Выход_Click()
Dim ответ As Integer
ответ = MsgBox("Вы действительно хотите выйти?", vbYesNo)
If ответ = vbYes Then
DoCmd.Quit
End If
End Sub
ФОРМА ГЛАВНОЕ МЕНЮ (ЛЮБОЕ)
Private Sub Выход_Click()
Dim ответ As Integer
ответ = MsgBox("Вы действительно хотите выйти?", vbYesNo)
If ответ = vbYes Then
DoCmd.Quit
End If
End Sub
Private Sub СменаПользователя_Click()
Dim frm As AccessObject
For Each frm In Application.CurrentProject.AllForms
If frm.IsLoaded And frm.Name <> Me.Name Then
DoCmd.Close acForm, frm.Name
End If
Next frm
DoCmd.Close acForm, Me.Name
DoCmd.OpenForm "Авторизация"
End Sub
иМба Кодэк
HERE I AM