Система удалённого сброса терминальных сессий. Под данным вопросом понимается система, которая способна автономно сбрасывать зависшие сессии в терминальном сервере даже если компьютер пользователя находится вне сети организации (например сотрудник уехал в командировку). Да, конечно можно использовать vpn, но хотелось сделать, чтобы было как можно проще для конечного юзера, что и навело на мысль использования нескольких прокладок в реализации этого небольшого проекта.
Итак с самого начала по порядку.
Была поставлена задача, чтобы любой сотрудник (в сети или за её пределами) мог в любой момент отправить команду сброса его терминальной сессии на сервер.
Так как vpn у нас настроен не у всех сотрудников, а так же есть филиал в отдельной подсети, то мною было принято решение сделать подобие системы приёма интернет-заказов магазинов. В таких системах сервер сам заказ получает по электронной почте с сайта интернет-магазина. Этот момент очень важный, так как эта прокладка не позволяет взломать сам сервер. Вторым важным моментом было принято решение зашифровать скрипт отправки электронной почты, дабы скрыть данные.
Скрипт ResetSession.js (скрипт написан на Java):
/* ****************************************************************
* The script sends a command to reset the terminal session *
* The script was written by Oleg Vladimirovich Anchurov in 2020. *
******************************************************************/
var WshShell = WScript.CreateObject("WScript.Shell");
var question = '\u0020\u0412\u044b\u0020\u0434\u0435\u0439\u0441\u0442\u0432\u0438\u0442\u0435\u043b\u044c\u043d\u043e\u0020\u0445\u043e\u0442\u0438\u0442\u0435\u0020\u043e\u0442\u043f\u0440\u0430\u0432\u0438\u0442\u044c\u0020\u043a\u043e\u043c\u0430\u043d\u0434\u0443\u0020\u0441\u0431\u0440\u043e\u0441\u0430\u0020\u0441\u0435\u0441\u0441\u0438\u0438\u0020\u043d\u0430\u0020\u0442\u0435\u0440\u043c\u0438\u043d\u0430\u043b\u044c\u043d\u044b\u0439\u0020\u0441\u0435\u0440\u0432\u0435\u0440\u0020\u0031\u0421\u003f';
var title = '\u0020\u0412\u043e\u043f\u0440\u043e\u0441';
var result = WshShell.Popup(question, 0, title, 1);
if (result == 1) {
var CmpName = WshShell.ExpandEnvironmentStrings("%computername%");
var UserName = WshShell.ExpandEnvironmentStrings("%username%");
var EmailFrom = 'script@myfirma.ru'; / Заменяем на свои данные
var EmailTo = 'robot@myfirma.ru'; / Заменяем на свои данные
var strSmtpServer = 'smtp.myfirma.ru'; / Заменяем на свои данные
var EmailPassword = 'SuperPuperPassword'; / Заменяем на свои данные
var Subject = "RS";
var Textbody = '\u0418\u043d\u0444\u043e\u0440\u043c\u0430\u0446\u0438\u044f\u0020\u043e\u0020\u0441\u0431\u0440\u0430\u0441\u044b\u0432\u0430\u0435\u043c\u043e\u0439\u0020\u0441\u0435\u0441\u0441\u0438\u0438';
Textbody += ':\r\n';
Textbody += '(' + CmpName + ',' + UserName + ')\r\n';
Textbody += '\u041a\u043e\u043d\u0435\u0446\u0020\u0438\u043d\u0444\u043e\u0440\u043c\u0430\u0446\u0438\u0438';
Textbody += '.\r\n';
try {
var objEmail = new ActiveXObject("CDO.Message");
objEmail.From = EmailFrom;
objEmail.To = EmailTo;
objEmail.Subject = Subject;
objEmail.Textbody = Textbody;
objEmail.Bodypart.Charset = 'windows-1251';
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2;
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.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.Update();
objEmail.Send();
var MSG = '\u0421\u043e\u043e\u0431\u0449\u0435\u043d\u0438\u0435\u0020\u043e\u0020\u0441\u0431\u0440\u043e\u0441\u0435\u0020\u0441\u0435\u0441\u0441\u0438\u0438\u0020';
MSG += UserName;
MSG += '\u0020\u0443\u0441\u043f\u0435\u0448\u043d\u043e\u0020\u043e\u0442\u043f\u0440\u0430\u0432\u043b\u0435\u043d\u043e';
WScript.Echo(MSG);
} catch(e) {
var MSG = Textbody;
MSG += '\nError!!!\n' + "Number: " + e.number + '\nDescription: ' + e.description;
WScript.Echo(MSG);
}
}
WScript.Quit();
Данный скрипт я зашифровал с помощью скрипта-шифровальщика. Перед шифровыванием необходимо исправить настройки почтового сервера на свои (строки помечены красным).
Далее мне нужен был какой-либо компьютер или сервер с постоянно работающей электронной почтой. Мой выбор пал на сервер, на котором уже был установлен Microsoft Outlook для приёма информации от банка. На данном сервере уже был настроен скрипт автоматического сохранения входящих вложений в папку (пример), а 1С уже сам следил за содержанием этой папки и забирал оттуда все файлы для дальнейшего парсинга. Я договорился со своим начальником и добавил свои скрипты в Outlook, которые делают аналогичную процедуру, а также я добавил систему поиска электронной почты сотрудника в Active Directory для двух целей: так как в нашей конторе у всех учётных записей пользователей прописана электронная почта в соответствующем атрибуте mail, то я решил найчить Outlook отыскивать почтовые ящики пользователей, чтобы потом по этому адресу скрипт сброса терминальных сессий отправлял отчёт.
Также на терминальном сервере необходимо создать расшаренную папку для приёма информации о сбрасываемых сессиях. В моём случае я создал папку Input (пример создания) и дал права доступа на запись пользователям домена.
Ниже приведён скрипт RedirectCommandToRDPServer и 2 функции AllowedCharacters и FindEmailFromAD, которые необходимо в Outlook прописать в разделе (General) во вкладке "Разработчик" > VisualBasic:
Public Sub RedirectCommandToRDPServer(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment ' Переменная для работы с вложениями
Dim saveFolder As String ' Переменная для пути к папке сохранения
Dim dateFormat As String ' Переменная для даты письма
Dim SenderEmailAddress As String ' Переменная для адреса
Dim strBody As String ' Переменная для тела письма
Dim FSO, File, fn, cLine
Dim Login As String
'Определяем отправителя и текст письма
'SenderEmailAddress = itm.SenderEmailAddress
strBody = Trim(CStr(itm.Body))
Simvol1 = InStr(strBody, "(")
Simvol2 = InStr(strBody, ")")
If Simvol1 > 0 And Simvol2 > 0 Then
strBody2 = Mid(strBody, Simvol1 + 1, Simvol2 - Simvol1 - 1)
Zapyataya = InStr(strBody, ",")
If Zapyataya > 0 Then
aBody = Split(strBody2, ",")
SenderEmailAddress = itm.SenderEmailAddress
'Задаём путь к папке сохранения
saveFolder = "\\RDPSRV\Input" ' Необходимо сменить на свой адрес расшаренной папки.
fn = saveFolder + "\ResetSession.txt"
Login = AllowedCharacters(Trim(aBody(1)))
If Login <> "" Then
EmailAddress = FindEmailFromAD(Login)
cLine = "reset session equal " + Login
If EmailAddress <> "" Then cLine = cLine + ":" + EmailAddress
Set FSO = CreateObject("Scripting.FileSystemObject")
Set File = FSO.OpenTextFile(fn, 8, True) ' 8 - Добавить к файлу.
File.WriteLine (cLine)
Set FSO = Nothing ' Чистим память
File.Close
End If
End If
End If
End Sub
В данном скрипте красным отмечено место, где необходимо исправить место сохранения файла ResetSession.txt (помечено красным). Данный файл записывается по принцыпу дозаписи к концу файла, а скрипт, который его разбирает и распарсивает (приведён в конце статьи), после парсинга удаляет файл ResetSession.txt.
Далее функция, которая убирает лишние символы при парсинге входящей почты:
Function AllowedCharacters(InputText)
AllowedCharacters = ""
ListAllowedCharacters = Split("q w e r t y u i o p a s d f g h j k l z x c v b n m , Q W E R T Y U I O P A S D F G H J K L Z X C V B N M", " ")
For i = 1 To Len(InputText)
Simvol = Mid(InputText, i, 1)
For j = 0 To 52
If Simvol = ListAllowedCharacters(j) Then AllowedCharacters = AllowedCharacters + Simvol
Next j
Next i
End Function
Далее функция, которая пытается найти адрес электронной почты по логину пользователя (функция универсальная и не привязана к домену!):
Function FindEmailFromAD(Login)
FindEmailFromAD = ""
' Итак, поехали
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext") ' Определяем имя домена
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDNSDomain & ">"
' Найти все активные учетные записи.
' Коды UseraccountControl тут: http://support.microsoft.com/kb/305144
' Все коды аттрибутов тут: http://www.computerperFormance.co.uk/Logon/LDAP_attributes_active_directory.htm
strFilter = "(&(objectCategory=person)(objectClass=user))" ' - запрос по всем пользователям
' В переменной strAttributes обязательно перечисляем список атрибутов, которые переносятся, иначе работать не будет!
strAttributes = "useraccountcontrol,sAMAccountName,mail"
' Формируем строку запроса.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
' Выполним запрос.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 1000 ' Максимальное количество пользователей, которое получит в ответе запрос к AD!
adoCommand.Properties("Timeout") = 307
adoCommand.Properties("Cache Results") = False
Set objRS = adoCommand.Execute
' Обработаем полученные данные из запроса
While Not objRS.EOF And FindEmailFromAD = ""
strUserAccountControl = objRS.Fields("useraccountcontrol").Value
uac = CLng(strUserAccountControl)
strUserAccountControl2 = ""
del = 8388608
For i = 1 To 24
a = uac \ del
strUserAccountControl2 = strUserAccountControl2 + CStr(a)
If a Then uac = uac - del
del = del / 2
Next
strUserAccountControl2 = Mid(strUserAccountControl2, 15, 1) + Mid(strUserAccountControl2, 23, 1)
If strUserAccountControl2 = "10" Then ' Незаблокированные учётные записи
' Получение информации
strMail = objRS.Fields("mail").Value
If strMail <> "" Then
strsAMAccountName = objRS.Fields("sAMAccountName").Value
If strsAMAccountName = Login Then
FindEmailFromAD = strMail
End If
End If
End If
objRS.MoveNext
Wend
Set adoCommand = Nothing ' Чистим память
Set adoConnection = Nothing ' Чистим память
End Function
Далее создаём в задание, что если приходит письмо от адреса script@myfirma.ru (Заменяем на свои данные) и в теме письма содержится "RS", то необходимо запустить Проект1.ThisOutlookSession.RedirectCommandToRDPServer.
Теперь переходим на терминальный сервер (в качестве примера в скрипте указано название RDPSRV). На этом сервере необходимо создать задание (пример создания), которое будет запускаться (например каждые 5 минут) и выполнять скрипт, который представляет из себя модифицированный скрипт, в основе которго использовал ранее зарекомендовавший себя скрипт сброса терминальных сессий, но пришлось его допилить (добавил парсер файла ResetSession.txt и возможность отправки отчёта не только админу, но и пользователю, если скрипты vba в Outlook (указанные выше) успешно найдут почту пользователя по логину.
Сам скрипт RDP_Reset_commands.vbs:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Скрипт следит за терминальными пользователями и выкидывает их сессии по условиям: '
' 1.По какой-либо причине не произошёл выход из сессии '
' 2.Пользователь не закрывает сессию более 8 часов! Просто какой-то кашмар - '
' пора домой, а они кричат: "Хлебом не корми - работу давай!" '
' Скрипт исправил Анчуров Олег Владимирович в 2021 году. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Dim WshShell, objScriptExec, CMPName
Set WshShell = CreateObject("Wscript.Shell")
Dim Apt(7, 150) ' задаем размер массива(максимально возможное число пользователей, например 50)
Dim User, Rdp, Id, Status, OffLine, TDate, TTime
Dim Line, Line2
Dim a, c, t, p, i, Reset
Dim Msg, Msg2, k2
Dim ind, kApt, kId
Dim Parametr, Parametr0, Parametr1, Parametr2, Parametr3, Parametr4
Dim FSO
Dim str, Arg
Dim Sdvig
Function DosToAnsi(Dos)
DosToAnsi = ""
'Convert Dos text to ANSI text:
For i = 1 to Len(Dos)
a = Asc(Mid(Dos,i,1))
If a < 128 then DosToAnsi = DosToAnsi + chr(a)
If a > 127 and a < 176 then DosToAnsi = DosToAnsi + chr(a + 64)
If a > 175 and a < 224 then DosToAnsi = DosToAnsi + chr(a)
If a > 223 and a < 240 then DosToAnsi = DosToAnsi + chr(a + 16)
If a = 240 then DosToAnsi = DosToAnsi + chr(168)
If a = 241 then DosToAnsi = DosToAnsi + chr(184)
If a > 241 then DosToAnsi = DosToAnsi + chr(a)
Next
End Function
CMPName = WshShell.ExpandEnvironmentStrings("%computername%")
Msg = "ПРОТОКОЛ РАБОТЫ СКРИПТА, ВЫКИДЫВАЮЩЕГО ПОЛЬЗОВАТЕЛЕЙ ИЗ ТЕРМИНАЛЬНЫХ СЕССИЙ НА ТЕРМИНАЛЬНОМ СЕРВАКЕ 1С:" & vbCrLf
Msg = Msg + "Ручной модуль сброса зависших сессий." + vbCrLf
Msg = Msg + "Имя сервера: " + CMPName & vbCrLf & vbCrLf
k2 = 0
kApt = -1
Parametr = False
Parametr1 = "include" ' Параметр соответствия
Parametr3 = "logoff" ' Параметр действия
Parametr4 = "" ' Адрес электронной почты
Set FSO = CreateObject("Scripting.FileSystemObject")
fn = "C:\Input\ResetSession.txt"
'msgbox(fn)
'msgbox(FSO.FileExists(fn))
If FSO.FileExists(fn) Then
Set File = FSO.GetFile(fn)
Set TS = File.OpenAsTextStream(1)
While Not TS.AtEndOfStream
str = TS.ReadLine()
str = LCase(str)
str = Replace(str,"session","")
strArr = Split(str," ")
Msg = Msg + " СТРОКА ПОТОКА: " + str & vbCrLf & vbCrLf
For Each Ind in strArr
Arg = Trim(Ind)
' Возможно условие с отрицанием
If Arg = "not" Then
Parametr0 = Arg
Parametr = True
ElseIf Arg = "include" Then ' Допустимые значения (обязательный параметр, но по умолчанию и в случае ошибки примет значение logoff): include (содержит), equal (равен) или like
Parametr1 = Arg
Parametr = True
ElseIf Arg = "equal" Or Arg = "=" Then
Parametr1 = "equal"
Parametr = True
ElseIf Arg = "logoff" Then ' Допустимые значения (необязательный параметр, по умолчанию logoff): logoff или reset
Parametr3 = Arg
Parametr = True
ElseIf Arg = "reset" Then
Parametr3 = "reset session"
Parametr = True
ElseIf Arg = "<>" Then
Parametr0 = "not"
Parametr1 = "equal"
Parametr = True
Else ' Допустимые значения (имя/часть имени пользователя или похожее этому имени значение): любое
Parametr2 = Arg ' Параметр: логиин пользователя (Если после параметра стоит двоеточие и e-mail пользователя, то требуется отправка отчёта на данный e-mail)
Parametr = True
End If
Next
Dvoetochie = InStr(Parametr2, ":")
If Dvoetochie Then
Parametr4 = Mid(Parametr2, Dvoetochie + 1)
Parametr2 = Left(Parametr2, Dvoetochie - 1)
End If
Set objScriptExec = WshShell.Exec("qUser.exe")
Do Until objScriptExec.StdOut.AtEndOfStream
Line = DosToAnsi(objScriptExec.StdOut.ReadLine)
'Разщипляем строку на составляющие
If Instr(Line, "отсутствует") Then Sdvig = 2 Else Sdvig = 0 ' Данная хня появилась в 2019 серваке
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 + Sdvig)))
TDate = LCase(Trim(Mid(Line, 66 + Sdvig, 11))) 'Если нужно, то раскоментировать!
TTime = LCase(Trim(Mid(Line, 77 + Sdvig, 6))) 'Если нужно, то раскоментировать!
a = 0
If Parametr Then
If Parametr0 = "not" then
If Parametr1 = "include" Then
If Not InStr(User, Parametr2) > 0 Then a = a + 1
End If
If Parametr1 = "equal" Then
If Not(User = Parametr2) Then a = a + 1
End If
Else
If Parametr1 = "include" Then
If InStr(User, Parametr2) > 0 Then a = a + 1
End If
If Parametr1 = "equal" Then
If (User = Parametr2) Then a = a + 1
End If
End If
End If
If a > 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
Loop
Wend
TS.Close
File.Delete
set TS = nothing
For ik = 0 To kApt
Msg2 = ""
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)
Reset = Parametr3 + " " & Id & " /v"
MsgBox(Reset)
'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
Do Until objScriptExec.StdOut.AtEndOfStream
Line = DosToAnsi(objScriptExec.StdOut.ReadLine)
'msgbox (Line)
Msg2 = Msg2 + Line & vbCrLf
Loop
If Msg2 <> "" Then
Msg = Msg + "Ответ команды Logoff " + Id + " для пользователя " + User + ":" & vbCrLf
Msg = Msg + Msg2 + vbCrLf & vbCrLf
k3 = k3 + 1
End If
k2 = k2 + 1
WScript.Sleep 3000 'Это время (в млсек) ждёт скрипт, пока будет исполнена команда Logoff.
Next
If k2 > 0 Then
Msg = Msg + "Итоги: " + String(41, "-") & vbCrLf
MSG = MSG + "Всего отключено пользователей: " + CStr(k2) & vbCrLf & vbCrLf
Msg = Msg + String(48, "*") & vbCrLf & vbCrLf
Dim objEmail
MSG = MSG + "Время/дата отработки скрипта: " + CStr(Time) + "/" + CStr(Date) & vbCrLf & vbCrLf
Const EmailFrom = "script@myfirma.ru" ' от кого будет отправляться e-mail
Const EmailPassword = "SuperPuperPassword" ' пароль от e-mail
Const strSmtpServer = "smtp.myfirma.ru" ' smtp сервер
Const EmailTo = "admin@myfirma.ru" ' Кому будет отправляться e-mail
Set objEmail = CreateObject("CDO.Message")
objEmail.From = EmailFrom
If Parametr4 Then
objEmail.CC = Parametr4
objEmail.To = EmailTo
Else
objEmail.To = EmailTo
End If
objEmail.Subject = CMPName + ": Отчёт по работе скрипта RDP_Reset_Command" 'Тема письма
objEmail.Textbody = MSG
objEmail.Bodypart.Charset = "windows-1251"
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
End If
Места, где необходимо внести в скрипт свои изменения, помечены красным.
Ну и чтобы не было претедентов нечаянных я в папку Input на терминальном сервере положил текстовик с названием "СРОЧНО ПРОЧТИ!!!", внутрит которого я поместил вот такую напоминалку:
В этой папке появляется файл ResetSession с содержанием типа:
reset session equal ipetrov
или
reset session equal ipetrov:ipetrov@myfirma.ru
когда кто-либо отправляет команду сброса сессии на терминальный сервер.
Эта папка расшарена, её удалять нельзя!
Вот где-то так получается c кучей костылей вполне себе рабочий минипроект.
Жизнь админа должна быть проще... | 
