Острых челов прошу молчать!!!

Не мое
не проверял


Вопрос: Как программно отключить юзеров от базы?

Совет:
Latuk
Member

Откуда: Москва
Сообщений: 1261 У меня сделанно так:
Есть табличка пользователь,доступ
Юзер сканит таблицу раз в две минуты
по таймеру невидимой формы
если флаг доступа скинут,то предлагает пользователю завершится
сразу или дает ему две минуты на завершение текущих дел и завершается сама


Dim FlQuit As Boolean 'флаг отключения
Dim FlSructUpd As Boolean 'флаг обновления структуры
Dim FlVerUpd As Boolean 'флаг обновления версии
Dim QuitTime, CurTimer
Dim intCurCboRecUpd As Integer
Private Const lngIntervalProverki = 120000 'частота проверок флага доступа в милисекундах

Private Sub btNo_Click()
Me.TimerInterval = lngIntervalProverki / 12 'после включения авто завершения
Me.Visible = False 'проверять флаг доступа каждые 10 сек на случай отмены завершения
End Sub

Private Sub btYes_Click()
If FlSructUpd Then DoCmd.Quit Else UpdVer
End Sub

Private Sub Form_Open(Cancel As Integer)
'Me.Visible = False
FlVerUpd = True
FlQuit = True
FlSructUpd = True
Me.TimerInterval = lngIntervalProverki
intCurCboRecUpd = 0
End Sub

Private Sub Form_Timer()
Dim AcName As String


If Nz(DLookup("Dostup", "dbo.UP_Current_v"), False) Then 'проверить флаг доступа
'Проверка версии структуры базы
If intVerBStruct() < cnn.Execute("dbo.Ver_Max_p")("Struct_Max") Then
If FlSructUpd Then
lbl4.Caption = "На сервере обнаружена новая структура базы."
lbl1.Caption = "Необходимо обновление программы!"
lbl2.Caption = "Через две минуты вы будете обновлены автоматически."
lbl3.Caption = "Обновится сейчас ?"
FlSructUpd = False
Me.Visible = True
Me.SetFocus
QuitTime = TimeSerial(Hour(Now), Minute(Now) + lngIntervalProverki / 60000, Second(Now))
CurTimer = Timer
Me.TimerInterval = 1000 'обновлять раз в секунду
Else 'если завершение начато проверить прошло ли время ожидания если да то обновить версию
If Timer > CurTimer + lngIntervalProverki / 1000 Then UpdVer
'обновить поле оставшегося времени
Ostalos = QuitTime - TimeSerial(Hour(Now), Minute(Now), Second(Now))
End If
Else 'Проверка версии программы
If intVer_ID() < cnn.Execute("dbo.Ver_Max_p")("ID_Max") And FlVerUpd Then
If MsgBox("Обнаружена новая версия програмы.Обновить?", vbYesNo) = vbYes Then
UpdVer
Else 'если отказался то больше не спрашивать
FlVerUpd = False
End If
End If
End If

If FlQuit Then
On Error Resume Next
AcName = Screen.ActiveDatasheet.Name
If AcName = "" Then AcName = Screen.ActiveForm.Name
If AcName = "" Then AcName = Screen.ActiveReport.Name
' вместо "123" втавляй что хочеш (например номер тек документа) для идентификации записи с которой работает юзер в активной форме
' этот фрагмент нужен если хочеш заполнять лог чем занимается юзер
cnn.Execute "dbo.UL_P @FormName='" & AcName & ";" & Screen.ActiveControl.Name & "' ,@DocID=" & 123
On Error GoTo 0
Else 'если доступ разрешен после инициации завершения
FlQuit = True 'сбросить флаг отключения
Me.TimerInterval = lngIntervalProverki
Me.Visible = False
End If
Else
If FlQuit Then 'если доступ отключен и завершение не начато
lbl4.Caption = "По техническим причинам вы отключаетесь от базы."
lbl1.Caption = "Завершите работу с программой."
lbl2.Caption = "Через две минуты вы будете отключены автоматически."
lbl3.Caption = "Завершить работу сейчас ?"
FlQuit = False 'начать завершение
Me.Visible = True
Me.SetFocus
QuitTime = TimeSerial(Hour(Now), Minute(Now) + lngIntervalProverki / 60000, Second(Now))
CurTimer = Timer
Me.TimerInterval = 1000 'обновлять раз в секунду
Else 'если завершение начато проверить прошло ли время ожидания если да то выход
If Timer > CurTimer + lngIntervalProverki / 1000 Then DoCmd.Quit
'обновить поле оставшегося времени
Ostalos = QuitTime - TimeSerial(Hour(Now), Minute(Now), Second(Now))
End If
End If

End Sub

При открытии так-же проверяется флаг доступа
чтобы не дать юзеру запустится при сброшенном флаге.

Благодарю.