これは、サーバー管理者と名前付きADグループのみがアクセスできるようにデスクトップをロックするために行ったことです。特定のADグループのメンバーではないユーザーには、デスクトップ/標準mstscではなくRDWebを使用するように指示するメッセージが表示されます。
- vbscriptを作成し、すべてのユーザーが読み取り+実行できるサーバー上のフォルダーに配置する
次の行を追加します %windir%\system32\USRLOGON.CMD
cscript <sourcefolder>\DesktopUserCheck.vbs
vbscriptコード（以下の<>エントリに個人情報を追加してください）
'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