This is what I have done to lock the Desktop to only be accessible for server administrators and a named AD group. Users that are not member of the given AD group will get a message telling them to use the RDWeb and not the Desktop/standard mstsc.
- Create a vbscript and put it in a folder on the server that all users can read+execute
Add the following line to %windir%\system32\USRLOGON.CMD
cscript <sourcefolder>\DesktopUserCheck.vbs
The vbscript code (please add your personal info in the below <> entries)
'Script created by Tord Bergset, Jan 2014
'This script is called from the file called C:\Windows\System32\USRLOGON.CMD
'The script check if a user logging on to the server desktop is a allowed to do this.
'The string called StrGroupName controls the access group to check for.
'AD group used for this script = "G WTS Grant Desktop Access"
'---------------------------------------------------------------------------------------
Const strComputer = "."
Const EWX_LOGOFF = 0
Dim objShell, objWMIService, colProcessList, objNetwork, StrGroupName, strUsername, strUserIsMember, strUserFullName
Set objShell = WScript.CreateObject ("WScript.Shell")
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'userinit.exe'")
Set objNetwork = CreateObject("Wscript.Network")
strUsername = EnvString("username")
' Mention any AD Group Name Here. Also works for Domain Admins, Enterprise Admins etc.
' -------------------------------------------------------------------------------------
StrGroupName = "G WTS Grant Desktop Access"
' -------------------------------------------------------------------------------------
If IsAdmin = 0 Then wscript.Quit
CheckADGroupMembership()
If strUserIsMember = "YES" Then
' Do something here if user is a member of the group
'MsgBox "Is member"
Wscript.Quit
Else
' Do something here if user is NOT a member of the group
'MsgBox "Is not member"
For Each objProcess in colProcessList
MsgBox "You (" & strUsername & " ) are not allowed to log in to the server desktop." & VBLF & "Please connect through the Remote Desktop Web Page (RDWeb):" & VBLF & VBLF & "<rdweb server address>", vbExclamation + vbSystemModal, strUsername & " - Access Denied !"
objShell.run "logoff"
WScript.Quit
Next
End If
Wscript.Quit
' *****************************************************
'This function checks to see if the logged on user has local admin rights
Function IsAdmin()
With CreateObject("Wscript.Shell")
IsAdmin = .Run("%comspec% /c OPENFILES > nul", 0, True)
End With
End Function
' *****************************************************
'This function checks to see if the passed group name contains the current user as a member. Returns True or False
Function IsMember(groupName)
If IsEmpty(groupListD) then
Set groupListD = CreateObject("Scripting.Dictionary")
groupListD.CompareMode = TextCompare
ADSPath = EnvString("userdomain") & "/" & EnvString("username")
Set userPath = GetObject("WinNT://" & ADSPath & ",user")
For Each listGroup in userPath.Groups
groupListD.Add listGroup.Name, "-"
Next
End if
IsMember = CBool(groupListD.Exists(groupName))
End Function
' *****************************************************
'This function returns a particular environment variable's value.
' for example, if you use EnvString("username"), it would return the value of %username%.
Function EnvString(variable)
variable = "%" & variable & "%"
EnvString = objShell.ExpandEnvironmentStrings(variable)
End Function
' *****************************************************
Sub CheckADGroupMembership()
' =============================================================
' List All Members of a Group; Including Nested Members
' =============================================================
Dim ObjRootDSE, ObjConn, ObjRS, ObjCustom
Dim StrDomainName, StrGroupName, StrSQL
Dim StrGroupDN, StrEmptySpace
strUserIsMember = ""
Set ObjRootDSE = GetObject("LDAP://RootDSE")
StrDomainName = Trim(ObjRootDSE.Get("DefaultNamingContext"))
Set ObjRootDSE = Nothing
StrSQL = "Select ADsPath From 'LDAP://" & StrDomainName & "' Where ObjectCategory = 'Group' AND Name = '" & StrGroupName & "'"
Set ObjConn = CreateObject("ADODB.Connection")
ObjConn.Provider = "ADsDSOObject": ObjConn.Open "Active Directory Provider"
Set ObjRS = CreateObject("ADODB.Recordset")
ObjRS.Open StrSQL, ObjConn
If ObjRS.EOF Then
'WScript.Echo VbCrLf & "This Group: " & StrGroupName & " does not exist in Active Directory"
End If
If Not ObjRS.EOF Then
WScript.Echo vbNullString
ObjRS.MoveLast: ObjRS.MoveFirst
'WScript.Echo "Total No of Groups Found: " & ObjRS.RecordCount
'WScript.Echo "List of Members In " & StrGroupName & " are: " & VbCrLf
While Not ObjRS.EOF
StrGroupDN = Trim(ObjRS.Fields("ADsPath").Value)
Set ObjCustom = CreateObject("Scripting.Dictionary")
StrEmptySpace = " "
GetAllNestedMembers StrGroupDN, StrEmptySpace, ObjCustom
Set ObjCustom = Nothing
ObjRS.MoveNext
Wend
End If
ObjRS.Close: Set ObjRS = Nothing
ObjConn.Close: Set ObjConn = Nothing
End Sub
Private Function GetAllNestedMembers (StrGroupADsPath, StrEmptySpace, ObjCustom)
Dim ObjGroup, ObjMember
Set ObjGroup = GetObject(StrGroupADsPath)
For Each ObjMember In ObjGroup.Members
'WScript.Echo Trim(ObjMember.CN) & " --- " & Trim(ObjMember.DisplayName) & " (" & Trim(ObjMember.Class) & ")" & " (" & Trim(ObjMember.sAMAccountName) & ")"
strThisUser = Trim(ObjMember.sAMAccountName)
If lCase(strUsername) = lCase(strThisUser) Then
strUserIsMember = "YES"
strUserFullName = Trim(ObjMember.DisplayName)
Exit Function
End If
If Strcomp(Trim(ObjMember.Class), "Group", vbTextCompare) = 0 Then
If ObjCustom.Exists(ObjMember.ADsPath) Then
'WScript.Echo StrEmptySpace & " -- Already Checked Group-Member " & "(Stopping Here To Escape Loop)"
Else
ObjCustom.Add ObjMember.ADsPath, 1
GetFromHere ObjMember.ADsPath, StrEmptySpace & " ", ObjCustom
End If
End If
Next
End Function
Private Sub GetFromHere(StrGroupADsPath, StrEmptySpace, ObjCustom)
Dim ObjThisGroup, ObjThisMember
Set ObjThisGroup = GetObject(StrGroupADsPath)
'WScript.Echo vbNullString
'WScript.Echo " ** Members of this Group are:"
For Each ObjThisMember In ObjThisGroup.Members
'WScript.Echo " >> " & Trim(ObjThisMember.CN) & " --- " & Trim(ObjThisMember.DisplayName) & " (" & Trim(ObjThisMember.Class) & ")" & " (" & Trim(ObjThisMember.sAMAccountName) & ")"
strThisUser = Trim(ObjThisMember.sAMAccountName)
If lCase(strUsername) = lCase(strThisUser) Then
strUserIsMember = "YES"
strUserFullName = Trim(ObjThisMember.DisplayName)
Exit Sub
End If
Next
'WScript.Echo vbNullString
End Sub