ISA Server 2006 may forward requests to an incorrect Web server when a client computer accesses Web sites that have different public names in the same session

' -+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
' -+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-

'    This code is Copyright (c) 2007 Microsoft Corporation.  
'
'    All rights reserved.
'
'    THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF
'    ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO
'    THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
'    PARTICULAR PURPOSE.
'
'    IN NO EVENT SHALL MICROSOFT AND/OR ITS RESPECTIVE SUPPLIERS BE
'    LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
'    DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
'    WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
'    ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
'    OF THIS CODE OR INFORMATION.
'
' -+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-

Const SE_VPS_GUID = "{143F5698-103B-12D4-FF34-1F34767DEabc}"
Const SE_VPS_NAME = "CreateDomainCookie"
Const SE_VPS_VALUE = true


'Define the constants needed
const Error_FileNotFound = &H80070002
Const fpcPolicyWebPublishing = 2

Main(WScript.Arguments)

Sub Main(args)

    If(args.Count = 1) Then
        SetWPLBhttpOnly args(0)
    Else
        Usage()
    End If
End Sub

Sub SetWPLBhttpOnly(ruleName)

    ' Create the root object.
    Dim root  ' The FPCLib.FPC root object
    Set root = CreateObject("FPC.Root")

    ' Declare the other objects needed.
    Dim isaArray        ' An FPCArray object
    Dim rule            ' An FPCPolicyRule object

    ' Obtain a reference to the array object.
    Set isaArray = root.GetContainingArray()

    ' Obtain a reference to the policy rule specified.
    On Error Resume Next
    Set rule = isaArray.ArrayPolicy.PolicyRules.Item(ruleName)
    If Err.Number = Error_FileNotFound Then
        WScript.Echo "The policy rule specified could not be found."
    Else
        Err.Clear
        On Error GoTo 0
        If rule.Type = fpcPolicyWebPublishing Then

            Dim VendorSets  ' An FPCVendorParametersSets collection
            Dim VendorSet   ' An FPCVendorParametersSet object

            Set VendorSets = rule.VendorParametersSets

            On Error Resume Next
            Set VendorSet = VendorSets.Item( SE_VPS_GUID )

            If Err.Number <> 0 Then
                Err.Clear

                ' Add the item
                Set VendorSet = VendorSets.Add( SE_VPS_GUID )
                CheckError
                WScript.Echo "New VendorSet added... " & VendorSet.Name

            Else
                WScript.Echo "Existing VendorSet found... value- " &  VendorSet.Value(SE_VPS_NAME)
            End If

            if VendorSet.Value(SE_VPS_NAME) <> SE_VPS_VALUE Then

                Err.Clear
                VendorSet.Value(SE_VPS_NAME) = SE_VPS_VALUE

                If Err.Number <> 0 Then
                        CheckError
                End If
            End If

            rule.Save
            WScript.Echo "Done!"

        Else
            WScript.Echo "The policy rule specified is not a Web publishing rule."
        End If
    End If

End Sub

Sub Usage()
    WScript.Echo "Usage:" & VbCrLf _
        & "  " & WScript.ScriptName & " RuleName" & VbCrLf _
        & "" & VbCrLf _
        & "    RuleName - Name of the Web publishing rule"
    WScript.Quit
End Sub


Sub CheckError()

    If Err.Number <> 0 Then
        WScript.Echo "An error occurred: 0x" & Hex(Err.Number) & " " & Err.Description
        Err.Clear
    End If

End Sub