Совсем не хотелось создавать отдельную статью и отнимать у себя лишнее время, но пришлось, так как в коментах не удалось вписать такой большой объём. Данная статья является продолжением статьи, описывающей методику избавления неправильных сессий на терминальном серваке. Скрипт был преобразован и адаптирован под 2012 сервер!
Но самое интересное то, что скрипт не только адаптирован под работу на 2012 сервере, но также он не потерял свою работоспособность на 2003 терминальном сервере! На 2008 пока не удалось проверить, так как у меня такого на работе пока нету. Если кто сможет проверить, просьба потом отписаться в коментах.
Итак, смотрим, что получилось.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Скрипт следит за терминальными пользователями и выкидывает их сессии по условиям: '
' 1.По какой-либо причине не произошёл выход из сессии '
' 2.Пользователь не закрывает сессию более 8 часов! Просто какой-то кашмар - '
' пора домой, а они кричат: "Хлебом не корми - работу давай!" '
' Скрипт написал Анчуров Олег Владимирович в 2013 году. '
' Скрипт адаптирован под 2012 терминальный сервак в 2014 году. '
' Скрипт взят с сайта: http://ithelp.moy.su '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Dim WshShell, WshShell2
Dim objScriptExec, objScriptExec2
Set WshShell = CreateObject("Wscript.Shell")
Set WshShell2 = CreateObject("Wscript.Shell")
Set objScriptExec = WshShell.Exec("qUser.exe")
Dim User, Rdp, Id, Status, OffLine, TDate, TTime
Dim Line, Line2
Dim a, c, t, p, i, Reset
Dim Msg, k
Msg = "ПРОТОКОЛ РАБОТЫ СКРИПТА, АВТОМАТИЧЕСКИ ВЫКИДЫВАЮЩЕГО ПОЛЬЗОВАТЕЛЕЙ ИЗ ТЕРМИНАЛЬНЫХ СЕССИЙ НА ТЕРМИНАЛЬНОМ СЕРВАКЕ 1С:" + chr(13) + chr(10)
Msg = Msg + "МОСКОВСКИЙ ТЕРМИНАЛЬНЫЙ СЕРВЕР." + chr(13) + chr(10) + chr(13) + chr(10)
k = 0
'Dim apt(50) ' задаем размер массива(максимально возможное число пользователей)
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
a = a + InStr(User,"admin1") 'Эту учётку трогать низя!
a = a + InStr(User,"admin2") 'Эту учётку трогать низя!
a = a + InStr(User,"admin3") 'Эту учётку трогать низя!
a = a + InStr(User,"admin4") 'Эту учётку трогать низя!
'Остальные учётки проверяем дальше...
If a = 0 then 'Если логин не в списке исключений, то проверяем показатели учётки...
c = 0
t = 0
p = 0
If Rdp <> "" then 'Исключительно для 2012 сервака проверка, так как по параметру OffLine нельзя в нём определить некорректное отключение от сессии!
If OffLine = "отсутствует" then c = c + 1 'Если была закрыта сессия просто крестиком или по какой-либо причине не произошёл выход из системы, то сразу необходимо выкинуть пользователя из сессии!
p = InStr(OffLine,":")
If p > 0 then
d = InStr(OffLine,"+") 'Если имеется +, то это значит, что больше суток идёт простаивание (цифра перед плюсом - количество суток), соответственно сразу выкидываем из сессии!
If d > 0 then
c = c +1
Else 'иначе проверяем количество времени простоя
t = CDbl(Left(OffLine,p - 1))
If t > 8 then c = c + 1 'Если пользователь не выключает комп на ночь и его сессия простаивает больше 8 часов, то тоже выкидываем из сессии!
End If
End If
Else
c = c + 1 ' В 2012 серваке параметр Rdp будет пустым в случае некоректного отключения пользователя от сессии!
End If
If c > 0 then
Reset = "logoff " & Id 'Команду LogOff можно заменить на Reset Session. Кому что больше подходит.
Set objScriptExec2 = WshShell2.Exec(Reset)
Msg = Msg + "Отключен пользователь: " + User + chr(13) + chr(10)
Msg = Msg + "Значения параметров команды QUser для данного пользователя: " + chr(13) + chr(10)
Msg = Msg + " Пользователь: " + User + chr(13) + chr(10)
Msg = Msg + " Сеанс: " + Rdp + chr(13) + chr(10)
Msg = Msg + " ID: " + Id + chr(13) + chr(10)
Msg = Msg + " Статус: " + Status + chr(13) + chr(10)
Msg = Msg + " Бездействие: " + Offline + chr(13) + chr(10)
Msg = Msg + " Время входа: " + TDate + "/" + TTime + chr(13) + chr(10) + chr(13) + chr(10)
k = k + 1
WScript.Sleep 3000 'Это время (в млсек) ждёт скрипт, пока будет исполнена команда Logoff.
End If
End If
End If
Loop
Set objScriptExec = Nothing
Set WshShell = Nothing
Set objScriptExec2 = Nothing
Set WshShell2 = Nothing
If k > 0 then
Dim objEmail
MSG = MSG + "Всего отключено контактов: " + CStr(k) + chr(13) + chr(10) + chr(13) + chr(10)
MSG = MSG + "Время/дата отработки скрипта: " + CStr(Time) + "/" + CStr(Date) + chr(13) + chr(10)
'WScript.Echo(MSG)
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 = "Отчёт по работе скрипта 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
Жизнь админа должна быть проще.
| 
