• Выключение компьютера после некоторого числа неправильных аутенфикаций.
• Посредством таймера ограничиваем время работы с формой. По окончанию выделенного промежутка - выключение системы.
• Отключение рабочего стола на время заполнения, а также добавление программы в автозагрузку при закрытии формы.
• Отдельный вход администратору.

' Код формы frmAuth
Dim Pass As String ' правильный пароль
Dim schet As String ' число попыток ввода
Dim patch As String ' полный путь к файлу настроек
Dim sysdir As String  ' путь к системному каталогу
Dim slength As Long  ' длина возвращаемой строки
Dim checks As String ' переменная блокирующая учетную запись
Dim sec As Long ' число оставшихся секунд
Dim dux As Long ' число оставшихся попыток

Private Sub Command1_Click()
sysdir = Space(255)  ' отводим место для получения строки в буфере
slength = GetSystemDirectory(sysdir, 255)
sysdir = Left(sysdir, slength)  ' получаем имя из буфера
patch = sysdir + "\" + "users.ini" ' создаем путь к файлу настроек

' ФОРМАТ ЧТЕНИЯ ФАЙЛА НАСТРОЕК:
' Переменная = GetINI(путь к файлу, "Пользователь", "Параметр", по умолчанию)

' Чтение из файла настроек пароля выбранного пользователя
Pass = GetINI(patch, List1.Text, "Password", "")

' Проверяем в файле: блокирован ли выбранный пользователь
checks = GetINI(patch, List1.Text, "Check1", "")

' Если выбран администратор, то он точно не блокирован
If List1.Text = "Администратор" Then GoTo 1
If checks <> 1 Then
1: If schet < 3 Then

' Праверка правильности пароля
 If Text1.Text = Pass Then

' {!!!}
' Если правильно - открываем основную форму программы
' {!!!}

Desktop True ' включаем рабочий стол

schet = 0 ' обнуляем переменную
Unload Me
Else
schet = schet + 1 ' увеличиваем счетчик на единицу
dux = 3 - schet ' число оставшихся попыток
MsgBox "Введен неверный пароль! Осталось попыток: " & dux, , "'ERROR'"
Text1.Text = ""
End If
Else
MsgBox "Неверный пароль введен уже 3 раза. Доступ к ПК закрыт!", , "'ERROR'"

GoTo 2

End If
Else
MsgBox "Доступ к этой учетной записи закрыт!", , "'ERROR'"

2: ' {!!!}
' Выключить компьютер и снова добавить в автозагрузку
' {!!!}

End If
End Sub

Private Sub Form_Load()
sec = 61 ' начинаем обратный отсчет

' {!!!}
' Устанавливаем форму поверх всех окон
' {!!!}

schet = 0 ' устанавливаем счетчик на ноль
Call OpenItems(Me.List1) ' загружаем список юзеров в листбокс
Desktop False ' отрубаем рабочий стол
End Sub

Private Sub List1_Click()
Text1.SetFocus
End Sub

Private Sub List1_DblClick()
Command1_Click
End Sub

Private Sub Timer1_Timer()
sec = sec - 1 ' обратный отсчет
Frame1.Caption = "Осталось " & sec & " сек."
If sec = 0 Then ' время исчерпано

' {!!!}
' Выключить компьютер и снова добавить в автозагрузку
' {!!!}

End If
End Sub

Private Sub Timer2_Timer()
On Error GoTo handle
List1.ListIndex = 0
Timer2.Enabled = False
handle: Exit Sub
End Sub

' Код модуля mdlAuth
Dim patch As String ' полный путь к файлу настроек
Dim sysdir As String  ' путь к системному каталогу
Dim slength As Long  ' длина возвращаемой строки

' ЧТЕНИЕ ФАЙЛА СО СПИСКОМ ПОЛЬЗОВАТЕЛЕЙ
Public Sub OpenItems(lstin As ListBox)
sysdir = Space(255)  ' отводим место для получения строки в буфере
slength = GetSystemDirectory(sysdir, 255)
sysdir = Left(sysdir, slength)  ' получаем имя из буфера
patch = sysdir + "\" + "users.ini" ' создаем путь к файлу настроек

Dim i As Integer
Dim str As String
' Если есть файл "lists.ini в котором список пользователей то открываем его
If Len(Dir(sysdir & "\" & "lists.ini")) Then
Open sysdir & "\" & "lists.ini" For Input As #1
Do While Not EOF(1)
Line Input #1, str
frmAuth.List1.AddItem str 'добавляем пользователя в листбокс для выбора
Loop
Close #1
End If
End Sub

' ЗАПИСЬ ФАЙЛА СО СПИСКОМ ПОЛЬЗОВАТЕЛЕЙ
Public Sub Saveitems(lstin As ListBox)
sysdir = Space(255)  ' отводим место для получения строки в буфере
slength = GetSystemDirectory(sysdir, 255)
sysdir = Left(sysdir, slength)  ' получаем имя из буфера
patch = sysdir + "\" + "users.ini" ' создаем путь к файлу настроек

Dim i As Integer
Open sysdir & "\" & "lists.ini" For Output As #1
For i = 0 To lstin.ListCount - 1
Print #1, lstin.List(i)
Next i
Close #1
End Sub

' Код модуля mdlOther

' ОТКЛЮЧЕНИЕ РАБОЧЕГО СТОЛА
Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, _
ByVal fEnable As Long) As Long

Const SW_HIDE = 0
Const SW_SHOW = 5

Public Sub Desktop(Visible As Boolean)
Dim hWnd As Long
hWnd = FindWindow("Progman", "Program Manager")
If Visible Then
ShowWindow hWnd, SW_SHOW
Else
ShowWindow hWnd, SW_HIDE
End If
EnableWindow hWnd, Visible
End Sub

' ЧТЕНИЕ И ЗАПИСЬ В ФАЙЛ INI
Declare Function GetPrivateProfileString& Lib _
"kernel32" Alias "GetPrivateProfileStringA" (ByVal _
lpszSection$, ByVal lpszKey$, ByVal lpszDefault$, _
ByVal lpszReturnBuffer$, ByVal cchReturnBuffer&, _
ByVal lpszFile$)
Declare Function WritePrivateProfileString Lib _
"kernel32" Alias "WritePrivateProfileStringA" (ByVal _
lpApplicationName As String, ByVal lpKeyName As String, _
ByVal lpString As String, ByVal lplFileName As String) As Long

' Чтение
Public Function GetINI(INIfile As String, Section As String, _
Key As String, Default As String)
'Call Admin.DeCode
Dim temp As String * 256
Dim length As Integer
temp = Space$(256)
length = GetPrivateProfileString(Section, Key, _
Default, temp, 255, INIfile)
GetINI = Left$(temp, length)
'Call Admin.Code
End Function

' Запись
Public Sub SetINI(INIfile As String, Section As String, _
Key As String, Value As String)
'Call Admin.DeCode
Dim n As Integer
Dim temp As String
temp = Value
For n = 1 To Len(Value)
If Mid$(Value, n, 1) = vbCr Or Mid$(Value, n, 1) = vbLf _
Then Mid$(Value, n) = ""
Next n
n = WritePrivateProfileString(Section, Key, temp, INIfile)
'Call Admin.Code
End Sub