Это финальное продолжение моей давней разработки скрипта, автоматического выкидывания пользователей на терминальном сервере. Больше этот скрипт переделывать не собираюсь, так как на мой взгляд он достиг совершенства!
Что нового:
- Исправлен страшный косяк, связанный с нечаянным отключением терминальных сессий. Дело в том, что в процессе работы было выявлено, что по вине провайдеров иногда бывают кратковременные провалы интернета и скрипт просто-напросто выкидывал сессии пользователей без разбора. В новой финальной версии я научил скрипт проверять достоверность обрыва сессии повторными проверками (у меня их 10) и в случае, если все эти проверки показывают, что связь разорвана, то только в этом случае происходит отключение сессии.
- По просьбам трудящихся была добавлена возможность править некоторые параметры работы скрипта, изменяя закомментированные переменные в начале скрипта.
Сам скрипт RDP_Reset.vbs:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Скрипт следит за терминальными пользователями и выкидывает их сессии по условиям: '
' 1.По какой-либо причине не произошёл выход из сессии '
' 2.Пользователь не закрывает сессию более 8 часов! Просто какой-то кашмар - '
' пора домой, а они кричат: "Хлебом не корми - работу давай!" '
' Скрипт исправил Анчуров Олег Владимирович в 2016 году. '
' Финальная версия в 2017 году. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Dim WshShell, objScriptExec, CMPName
Set WshShell = CreateObject("Wscript.Shell")
Dim Apt(7, 50) ' задаем размер массива(максимально возможное число пользователей, например 50)
Dim User, Rdp, Id, Status, OffLine, TDate, TTime
Dim Line, Line2
Dim a, c, t, p, i, Reset
Dim Msg, k1, k2
Dim Pause, Kol, MaxHour
Dim ind, kApt, kId
Dim AdminovNeTrogaem, Zolushka
CMPName = WshShell.ExpandEnvironmentStrings("%computername%")
Msg = "ПРОТОКОЛ РАБОТЫ СКРИПТА, АВТОМАТИЧЕСКИ ВЫКИДЫВАЮЩЕГО ПОЛЬЗОВАТЕЛЕЙ ИЗ ТЕРМИНАЛЬНЫХ СЕССИЙ НА ТЕРМИНАЛЬНОМ СЕРВАКЕ 1С:" & vbCrLf
Msg = Msg + "Имя сервера: " + CMPName & vbCrLf & vbCrLf
k1 = 0
k2 = 0
kApt = -1
Pause = 10 ' Размер паузы в секундах между повторными проверками
Kol = 10 ' Количество проверок в разах
MaxHour = 8 ' Максимальное количество часов неактивности сесиии, если < 1 то не будет проверки.
AdminovNeTrogaem = True ' Учётки админов не трогаем (true - админов не трогаем/false - админов трогаем).
Zolushka = True ' В полночь закрываем все сессии, даже администраторские (true - выкидываем всех/false - не выкидываем). Этот параметр стоит выше параметра AdminovNeTrogaem и на него не обращает внимания!
Msg = Msg + "Количество проверок скрипта (в разах): " + CStr(Kol) & vbCrLf
Msg = Msg + "Длительность паузы между проверками (в секундах): " + CStr(Pause) & vbCrLf & vbCrLf
Msg = Msg + String(48, "*") & vbCrLf & vbCrLf
h = Hour(Now)
For ind = 1 To Kol
Set objScriptExec = WshShell.Exec("qUser.exe")
Do Until objScriptExec.StdOut.AtEndOfStream
Line = objScriptExec.StdOut.ReadLine
Line2 = ""
'Производим перекодировку текста из Dos в ANSI:
For i = 1 to Len(Line)
a = Asc(Mid(Line,i,1))
If a < 128 then Line2 = Line2 + chr(a)
If a > 127 and a < 176 then Line2 = Line2 + chr(a + 64)
If a > 175 and a < 224 then Line2 = Line2 + chr(a)
If a > 223 and a < 240 then Line2 = Line2 + chr(a + 16)
If a = 240 then Line2 = Line2 + chr(168)
If a = 241 then Line2 = Line2 + chr(184)
If a > 241 then Line2 = Line2 + chr(a)
Next
Line = Line2
'Разщипляем строку на составляющие
User = LCase(Trim(Mid(Line, 2, 22)))
Rdp = LCase(Trim(Mid(Line, 24, 16)))
Id = LCase(Trim(Mid(Line, 40, 6)))
Status = LCase(Trim(Mid(Line, 47, 8))) 'Если нужно, то раскоментировать!
OffLine = LCase(Trim(Mid(Line, 55, 11)))
TDate = LCase(Trim(Mid(Line, 66, 11))) 'Если нужно, то раскоментировать!
TTime = LCase(Trim(Mid(Line, 77, 6))) 'Если нужно, то раскоментировать!
'Первая строка нас не интересует!
'Переменная Rdp может принимать следующие значения:
'rdp-tcp#xxx - стандартный клиент RDP
'console - консоль, например из DameWare
'пустая строка - пользователь отключился некорректно
If Rdp <> "сеанс" Then 'Те пользователи, кто в сеансе, их не трогаем! Остальных проверяем по логину....
a = 0
If AdminovNeTrogaem Then
' Список администраторов, которых трогать не нужно выкидывать из сессий.
' Список может содержать любое количество записей и даже отсутствовать!
a = a + InStr(User,"admin1") 'Эту учётку трогать низя!
a = a + InStr(User,"admin2") 'Эту учётку трогать низя!
a = a + InStr(User,"admin3") 'Эту учётку трогать низя!
a = a + InStr(User,"admin4") 'Эту учётку трогать низя!
End If
'Остальные учётки проверяем дальше...
If h = 0 And Zolushka Then a = 0 'В период времени с 0:00 до 0:59 будут отключены абсолютно все учётные записи, даже администраторские!
If a = 0 then 'Если логин не в списке исключений, то проверяем показатели учётки...
c = 0
t = 0
p = 0
If Rdp <> "" then 'Исключительно для 2012 сервака проверка, так как по параметру OffLine нельзя в нём определить некорректное отключение от сессии!
If OffLine = "отсутствует" then
c = c + 1 'Если была закрыта сессия просто крестиком или по какой-либо причине не произошёл выход из системы, то сразу необходимо выкинуть пользователя из сессии!
Else
If OffLine = "." Then OffLine = "0:00"
p = InStr(OffLine, ":")
If p = 0 Then OffLine = "0:" + OffLine
End If
p = InStr(OffLine, ":")
If p > 0 then
'Проверяем количество времени простоя
d = InStr(OffLine, "+")
t = CDbl(Left(OffLine, p - 1)) + 24 * CDbl(Left(OffLine, d - 1))
If t > MaxHour then c = c + 1 'Если время сессии больше заданной переменной MaxHour, то выкидываем из сессии!
End If
Else
c = c + 1 ' В 2012 серваке параметр Rdp будет пустым в случае некоректного отключения пользователя от сессии!
End If
If c > 0 then
kId = -1
For ik = 0 To kApt
If Apt(2, ik) = Id Then
kId = ik
Exit For
End If
Next
If kId < 0 Then
kApt = kApt + 1
Apt(0, kApt) = User
Apt(1, kApt) = RDP
Apt(2, kApt) = Id
Apt(3, kApt) = Status
Apt(4, kApt) = OffLine
Apt(5, kApt) = TDate
Apt(6, kApt) = TTime
Apt(7, kApt) = 1
Else
Apt(7, kId) = Apt(7, kId) + 1
End If
End If
End If
End If
Loop
WScript.Sleep (Pause * 1000) ' Выдерживаем паузу между опросами, дабы выявить нестабильные каналы связи
Next
For ik = 0 To kApt
User = Apt(0, ik)
RDP = Apt(1, ik)
Id = Apt(2, ik)
Status = Apt(3, ik)
OffLine = Apt(4, ik)
TDate = Apt(5, ik)
TTime = Apt(6, ik)
kId = Apt(7, ik)
If kId = Kol Then
Reset = "logoff " & Id 'Команду LogOff можно заменить на Reset Session. Кому что больше подходит.
Set objScriptExec = WshShell.Exec(Reset)
Msg = Msg + "Отключен пользователь: " + User & vbCrLf
Msg = Msg + "Значения параметров команды QUser для данного пользователя: " & vbCrLf
Msg = Msg + " Сеанс: " + Rdp & vbCrLf
Msg = Msg + " ID: " + Id & vbCrLf
Msg = Msg + " Статус: " + Status & vbCrLf
Msg = Msg + " Бездействие: " + Offline & vbCrLf
Msg = Msg + " Время входа: " + TDate + "/" + TTime & vbCrLf & vbCrLf
k2 = k2 + 1
WScript.Sleep 3000 'Это время (в млсек) ждёт скрипт, пока будет исполнена команда Logoff.
End If
If kId > 0 And kId < Kol Then
k1 = k1 + 1
End If
Next
If k2 > 0 Then
Msg = Msg + "Итоги: " + String(41, "-") & vbCrLf
MSG = MSG + "Всего отключено пользователей: " + CStr(k2) & vbCrLf & vbCrLf
Msg = Msg + String(48, "*") & vbCrLf & vbCrLf
End If
If k1 > 0 Then
Msg = Msg + "Обнаружены нестабильные сесиии!" & vbCrLf
MSG = MSG + "Список нестабильных сессий:" & vbCrLf
Msg = Msg + String(48, "-") & vbCrLf & vbCrLf
End If
k1 = 0
For ik = 0 To kApt
User = Apt(0, ik)
RDP = Apt(1, ik)
Id = Apt(2, ik)
Status = Apt(3, ik)
OffLine = Apt(4, ik)
TDate = Apt(5, ik)
TTime = Apt(6, ik)
kId = Apt(7, ik)
If kId > 0 And kId < Kol Then
Msg = Msg + "Пользователь с нестабильной сессией: " + User & vbCrLf
Msg = Msg + "Значения параметров команды QUser для данного пользователя: " & vbCrLf
Msg = Msg + " Сеанс: " + Rdp & vbCrLf
Msg = Msg + " ID: " + Id & vbCrLf
Msg = Msg + " Статус: " + Status & vbCrLf
Msg = Msg + " Бездействие: " + Offline & vbCrLf
Msg = Msg + " Время входа: " + TDate + "/" + TTime & vbCrLf & vbCrLf
k1 = k1 + 1
End If
Next
If k1 > 0 Then
Msg = Msg + "Итоги: " + String(41, "-") & vbCrLf
MSG = MSG + "Всего нестабильных сессий пользователей: " + CStr(k1) & vbCrLf & vbCrLf
Msg = Msg + String(48, "*") & vbCrLf & vbCrLf
MSG = MSG + "Стоит обратить внимание на тот факт, что есть нестабильные сессии!" & vbCrLf
MSG = MSG + "Это может быть связано с несколькими причинами." & vbCrLf
MSG = MSG + "Например:" & vbCrLf
MSG = MSG + " 1. Где-то глючат каналы связи у промежуточных провайдеров;" & vbCrLf
MSG = MSG + " 2. Не хватает полосы пропускания у Вашего провайдера для одновременного доступа такого количества одновременных сессий;" & vbCrLf
MSG = MSG + " (советуется проверить доступность удалённых узлов с помощью утилит командной строки: ping, tracert, nslookup и pathping);" & vbCrLf
MSG = MSG + " 3. У Вашего сервера не хватает ресурсов для терминального доступа такого количества пользователей." & vbCrLf
MSG = MSG + " (советуется проверить ресурсы терминального сервера с помощью монитора ресурсов);" & vbCrLf & vbCrLf
End If
Set objScriptExec = Nothing
Set WshShell = Nothing
If k1 + k2 > 0 then
Dim objEmail
MSG = MSG + "Время/дата отработки скрипта: " + CStr(Time) + "/" + CStr(Date) & vbCrLf & vbCrLf
Const EmailFrom = "bot@firma.ru" ' от кого будет отправляться e-mail
Const EmailPassword = "SuperPassword" ' пароль от e-mail
Const strSmtpServer = "smtp.firma.ru" ' smtp сервер
Const EmailTo = "admin@firma.ru" ' Кому будет отправляться e-mail
Set objEmail = CreateObject("CDO.Message")
objEmail.From = EmailFrom
objEmail.To = EmailTo
objEmail.Subject = CMPName + ": Отчёт по работе скрипта RDP_Reset" 'Тема письма
objEmail.Textbody = MSG
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = EmailFrom
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = EmailPassword
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
Set objEmail = Nothing
End If
Некоторые выводы, сделанные мною в процессе использования финальной версии скрипта:
- На моё удивление, скрипт стал работать примерно в два раза быстрее!
- Жалобы, связанные с внезапным отключением терминальных сессий прекратились от сотрудников!
Берите, правьте, пользуйтесь на здоровье!
Жизнь админа должна быть проще! | 
