Option Explicit

Dim objArgs    : Set objArgs = WScript.Arguments
Dim sTarget,sTrustee,bSetSendAs,bSetReceiveAs

bSetSendAs = True
bSetReceiveAs = True
if objArgs.Count < 2 Then : ShowSyntax
If (objArgs(0) = "?") Or (objArgs(0) = "-?") Or (objArgs(0) = "/?") Then : ShowSyntax
sTarget = objArgs(0) 
sTrustee = objArgs(1)
If objArgs.Count > 2 Then
	If UCase(objArgs(2)) = "FALSE" Then 
		bSetSendAs = False
	Elseif UCase(objArgs(2)) <> "TRUE" Then
		ShowSyntax
	End If
End if
If objArgs.Count > 3 Then
	If UCase(objArgs(3)) = "FALSE" Then
		bSetReceiveAs = False
	Elseif UCase(objArgs(3)) <> "TRUE" Then
		ShowSyntax
	End If
End If

SetSendAsReceiveAs sTarget, sTrustee, bSetSendAs, bSetReceiveAs

' ------------------------------------------------------------------------------------------------------------------------------------------
' 
'    XX  XX              XXX                                 XXXXXXX                                X        XX                              
'    XX  XX               XX                                  XX   X                               XX                                        
'    XX  XX    XXXXX      XX    XX XXX    XXXXX   XX XXX      XX X    XX  XXX   XX XXX   XXXXX    XXXXX     XXX      XXXX    XX XXX  XXXXXXX 
'    XXXXXX   XX    X     XX     XX  XX  XX    X   XXX XX     XXXX    XX  XX    XXX XX  XX   XX    XX        XX     XX  XX   XXX XX  XX      
'    XX  XX   XXXXXXX     XX     XX  XX  XXXXXXX   XX         XX X    XX  XX    XX  XX  XX         XX        XX     XX  XX   XX  XX  XXXXXXX 
'    XX  XX   XX          XX     XXXXX   XX        XX         XX      XX  XX    XX  XX  XX   XX    XX XX     XX     XX  XX   XX  XX       XX 
'    XX  XX    XXXXX     XXXX    XX       XXXXX   XXXX       XXXX      XXX XX   XX  XX   XXXXX      XXX     XXXX     XXXX    XX  XX  XXXXXXX 
'                               XXXX              
' 
' ------------------------------------------------------------------------------------------------------------------------------------------

Sub ShowSyntax
	Dim sString
	sString = "Syntax:" & vbCRLF & "    cscript " & WScript.ScriptName & " domain\target domain\trustee [Set Send-As] [Set Receive-As]" & _
	          vbCRLF  & "eg:" & vbCRLF & "    cscript " & WScript.ScriptName & " mydomain\fred mydomain\Charlie True True" & _
	          vbCRLF  & "    cscript " & WScript.ScriptName & " mydomain\Fred mydomain\Charlie False True" & _ 
	          vbCRLF  & "    cscript " & WScript.ScriptName & " mydomain\Fred mydomain\Charlie"
	WScript.Echo sString
	WScript.Quit(1)
End Sub

' --------------------------------------------------------------------------

Function SetSendAsReceiveAs(sTarget,sTrustee,bSetSendAs,bSetReceiveAs)
	Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5
	Const      ADS_FLAG_OBJECT_TYPE_PRESENT = &H1
	Const       ADS_RIGHT_DS_CONTROL_ACCESS = &H100
	Const                  RIGHT_DS_SEND_AS = "{ab721a54-1e2f-11d0-9819-00aa0040529b}"
	Const               RIGHT_DS_RECEIVE_AS = "{ab721a56-1e2f-11d0-9819-00aa0040529b}"
	Dim objSdUtil, objSD, objDACL, objAce1, objAce2
	SetSendAsReceiveAs = False	 
	On Error Resume Next
	Err.Clear
	Set objSdUtil = GetObject("LDAP://" & WinNTToLDAP(sTarget))
	If Err.Number <> 0 Then : Exit Function
	Set objSD = objSdUtil.Get("ntSecurityDescriptor")
	Set objDACL = objSD.DiscretionaryACL
	
	Set objAce1 = CreateObject("AccessControlEntry")
	objAce1.Trustee = sTrustee
	objAce1.AceFlags = 0
	objAce1.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT
	objAce1.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT
	objAce1.ObjectType = RIGHT_DS_SEND_AS
	objAce1.AccessMask = ADS_RIGHT_DS_CONTROL_ACCESS
	
	Set objAce2 = CreateObject("AccessControlEntry")
	objAce2.Trustee = sTrustee
	objAce2.AceFlags = 0
	objAce2.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT
	objAce2.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT
	objAce2.ObjectType = RIGHT_DS_RECEIVE_AS
	objAce2.AccessMask = ADS_RIGHT_DS_CONTROL_ACCESS
	
	if bSetSendAs    Then : objDACL.AddAce objAce1
	if bSetReceiveAs Then : objDACL.AddAce objAce2
	
	objSD.DiscretionaryAcl = objDACL
	objSDUtil.Put "ntSecurityDescriptor", Array(objSD)
	if bSetSendAs Or bSetReceiveAs Then : objSDUtil.SetInfo
	If Err.Number <> 0 Then : Exit Function
	SetSendAsReceiveAs = True
End Function

' --------------------------------------------------------------------------

Function WinNTToLDAP(sAccountName)
	Const ADS_NAME_INITTYPE_GC = 3
	Const ADS_NAME_TYPE_NT4 = 3
	Const ADS_NAME_TYPE_1779 = 1
	Dim objTrans, oObject
	Set objTrans = CreateObject("NameTranslate")
	objTrans.Init ADS_NAME_INITTYPE_GC, ""
	objTrans.Set ADS_NAME_TYPE_NT4, sAccountName
	WinNTToLDAP = objTrans.Get(ADS_NAME_TYPE_1779)
End Function

' --------------------------------------------------------------------------