' Скрипт создает на рабочем столе пользователя RDP-ярлык удаленного подключения, базируясь на членстве в группах.
' Шаблон названия группы - RDP_НазваниеЯрлыка в поле Description указываем имя сервера, на который настраивается RDP-соединение
' например AD-группа RDP_1C-Бухгалтерия с описанием Server1.domain.local в поле Desription
' Если ярлык с таким названием уже есть - он пересоздается, что решает задачу обновления параметров.
' при необходимости параметры RDP-файла можно поправить в теле скрипта.

On Error Resume Next
Set wshShell = WScript.CreateObject("WScript.Shell")
Set m_FSO = CreateObject("Scripting.FileSystemObject")

' Находим пользователя в AD и определем его параметры
Set objSysInfo = CreateObject("ADSystemInfo")
ADSPath = "LDAP://" & objSysInfo.UserName
Set objUser = GetObject(ADSPath)
ShortUserName = objUser.SamAccountName
DomainName = objSysInfo.DomainShortName

' Читаем путь к Рабочему столу
DesktopPath = wshShell.SpecialFolders("Desktop")
LevelCount = 0
MaxLevelCount = 4
Status = CheckGroups(ADSPath)

' дальше идет нудный перечень используемых функций
'============ Function GetPrefixNameGroup ============
Function GetPrefixNameGroup(sString)
' Trim prefix of name group
Dim TempString
TempString = Left(sString, InStr(sString, "_"))
GetPrefixNameGroup = TempString
End Function
'=====================================================
'============ Function GetLinkNameGroup ============
Function GetLinkNameGroup(sString)
' Trim LinkName of name group
Dim TempString
TempString = Mid(sString, InStrRev(sString, "_")+1)
GetLinkNameGroup = TempString
End Function
'=====================================================
'============ Function Create RdpFile ============
Function CreateRDPFile(sString, sName)
spath = DesktopPath & "" & sString & ".rdp"
' проверяем наличие такого же файла - если есть - удаляем его'
If m_FSO.FileExists(sPath) or m_FSO.FolderExists(sPath) Then
m_FSO.DeleteFile (sPath),1
End If
Set RDPFile = m_FSO.CreateTextFile (spath, True)
RDPFile.writeline ("screen mode id:i:2")
RDPFile.writeline ("use multimon:i:0")
RDPFile.writeline ("desktopwidth:i:1280")
RDPFile.writeline ("desktopheight:i:1024")
RDPFile.writeline ("session bpp:i:16")
RDPFile.writeline ("winposstr:s:0,1,0,0,800,600")
RDPFile.writeline ("compression:i:1")
RDPFile.writeline ("keyboardhook:i:2")
RDPFile.writeline ("audiocapturemode:i:0")
RDPFile.writeline ("videoplaybackmode:i:1")
RDPFile.writeline ("connection type:i:2")
RDPFile.writeline ("displayconnectionbar:i:1")
RDPFile.writeline ("disable wallpaper:i:1")
RDPFile.writeline ("disable full window drag:i:1")
RDPFile.writeline ("allow desktop composition:i:0")
RDPFile.writeline ("allow font smoothing:i:0")
RDPFile.writeline ("disable menu anims:i:1")
RDPFile.writeline ("disable themes:i:1")
RDPFile.writeline ("disable cursor setting:i:0")
RDPFile.writeline ("bitmapcachepersistenable:i:1")
' добавление имени сервера '
RDPFile.writeline ("full address:s:" & sName)
RDPFile.writeline ("audiomode:i:2")
RDPFile.writeline ("redirectprinters:i:0")
RDPFile.writeline ("redirectcomports:i:0")
RDPFile.writeline ("redirectsmartcards:i:0")
RDPFile.writeline ("redirectclipboard:i:1")
RDPFile.writeline ("redirectposdevices:i:0")
RDPFile.writeline ("redirectdirectx:i:1")
RDPFile.writeline ("autoreconnection enabled:i:1")
RDPFile.writeline ("authentication level:i:0")
RDPFile.writeline ("prompt for credentials:i:0")
RDPFile.writeline ("negotiate security layer:i:1")
RDPFile.writeline ("remoteapplicationmode:i:0")
RDPFile.writeline ("alternate shell:s:")
RDPFile.writeline ("shell working directory:s:")
RDPFile.writeline ("gatewayhostname:s:")
RDPFile.writeline ("gatewayusagemethod:i:4")
RDPFile.writeline ("gatewaycredentialssource:i:4")
RDPFile.writeline ("gatewayprofileusagemethod:i:0")
RDPFile.writeline ("promptcredentialonce:i:1")
' добавление имени пользователя в нотации DomainUsername'
RDPFile.writeline ("username:s:" & DomainName& ""& ShortUserName)
RDPFile.writeline ("drivestoredirect:s:")
RDPFile.close
End Function
'=====================================================
'============ Function CheckGroups ===================
Function CheckGroups(ADSPath)
Dim objUser, arrMemberOf
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
LevelCount = LevelCount + 1
if ( LevelCount >= MaxLevelCount) then
LevelCount = LevelCount - 1
return LevelCount
end If
Set objUser = GetObject (ADSPath)
On Error Resume Next
arrMemberOf = objUser.GetEx("memberOf")
If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
LevelCount = LevelCount - 1
return LevelCount
Else
For Each Group in arrMemberOf
ADSGroup = "LDAP://" & Group
CheckGroups(ADSGroup)
WScript.Echo "Extra=" & LevelCount
Set objGroup = GetObject ( ADSGroup )
If(GetPrefixNameGroup(objGroup.CN) = "RDP_") Then
Set objGroup = GetObject ( "LDAP://" & Group)
LinkName = GetLinkNameGroup(objGroup.CN)
LinkServer = objGroup.description
LinkResult = CreateRDPFile (LinkName, LinkServer)
end If
Next
End If
LevelCount = LevelCount - 1
End Function
'=====================================================