FIX: A nonweb proxy client in a Forefront Threat Management Gateway (TMG) 2010 environment cannot open certain load-balanced websites when TMG HTTPS inspection is enabled

' The domain name set for the exclusion list
const strDomainNameSetName = _
    "HTTPS-inspection IP address validation exception"
const strDomainNameSetDescription = "HTTPS sites whose certificate's domain-name matches this set are excluded from the validation that the domain-name indeed resolves to the IP address that the Web client originally connected to"
 
 
Const strVpsGUID = "{143F5698-103B-12D4-FF34-1F34767DEABC}"
Const strVpsPropertyName = "HTTPSiIpAddressValidationExclusionDNSet"
Const Error_FileNotFound = &H80070002
 
Set objArray = CreateObject("FPC.Root").GetContainingArray()
Set objDNSet = OpenDNSet( _
                    objArray.RuleElements.DomainNameSets, _
                    strDomainNameSetName, _
                    strDomainNameSetDescription _
                    )
Set objVPSet = OpenVPSet(objArray.ArrayPolicy, strVpsGUID)
objVPSet.Value(strVpsPropertyName) = objDNSet.PersistentName
objArray.Save
 
function OpenDNSet(objDNSets, strDNSetName, strDNSetDescription)
    On Error Resume Next
    Set objDNSet = objDNSets.Item(strDNSetName)
    ' Save the Err properties in case it needs to be re-raised
    errNumber      = Err.Number
    errSource      = Err.Source
    errDescription = Err.Description
    errHelpFile    = Err.HelpFile
    errHelpContext = Err.HelpContext
    
    On Error GoTo 0
    
    if errNumber = Error_FileNotFound Then
        Set objDNSet = objDNSets.Add(strDNSetName)
        objDNSet.Description = strDNSetDescription
    Elseif errNumber < 0 Then
        ' An error other than "file not found" occured -- re-raise the error,
        ' this time not under "On Error Resume Next"
        Err.Raise errNumber, errSource, errDescription, errHelpFile, errHelpContext
    End If
     
    Set OpenDNSet = objDNSet
end function
 
function OpenVPSet(objParent, strVpsGUID)
    Set objVPSets = objParent.VendorParametersSets
    On Error Resume Next
    Set OpenVPSet = objVPSets.Item(strVpsGUID)
    ' Save the Err properties in case it needs to be re-raised
    errNumber      = Err.Number
    errSource      = Err.Source
    errDescription = Err.Description
    errHelpFile    = Err.HelpFile
    errHelpContext = Err.HelpContext
    
    On Error GoTo 0
    
    if errNumber = Error_FileNotFound Then
        Set OpenVPSet = objVPSets.Add(strVpsGUID)
    Elseif errNumber < 0 Then
        ' An error other than "file not found" occured -- re-raise the error,
        ' this time not under "On Error Resume Next"
        Err.Raise errNumber, errSource, errDescription, errHelpFile, errHelpContext
     End If
end function