Creating the IIsWebManagement Class Module


Creating the IIsWebManagement Class Module

In this section, you will continue the creation of the IIsAdmin.DLL COM server application started in Chapter 8.

Example 9.1 Creating the IIsAdmin.DLL COM Server Application: The IIsWebManagement Class Module
  1. Open the IIsAdmin ActiveX DLL Visual Basic project that was started in Chapter 8. You can also download the project from http://www.newriders.com/adsi.

  2. If you are adding to the IIsAdmin project, add a new class module to the project. If this is a new project, make sure to set a reference to Active DS Type Library.

  3. Name the new module IIsWebManagement.

  4. Enter the following code into the General Declarations section of the class module:

    Public Function ManageIdentityProperty(ByVal TargetComputer As String, ByVal SiteIndex As  graphics/ccc.gifInteger, ByVal Action As String, ByVal IdentityProperty As String, Optional ByVal  graphics/ccc.gifNewValue As Variant) As Variant      On Error Resume Next      Dim ArrayElement As Variant      Dim NewElement() As Variant      Dim i As Integer      Dim Site As IADs      Set Site = GetObject("IIS://"&TargetComputer&"/W3SVC/"&SiteIndex)      Select Case UCase(Action)           Case "QUERY"                Select Case UCase(IdentityProperty)                     Case "SERVERCOMMENT"                          ManageIdentityProperty = Site.ServerComment                     Case "SERVERBINDINGS"                          For Each ArrayElement In Site.ServerBindings                               i = UBound(NewElement) + 1                               ReDim Preserve NewElement(i)                               NewElement(i) = ArrayElement                          Next                          ManageIdentityProperty = NewElement                     Case "SECUREBINDINGS"                          For Each ArrayElement In Site.SecureBindings                               i = UBound(NewElement) + 1                               ReDim Preserve NewElement(i)                               NewElement(i) = ArrayElement                          Next                          ManageIdentityProperty = NewElement                     Case "MAXCONNECTIONS"                          ManageIdentityProperty = Site.MaxConnections                     Case "CONNECTIONTIMEOUT"                          ManageIdentityProperty = Site.ConnectionTimeout                End Select           Case "SET"                If NewValue <> "" Then                     Select Case UCase(IdentityProperty)                          Case "SERVERCOMMENT"                               Err.Number = 0                               Site.ServerComment = NewValue                          Case "ADDSERVERBINDING"                               If IsArray(Site.ServerBindings) Then                                    For Each ArrayElement In Site.ServerBindings                                         i = UBound(NewElement) + 1                                         ReDim Preserve NewElement(i)                                         NewElement(i) = ArrayElement                                    Next                                    i = UBound(NewElement) + 1                                    ReDim Preserve NewElement(i)                                    NewElement(i) = NewValue                                    Err.Number = 0                                    Site.ServerBindings = NewElement                               Else                                    Site.ServerBindings = Array(NewValue)                               End If                          Case "ADDSECUREBINDING"                               If IsArray(Site.SecureBindings) Then                                    For Each ArrayElement In Site.SecureBindings                                         i = UBound(NewElement) + 1                                         ReDim Preserve NewElement(i)                                         NewElement(i) = ArrayElement                                    Next                                    i = UBound(NewElement) + 1                                    ReDim Preserve NewElement(i)                                    NewElement(i) = NewValue                                    Err.Number = 0                                    Site.SecureBindings = NewElement                               Else                                    Site.SecureBindings = Array(NewValue)                               End If                          Case "REMOVEALLSERVERBINDINGS"                               Site.ServerBindings = Array("")                               Err.Number = 0                          Case "REMOVEALLSECUREBINDINGS"                               Err.Number = 0                               Site.SecureBindings = Array("")                          Case "REMOVESERVERBINDING"                               If IsArray(Site.ServerBindings) Then                                    For Each ArrayElement In Site.ServerBindings                                         If ArrayElement <> NewValue Then                                              i = UBound(NewElement) + 1                                              ReDim Preserve NewElement(i)                                              NewElement(i) = ArrayElement                                         End If                                    Next                                    Err.Number = 0                                    Site.ServerBindings = NewElement                               Else                                    If Site.ServerBindings = NewValue Then                                         Err.Number = 0                                         Site.ServerBindings = Array("")                                    End If                               End If                          Case "REMOVESECUREBINDING"                               If IsArray(Site.SecureBindings) Then                                    For Each ArrayElement In Site.SecureBindings                                         If ArrayElement <> NewValue Then                                              i = UBound(NewElement) + 1                                              ReDim Preserve NewElement(i)                                              NewElement(i) = ArrayElement                                         End If                                    Next                                    Err.Number = 0                                    Site.SecureBindings = NewElement                               Else                                    If Site.SecureBindings = NewValue Then                                         Site.SecureBindings = Array("")                                    End If                               End If                          Case "MAXCONNECTIONS"                               Site.MaxConnections = NewValue                          Case "CONNECTIONTIMEOUT"                               Site.ConnectionTimeout = NewValue                     End Select                     Site.SetInfo                     If Err.Number = 0 Then ManageIdentityProperty = True                End If      End Select End Function Public Function ManageOperators(ByVal TargetComputer As String, ByVal SiteIndex As  graphics/ccc.gifInteger, ByVal Action As String, ByVal IdentityProperty As String, Optional ByVal  graphics/ccc.gifNewValue As Variant) As Variant      On Error Resume Next      Dim SecurityDescriptor As Variant      Dim DiscretionaryACL As Variant      Dim ACE As Variant      Dim ArrayElement As Variant      Dim NewElement() As Variant      Dim i As Integer      Dim Site As IADs      Set Site = GetObject("IIS://"&TargetComputer&"/W3SVC/"&SiteIndex)      Set SecurityDescriptor = Site.AdminAcl      Set DiscretionaryACL = SecurityDescriptor.DiscretionaryACL      Select Case UCase(Action)           Case "QUERY"                Select Case UCase(IdentityProperty)                     Case "OPERATORS"                          For Each ArrayElement In DiscretionaryACL                               If ArrayElement.AccessMask = 11 Or ArrayElement.AccessMask  graphics/ccc.gif= 262315 Then                                    i = UBound(NewElement) + 1                                    ReDim Preserve NewElement(i)                                    NewElement(i) = ArrayElement.Trustee                               End If                          Next                          ManageOperators = NewElement                End Select           Case "SET"                If NewValue <> "" Then                     Select Case UCase(IdentityProperty)                          Case "NEWOPERATOR"                               Set ACE = CreateObject("AccessControlEntry")                               ACE.Trustee = NewValue                               ACE.AccessMask = 11                               DiscretionaryACL.AddAce ACE                               SecurityDescriptor.DiscretionaryACL = DiscretionaryACL                               Site.AdminAcl = SecurityDescriptor                          Case "REMOVEOPERATOR"                               Set ACE = CreateObject("AccessControlEntry")                               ACE.Trustee = NewValue                               ACE.AccessMask = 11                               DiscretionaryACL.RemoveAce ACE                               SecurityDescriptor.DiscretionaryACL = DiscretionaryACL                               Site.AdminAcl = SecurityDescriptor                     End Select                     Site.SetInfo                     If Err.Number = 0 Then ManageOperators = True                End If      End Select End Function Public Function ManageAuthenticationMethods(ByVal TargetComputer As String, ByVal  graphics/ccc.gifSiteIndex As Integer, ByVal Action As String, ByVal IdentityProperty As String, Optional  graphics/ccc.gifByVal NewValue As Variant) As Variant      On Error Resume Next      Dim Site As IADs      Dim Resource As IADs      Dim NewElement() As Variant      Dim i As Integer      Set Resource = GetObject("IIS://"&TargetComputer&"/W3SVC/"&SiteIndex&"/ROOT")      Select Case UCase(Action)           Case "QUERY"                Select Case UCase(IdentityProperty)                     Case "ALLAUTHENTICATIONMETHODS"                          i = UBound(NewElement) + 1                          ReDim Preserve NewElement(i)                          NewElement(i) = "Anonymous Access Enabled:  graphics/ccc.gif"&Resource.AuthAnonymous                          If Resource.AuthAnonymous = True Then                               i = UBound(NewElement) + 1                               ReDim Preserve NewElement(i)                               NewElement(i) = "Anonymous Username:  graphics/ccc.gif"&Resource.AnonymousUsername                               i = UBound(NewElement) + 1                               ReDim Preserve NewElement(i)                               NewElement(i) = "Anonymous User Account Password:  graphics/ccc.gif"&Resource.AnonymousUserPass                               i = UBound(NewElement) + 1                               ReDim Preserve NewElement(i)                               NewElement(i) = "Anonymous User Account Password Sync  graphics/ccc.gifEnabled: "& Resource.AnonymousPasswordSync                          End If                          i = UBound(NewElement) + 1                          ReDim Preserve NewElement(i)                          NewElement(i) = "Basic Authentication Enabled:  graphics/ccc.gif"&Resource.AuthBasic                          If Resource.AuthBasic = True Then                               i = UBound(NewElement) + 1                               ReDim Preserve NewElement(i)                               NewElement(i) = "Basic Authentication Default Domain: "&  graphics/ccc.gifResource.DefaultLogonDomain                          End If                          i = UBound(NewElement) + 1                          ReDim Preserve NewElement(i)                          NewElement(i) = "NTLM Authentication Enabled: "&Resource.AuthNTLM                          ManageAuthenticationMethods = NewElement                     Case "ANONYMOUS"                          ManageAuthenticationMethods = Resource.AuthAnonymous                     Case "BASIC"                          ManageAuthenticationMethods = Resource.AuthBasic                     Case "NTLM"                          ManageAuthenticationMethods = Resource.AuthNTLM                     Case "ANONYMOUSUSERNAME"                          ManageAuthenticationMethods = Resource.AnonymousUsername                     Case "ANONYMOUSUSERPASS"                          ManageAuthenticationMethods = Resource.AnonymousUserPass                     Case "ANONYMOUSPASSWORDSYNC"                          ManageAuthenticationMethods = Resource.AnonymousPasswordSync                     Case "DEFAULTLOGONDOMAIN"                          ManageAuthenticationMethods = Resource.DefaultLogonDomain                End Select           Case "SET"                If NewValue <> "" Then                     Select Case UCase(IdentityProperty)                          Case "ANONYMOUS"                               Resource.AuthAnonymous = NewValue                          Case "BASIC"                               Resource.AuthBasic = NewValue                          Case "NTLM"                               Resource.AuthNTLM = NewValue                          Case "ANONYMOUSUSERNAME"                               Resource.AnonymousUsername = NewValue                          Case "ANONYMOUSUSERPASS"                               Resource.AnonymousUserPass = NewValue                          Case "ANONYMOUSPASSWORDSYNC"                               Resource.AnonymousPasswordSync = NewValue                          Case "DEFAULTLOGONDOMAIN"                               Resource.DefaultLogonDomain = NewValue                     End Select                     Resource.SetInfo                     If Err.Number = 0 Then ManageAuthenticationMethods = True                End If      End Select End Function Public Function MIMETypeManagement(ByVal TargetComputer As String, ByVal Index As Integer, graphics/ccc.gif ByVal Action As String, Optional ByVal MIMEExtension As String, Optional ByVal MIMEType  graphics/ccc.gifAs String) As Variant      On Error Resume Next      Dim IIsComputer As IADs      Set IIsComputer = GetObject("IIS://"&TargetComputer&"/W3SVC/"&Index&"/ROOT")      Select Case UCase(Action)           Case "ENUMERATE"                Dim MimeMapping As Variant                Dim NewElement() As Variant                Dim i As Long                For Each MimeMapping In IIsComputer.MimeMap                     i = UBound(NewElement) + 1                     ReDim Preserve NewElement(i)                     NewElement(i) = MimeMapping.Extension&vbTab&MimeMapping.MIMEType                Next                MIMETypeManagement = NewElement           Case "ADD"                If MIMEType <> "" And MIMEExtension <> "" Then                     Dim NewMimeMapping As Variant                     NewMimeMapping = IIsComputer.GetEx("MimeMap")                     i = UBound(NewMimeMapping) + 1                     ReDim Preserve NewMimeMapping(i)                     Set NewMimeMapping(i) = CreateObject("MimeMap")                     NewMimeMapping(i).MIMEType = MIMEType                     NewMimeMapping(i).Extension = MIMEExtension                     IIsComputer.PutEx ADS_PROPERTY_UPDATE, "MimeMap", NewMimeMapping                     Err.Number = 0                     IIsComputer.SetInfo                     If Err.Number = 0 Then MIMETypeManagement = True                Else                     MIMETypeManagement = False                End If           Case "REMOVE"                If MIMEExtension <> "" Then                     Dim MapToDelete As String                     Dim MimeItem As Variant                     NewMimeMapping = IIsComputer.MimeMap                     For Each MimeMapping In IIsComputer.MimeMap                          If MimeMapping.Extension <> MIMEExtension Then                               ReDim Preserve NewMimeMapping(i)                               Set NewMimeMapping(i) = CreateObject("MimeMap")                               NewMimeMapping(i).MIMEType = MimeMapping.MIMEType                               NewMimeMapping(i).Extension = MimeMapping.Extension                               i = i + 1                          End If                     Next                     IIsComputer.PutEx ADS_PROPERTY_UPDATE, "MimeMap", NewMimeMapping                     Err.Number = 0                     IIsComputer.SetInfo                     If Err.Number = 0 Then MIMETypeManagement = True                Else                     MIMETypeManagement = False                End If      End Select End Function Public Function ManageIPRestrictions(ByVal TargetComputer As String, ByVal SiteIndex As  graphics/ccc.gifInteger, ByVal RelativePath As String, ByVal Action As String, Optional ByVal  graphics/ccc.gifRestrictAction As String, Optional ByVal Restrict As String, Optional ByVal IPSubnet As  graphics/ccc.gifString) As Variant      On Error Resume Next      Dim Site As IADs      Dim IPSecurity As Variant      Dim NewElement() As Variant      Dim IPAddress As String      Dim ActionType As String      Dim Entry As Variant      Dim i As Integer      Set Site = GetObject("IIS://"&TargetComputer&"/W3SVC/"&SiteIndex&RelativePath)      Select Case UCase(Action)           Case "QUERY"                Set IPSecurity = Site.IPSecurity                If IPSecurity.GrantByDefault Then                     For Each Entry In IPSecurity.IPDeny                          If InStr(1, Entry, "255.255.255.255") Then                               i = UBound(NewElement) + 1                               ReDim Preserve NewElement(i)                               NewElement(i) = "Denied IP: "&Replace(Entry, ",  graphics/ccc.gif255.255.255.255", "")                          Else                               i = UBound(NewElement) + 1                               ReDim Preserve NewElement(i)                               NewElement(i) = "Denied Subnet: "&Entry                          End If                     Next                     For Each Entry In IPSecurity.DomainDeny                          i = UBound(NewElement) + 1                          ReDim Preserve NewElement(i)                          NewElement(i) = "Denied Domain: "&Entry                     Next                Else                     For Each Entry In IPSecurity.IPGrant                          If InStr(1, Entry, "255.255.255.255") Then                               i = UBound(NewElement) + 1                               ReDim Preserve NewElement(i)                               NewElement(i) = "Allowed IP: "&Replace(Entry, ",  graphics/ccc.gif255.255.255.255", "")                          Else                               i = UBound(NewElement) + 1                               ReDim Preserve NewElement(i)                               NewElement(i) = "Allowed Subnet: "&Entry                          End If                     Next                     For Each Entry In IPSecurity.DomainGrant                          i = UBound(NewElement) + 1                          ReDim Preserve NewElement(i)                          NewElement(i) = "Allowed Domain: "&Entry                     Next                End If                ManageIPRestrictions = NewElement           Case "SET"                If Restrict <> "" Then                     Select Case UCase(RestrictAction)                         Case "GRANTIP"                             Set IPSecurity = Site.IPSecurity                             IPSecurity.GrantByDefault = False                             Site.IPSecurity = IPSecurity                             Site.SetInfo                             IPSecurity.IPGrant = Array(Restrict&", 255.255.255.255")                             Site.IPSecurity = IPSecurity                             Site.SetInfo                             If Err.Number = 0 Then ManageIPRestrictions = True                         Case "GRANTSUBNET"                             Set IPSecurity = Site.IPSecurity                             IPSecurity.GrantByDefault = False                             IPSecurity.IPGrant = Array(Restrict&", "&IPSubnet)                             Site.IPSecurity = IPSecurity                             Site.SetInfo                             If Err.Number = 0 Then ManageIPRestrictions = True                         Case "GRANTDOMAIN"                             Set IPSecurity = Site.IPSecurity                             IPSecurity.GrantByDefault = False                             IPSecurity.DomainGrant = Array(Restrict)                             Site.IPSecurity = IPSecurity                             Site.SetInfo                             If Err.Number = 0 Then ManageIPRestrictions = True                         Case "DENYIP"                             Set IPSecurity = Site.IPSecurity                             IPSecurity.GrantByDefault = True                             IPSecurity.IPDeny = Array(Restrict&", 255.255.255.255")                             Site.IPSecurity = IPSecurity                             Site.SetInfo                             If Err.Number = 0 Then ManageIPRestrictions = True                         Case "DENYSUBNET"                             Set IPSecurity = Site.IPSecurity                             IPSecurity.GrantByDefault = True                             IPSecurity.IPDeny = Array(Restrict&", "&IPSubnet)                             Site.IPSecurity = IPSecurity                             Site.SetInfo                             If Err.Number = 0 Then ManageIPRestrictions = True                         Case "DENYDOMAIN"                             Set IPSecurity = Site.IPSecurity                             IPSecurity.GrantByDefault = True                             IPSecurity.DomainDeny = Array(Restrict)                             Site.IPSecurity = IPSecurity                             Site.SetInfo                             If Err.Number = 0 Then ManageIPRestrictions = True                     End Select                End If      End Select End Function Public Function ManagePerformanceProperty(ByVal TargetComputer As String, ByVal SiteIndex  graphics/ccc.gifAs Integer, ByVal Action As String, ByVal IdentityProperty As String, Optional ByVal  graphics/ccc.gifNewValue As Variant) As Variant      Dim Site As IADs      Set Site = GetObject("IIS://" & TargetComputer & "/W3SVC/" & SiteIndex)      Select Case UCase(Action)           Case "QUERY"                Select Case UCase(IdentityProperty)                     Case "SERVERSIZE"                          ManagePerformanceProperty = Site.ServerSize                     Case "MAXBANDWIDTH"                          ManagePerformanceProperty = Site.MaxBandwidth                     Case "ALLOWKEEPALIVE"                          ManagePerformanceProperty = Site.AllowKeepAlive                     Case "HTTPEXPIRES"                          Set Site = GetObject("IIS://"&TargetComputer&"/W3SVC/ graphics/ccc.gif"&SiteIndex&"/ROOT")                          ManagePerformanceProperty = Site.HttpExpires                End Select           Case "SET"                If NewValue <> "" Then                     Select Case UCase(IdentityProperty)                          Case "SERVERSIZE"                               Site.ServerSize = NewValue                          Case "MAXBANDWIDTH"                               Site.MaxBandwidth = NewValue                          Case "ALLOWKEEPALIVE"                               Site.AllowKeepAlive = NewValue                          Case "HTTPEXPIRES"                               Set Site = GetObject("IIS://"&TargetComputer&"/W3SVC/ graphics/ccc.gif"&SiteIndex&"/ROOT")                               Site.HttpExpires = NewValue                     End Select                     Site.SetInfo                     If Err.Number = 0 Then ManagePerformanceProperty = True                End If      End Select End Function Public Function ManageHomeDirectoryProperty(ByVal TargetComputer As String, ByVal  graphics/ccc.gifSiteIndex As Integer, ByVal RelativePath As String, ByVal Action As String, ByVal  graphics/ccc.gifIdentityProperty As String, Optional ByVal NewValue As Variant) As Variant      Dim Resource As IADs      Set Resource = GetObject("IIS://"&TargetComputer&"/W3SVC/"&SiteIndex&"/ graphics/ccc.gifROOT"&RelativePath)      Select Case UCase(Action)           Case "QUERY"                Select Case UCase(IdentityProperty)                     Case "PATH"                          ManageHomeDirectoryProperty = Resource.Path                     Case "UNCUSERNAME"                          ManageHomeDirectoryProperty = Resource.UNCUsername                     Case "UNCPASSWORD"                          ManageHomeDirectoryProperty = Resource.UNCPassword                     Case "ACCESSREAD"                          ManageHomeDirectoryProperty = Resource.AccessRead                     Case "ACCESSWRITE"                          ManageHomeDirectoryProperty = Resource.AccessWrite                     Case "DONTLOG"                          ManageHomeDirectoryProperty = Resource.DontLog                     Case "ENABLEDIRBROWSING"                          ManageHomeDirectoryProperty = Resource.EnableDirBrowsing                     Case "CONTENTINDEXED"                          ManageHomeDirectoryProperty = Resource.ContentIndexed                     Case "FRONTPAGEWEB"                          Set Resource = GetObject(Resource.Parent)                          ManageHomeDirectoryProperty = Resource.FrontPageWeb                     Case "HTTPREDIRECT"                          ManageHomeDirectoryProperty = Resource.HttpRedirect                End Select           Case "SET"                If NewValue <> "" Then                     Select Case UCase(IdentityProperty)                          Case "PATH"                               Resource.Path = NewValue                          Case "UNCUSERNAME"                               Resource.UNCUsername = NewValue                          Case "UNCPASSWORD"                               Resource.UNCPassword = NewValue                          Case "ACCESSREAD"                               Resource.AccessRead = NewValue                          Case "ACCESSWRITE"                               Resource.AccessWrite = NewValue                          Case "DONTLOG"                               Resource.DontLog = NewValue                          Case "ENABLEDIRBROWSING"                               Resource.EnableDirBrowsing = NewValue                          Case "CONTENTINDEXED"                               Resource.ContentIndexed = NewValue                          Case "FRONTPAGEWEB"                               Set Resource = GetObject(Resource.Parent)                               Resource.FrontPageWeb = NewValue                          Case "HTTPREDIRECT"                               Resource.HttpRedirect = NewValue                     End Select                     Resource.SetInfo                     If Err.Number = 0 Then ManageHomeDirectoryProperty = True                End If      End Select End Function Public Function ManageApplicationProperty(ByVal TargetComputer As String, ByVal SiteIndex  graphics/ccc.gifAs Integer, ByVal RelativePath As String, ByVal Action As String, ByVal IdentityProperty  graphics/ccc.gifAs String, Optional ByVal NewValue As Variant) As Variant      Dim Resource As IADs      Set Resource = GetObject("IIS://"&TargetComputer&"/W3SVC/"&SiteIndex&"/ graphics/ccc.gifROOT"&RelativePath)      Select Case UCase(Action)           Case "QUERY"                Select Case UCase(IdentityProperty)                     Case "APPFRIENDLYNAME"                          ManageApplicationProperty = Resource.AppFriendlyName                     Case "APPROOT"                          ManageApplicationProperty = Resource.AppRoot                     Case "APPISOLATED"                          ManageApplicationProperty = Resource.AppIsolated                     Case "ACCESSREAD"                          ManageApplicationProperty = Resource.AccessRead                     Case "ACCESSEXECUTE"                          ManageApplicationProperty = Resource.AccessExecute                     Case "ASPSESSIONTIMEOUT"                          ManageApplicationProperty = Resource.AspSessionTimeout                     Case "ASPBUFFERINGON"                          ManageApplicationProperty = Resource.AspBufferingOn                     Case "ASPENABLEPARENTPATHS"                          ManageApplicationProperty = Resource.AspEnableParentPaths                     Case "ASPSCRIPTLANGUAGE"                          ManageApplicationProperty = Resource.AspScriptLanguage                     Case "ASPSCRIPTTIMEOUT"                          ManageApplicationProperty = Resource.AspScriptTimeout                     Case "ASPLOGERRORREQUESTS"                          ManageApplicationProperty = Resource.AspLogErrorRequests                     Case "ASPEXCEPTIONCATCHENABLE"                          ManageApplicationProperty = Resource.AspExceptionCatchEnable                     Case "ASPSCRIPTENGINECACHEMAX"                          ManageApplicationProperty = Resource.AspScriptEngineCacheMax                     Case "ASPSCRIPTFILECACHESIZE"                          ManageApplicationProperty = Resource.AspScriptFileCacheSize                     Case "CGITIMEOUT"                          Set Resource = GetObject(Resource.Parent)                          ManageApplicationProperty = Resource.CGITimeout                     Case "APPALLOWDEBUGGING"                          ManageApplicationProperty = Resource.AppAllowDebugging                     Case "APPALLOWCLIENTDEBUG"                          ManageApplicationProperty = Resource.AppAllowClientDebug                     Case "ASPSCRIPTERRORSENTTOBROWSER"                          ManageApplicationProperty = Resource.AspScriptErrorSentToBrowser                     Case "ASPSCRIPTERRORMESSAGE"                          ManageApplicationProperty = Resource.AspScriptErrorMessage                End Select           Case "SET"                If NewValue <> "" Then                     Select Case UCase(IdentityProperty)                          Case "APPFRIENDLYNAME"                               Resource.AppFriendlyName = NewValue                          Case "APPROOT"                               Resource.AppRoot = NewValue                          Case "APPISOLATED"                               Resource.AppIsolated = NewValue                          Case "ACCESSREAD"                               Resource.AccessRead = NewValue                          Case "ACCESSEXECUTE"                               Resource.AccessExecute = NewValue                          Case "ASPSESSIONTIMEOUT"                               Resource.AspSessionTimeout = NewValue                          Case "ASPBUFFERINGON"                               Resource.AspBufferingOn = NewValue                          Case "ASPENABLEPARENTPATHS"                               Resource.AspEnableParentPaths = NewValue                          Case "ASPSCRIPTLANGUAGE"                               Resource.AspScriptLanguage = NewValue                          Case "ASPSCRIPTTIMEOUT"                               Resource.AspScriptTimeout = NewValue                          Case "ASPLOGERRORREQUESTS"                               Resource.AspLogErrorRequests = NewValue                          Case "ASPEXCEPTIONCATCHENABLE"                               Resource.AspExceptionCatchEnable = NewValue                          Case "ASPSCRIPTENGINECACHEMAX"                               Resource.AspScriptEngineCacheMax = NewValue                          Case "ASPSCRIPTFILECACHESIZE"                               Resource.AspScriptFileCacheSize = NewValue                          Case "CGITIMEOUT"                               Set Resource = GetObject(Resource.Parent)                               Resource.CGITimeout = NewValue                          Case "APPALLOWDEBUGGING"                               Resource.AppAllowDebugging = NewValue                          Case "APPALLOWCLIENTDEBUG"                               Resource.AppAllowClientDebug = NewValue                          Case "ASPSCRIPTERRORSENTTOBROWSER"                               Resource.AspScriptErrorSentToBrowser = NewValue                          Case "ASPSCRIPTERRORMESSAGE"                               Resource.AspScriptErrorMessage = NewValue                     End Select                     Resource.SetInfo                     If Err.Number = 0 Then ManageApplicationProperty = True                End If      End Select End Function Public Function ManageSSLConfigProperty(ByVal TargetComputer As String, ByVal SiteIndex  graphics/ccc.gifAs Integer, ByVal RelativePath As String, ByVal Action As String, ByVal IdentityProperty  graphics/ccc.gifAs String, Optional ByVal NewValue As Variant) As Variant      Dim Resource As IADs      Set Resource = GetObject("IIS://"&TargetComputer&"/W3SVC/"&SiteIndex&"/ graphics/ccc.gifROOT"&RelativePath)      Select Case UCase(Action)           Case "QUERY"                Select Case UCase(IdentityProperty)                     Case "ACCESSSSL"                          ManageSSLConfigProperty = Resource.AccessSSL                     Case "ACCESSSSL128"                          ManageSSLConfigProperty = Resource.AccessSSL128                     Case "ACCESSSSLMAPCERT"                          ManageSSLConfigProperty = Resource.AccessSSLMapCert                     Case "ACCESSSSLNEGOTIATECERT"                          ManageSSLConfigProperty = Resource.AccessSSLNegotiateCert                     Case "ACCESSSSLREQUIRECERT"                          ManageSSLConfigProperty = Resource.AccessSSLRequireCert                End Select           Case "SET"                If NewValue <> "" Then                     Select Case UCase(IdentityProperty)                          Case "ACCESSSSL"                               Resource.AccessSSL = NewValue                          Case "ACCESSSSL128"                               Resource.AccessSSL128 = NewValue                          Case "ACCESSSSLMAPCERT"                               Resource.AccessSSLMapCert = NewValue                          Case "ACCESSSSLNEGOTIATECERT"                               Resource.AccessSSLNegotiateCert = NewValue                          Case "ACCESSSSLREQUIRECERT"                               Resource.AccessSSLRequireCert = NewValue                     End Select                     Resource.SetInfo                     If Err.Number = 0 Then ManageSSLConfigProperty = True                End If      End Select End Function Public Function ManageDefaultDocumentProperty(ByVal TargetComputer As String, ByVal  graphics/ccc.gifSiteIndex As Integer, ByVal RelativePath As String, ByVal Action As String, ByVal  graphics/ccc.gifIdentityProperty As String, Optional ByVal NewValue As Variant) As Variant      Dim Site As IADs      Set Site = GetObject("IIS://"&TargetComputer&"/W3SVC/"&SiteIndex&"/ graphics/ccc.gifROOT"&RelativePath)      Select Case UCase(Action)           Case "QUERY"                Select Case UCase(IdentityProperty)                     Case "ENABLEDEFAULTDOC"                          ManageDefaultDocumentProperty = Site.EnableDefaultDoc                     Case "DEFAULTDOC"                          ManageDefaultDocumentProperty = Site.DefaultDoc                     Case "DEFAULTDOCFOOTER"                          ManageDefaultDocumentProperty = Site.DefaultDocFooter                     Case "ENABLEDOCFOOTER"                          ManageDefaultDocumentProperty = Site.EnableDocFooter                End Select           Case "SET"                If NewValue <> "" Then                     Select Case UCase(IdentityProperty)                          Case "ENABLEDEFAULTDOC"                               Site.EnableDefaultDoc = NewValue                          Case "DEFAULTDOC"                               Site.DefaultDoc = NewValue                          Case "DEFAULTDOCFOOTER"                               Site.DefaultDocFooter = NewValue                          Case "ENABLEDOCFOOTER"                               Site.EnableDocFooter = NewValue                     End Select                     Site.SetInfo                     If Err.Number = 0 Then ManageDefaultDocumentProperty = True                End If      End Select End Function Public Function ManageHTTPHeaderProperty(ByVal TargetComputer As String, ByVal SiteIndex  graphics/ccc.gifAs Integer, ByVal RelativePath As String, ByVal Action As String, ByVal IdentityProperty  graphics/ccc.gifAs String, Optional ByVal NewValue As Variant) As Variant      On Error Resume Next      Dim Resource As IADs      Dim ArrayEntry As Variant      Dim NewElement() As Variant      Dim i As Integer      Set Resource = GetObject("IIS://"&TargetComputer&"/W3SVC/"&SiteIndex&"/ graphics/ccc.gifROOT"&RelativePath)      Select Case UCase(Action)           Case "QUERY"                Select Case UCase(IdentityProperty)                     Case "HTTPCUSTOMHEADERS"                          For Each ArrayEntry In Resource.HttpCustomHeaders                               i = UBound(NewElement) + 1                               ReDim Preserve NewElement(i)                               NewElement(i) = ArrayEntry                          Next                          ManageHTTPHeaderProperty = NewElement                     Case "PICSRATING"                          For Each ArrayEntry In Resource.HttpPics                               i = UBound(NewElement) + 1                               ReDim Preserve NewElement(i)                               NewElement(i) = ArrayEntry                          Next                          ManageHTTPHeaderProperty = NewElement                End Select           Case "SET"                If NewValue <> "" Then                     Select Case UCase(IdentityProperty)                          Case "HTTPCUSTOMHEADERS"                               If IsArray(Resource.HttpCustomHeaders) Then                                    For Each ArrayEntry In Resource.HttpCustomHeaders                                         i = UBound(NewElement) + 1                                         ReDim Preserve NewElement(i)                                         NewElement(i) = ArrayEntry                                    Next                                    i = UBound(NewElement) + 1                                    ReDim Preserve NewElement(i)                                    NewElement(i) = NewValue                                    Resource.HttpCustomHeaders = NewElement                                    Err.Number = 0                               Else                                    Resource.HttpCustomHeaders = Array(NewValue)                               End If                          Case "PICSRATING"                               Resource.HttpPics = Array(NewValue)                     End Select                     Resource.SetInfo                     If Err.Number = 0 Then ManageHTTPHeaderProperty = True                End If      End Select End Function Public Function CreatePICSLabel(ByVal ResponsiblePartyEMail As String, ByVal  graphics/ccc.gifExpirationDate As Date, ByVal ViolenceRating As Integer, ByVal SexRating As Integer,  graphics/ccc.gifByVal NudityRating As Integer, ByVal LanguageRating As Integer) As String      Dim PicsExpirationDate As String      Dim PicsCurrentDate As String      PicsExpirationDate =  graphics/ccc.gifYear(ExpirationDate)&"."&(Month(ExpirationDate))&"."&Day(ExpirationDate)& "T12:00-0000"      PicsCurrentDate = Year(Date)&"."&(Month(Date))&"."&Day(Date)&"T12:00-0000"      CreatePICSLabel = "PICS-Label: (PICS-1.0 ""http://www.rsac.org/ratingsv01.html"" l  graphics/ccc.gifby """& ResponsiblePartyEMail&""" on """&PicsCurrentDate&""" exp  graphics/ccc.gif"""&PicsExpirationDate&""" r (v "& ViolenceRating&" s "&SexRating&" n "&NudityRating&" l  graphics/ccc.gif"&LanguageRating&"))" End Function 
  5. Compile the code as IIsAdmin.DLL.

  6. Save and close the IIsAdmin project.

Tip

You can download the Visual Basic 6.0 project or precompiled version of IisAdmin.DLL from http://www.newriders.com/adsi.


Using the Functions in IIsWebManagement

With the IIsWebManagement class module created, you can access this function from any programming language that supports OLE automation, including Visual Basic, VBScript, and JavaScript.

Tip

To instantiate the object, follow the appropriate syntax found in Chapter 3, "Container Enumeration Methods and Programmatic Domain Account Policy Manipulation."

Substitute theIIsAdmin.IIsWebManagement object and class name where necessary..


Use Table 9.9 to help you use the proper syntax for each of the methods of the IIsWebManagement interface.

Table 9.9. Proper IIsWebManagement Interface Method Syntax
Action Syntax
Query/Set Server Comment
 ManageIdentityProperty("Server_Name", 1, "Query", "ServerComment") ManageIdentityProperty("Server_Name", 1, "Set", "ServerComment", "Default Web Site")
Query/Set ServerBindings
 For Each Binding In ManageIdentityProperty ("Server_Name", 1, "Query", "ServerBindings")       Debug.Print Binding Next ManageIdentityProperty("Server_Name", 1, "Set", "AddServerBinding", "127.0.0.1:81:") ManageIdentityProperty("Server_Name", 1, "Set", "RemoveAllServerBindings") ManageIdentityProperty("Server_Name", 1, "Set", "RemoveServerBinding", "127.0.0.1:81:")
Query/Set SecureBindings
 For Each Binding In ManageIdentityProperty ("Server_Name", 1, "Query", "SecureBindings")     Debug.Print Binding Next ManageIdentityProperty("Server_Name", 1, "Set", "AddSecureBinding", "127.0.0.1:445:") ManageIdentityProperty("Server_Name", 1, "Set", "RemoveAllSecureBindings") ManageIdentityProperty("Server_Name", 1, "Set", "RemoveSecureBinding", "127.0.0.1:445:")
Query/Set MaxConnections
 ManageIdentityProperty("Server_Name", 1, "Query", "MaxConnections") ManageIdentityProperty("Server_Name", 1, "Set", "MaxConnections", 1000) 
Query/Set Connection Timeout
 ManageIdentityProperty("Server_Name", 1,"Query", "ConnectionTimeout") ManageIdentityProperty("Server_Name", 1, "Set", "ConnectionTimeout", 900) 
Enumerate Site Operators
 For Each Operator In ManageOperators ("Server_Name", 1, "Query", "Operators")     Debug.Print Operator Next 
Manage Site Operators
 ManageOperators("Server_Name", 1,"Set", "NewOperator", "Server_Name\Administrator") ManageOperators("Server_Name", 1, "Set", "RemoveOperator, Server_Name\Administrator)
Enumerate Authenication Methods for a Resource
 For Each Item In ManageAuthenticationMethods (Server_Name, 1, Query, "AllAuthenticationMethods")     Debug.Print Item Next 
Query Authentication Method Properties for a Given Resource
 ManageAuthenticationMethods("Server_Name", 1, "query","anonymous") ManageAuthenticationMethods("Server_Name", 1, "Query", "Basic") ManageAuthenticationMethods("Server_Name", 1, "Query", "NTLM") ManageAuthenticationMethods("Server_Name", 1, "Query", "AnonymousUserName") ManageAuthenticationMethods("Server_Name", 1, "Query", "AnonymousUserPass") ManageAuthenticationMethods("Server_Name", 1, "Query", "AnonymousPasswordSync") ManageAuthenticationMethods("Server_Name", 1, "Query", "DefaultLogonDomain") 
Set Authentication Method Properties for a Given Resource
 ManageAuthenticationMethods("Server_Name", 1, "Set", "Anonymous", False) ManageAuthenticationMethods("Server_Name", 1, "Set", "Basic", False) ManageAuthenticationMethods("Server_Name", 1, "Set", "NTLM", False) ManageAuthenticationMethods("Server_Name", 1, "Set", "AnonymousUserName", "Server_Name\IUSR_Server_Name") ManageAuthenticationMethods("Server_Name", 1, "Set", "AnonymousUserPass", "u327eshf2sa!") ManageAuthenticationMethods("Server_Name", 1, "Set", "AnonymousPasswordSync", True) ManageAuthenticationMethods("Server_Name", 1, "Set", "DefaultLogonDomain", "User_Domain_Name")
Enumerate Site Specific MIME Types
 For Each Item In Obj.MIMETypeManagement ("IIS_Server_Name", "Enumerate")     Debug.Print Item Next 
Add New Site Specific MIME Type
 MIMETypeManagement("IIS_Server_Name", "Add", ".Extension", "Application/Type") 
Remove Site Specific MIME Type
 MIMETypeManagement("IIS_Server_Name", "Remove", ".Extension") 
Query IP Restrictions
 For Each Item In ManageIPRestrictions ("Server_Name", 1, "/ROOT", "Query")     Debug.Print Item Next 
Deny All Access Except Specified IP
 ManageIPRestrictions("Server_Name", 1, "/ROOT", "Set", "GrantIP", "xxx.xxx.xxx.xxx")
Deny All Access Except Specified Subnet
 ManageIPRestrictions("Server_Name", 1, "/ROOT", "Set", "GrantSubnet", "xxx.xxx.xxx.xxx", "xxx.xxx.xxx.0") 
Deny All Access Except Specified DNS Domain
 ManageIPRestrictions("Server_Name", 1, "/ROOT", "Set", "GrantDomain", "DNS_Domain") 
Grant All Access Except Specified Address
 ManageIPRestrictions("Server_Name", 1, "/ROOT", "Set", "DenyIP", "xxx.xxx.xxx.xxx") 
Grant All Access Except Specified Subnet
 ManageIPRestrictions("Server_Name", 1, "/ROOT", "Set", "DenySubnet", "xxx.xxx.xxx.xxx", "xxx.xxx.xxx.0") 
Grant All Access Except Specified Domain
 ManageIPRestrictions("Server_Name", 1, "/ROOT", "Set", "DenyDomain", "DNS_Domain") 
Query Performance Properties and HTTP Expiration
 ManagePerformanceProperty("Server_Name", 1, "Query", "ServerSize") ManagePerformanceProperty("Server_Name", 1, "Query", "MaxBandwidth") ManagePerformanceProperty("Server_Name", 1, "Query", "AllowKeepAlive") ManagePerformanceProperty("Server_Name", 1, "Query", "HttpExpires") 
Set Performance Properties and HTTP Expiration
 ManagePerformanceProperty("Server_Name", 1, "Set", "ServerSize", 1) ManagePerformanceProperty("Server_Name", 1, "Set", "MaxBandwidth", 104856) ManagePerformanceProperty("Server_Name", 1, "Set", "AllowKeepAlive", False) ManagePerformanceProperty("Server_Name", 1, "Set", "HttpExpires", "D,60") 
Query Home Directory Properties
 ManageHomeDirectoryProperty("Server_Name", 1, "","Query","Path") ManageHomeDirectoryProperty("Server_Name", 1, "","Query","UNCUsername") ManageHomeDirectoryProperty("Server_Name", 1, "","Query","UNCUserPass") ManageHomeDirectoryProperty("Server_Name", 1, "","Query","AccessRead") ManageHomeDirectoryProperty("Server_Name", 1, "","Query","AccessWrite") ManageHomeDirectoryProperty("Server_Name", 1, "","Query","DontLog") ManageHomeDirectoryProperty("Server_Name", 1, "","Query","EnableDirBrowsing") ManageHomeDirectoryProperty("Server_Name", 1, "","Query","ContentIndexed") ManageHomeDirectoryProperty("Server_Name", 1, "","Query","FrontPageWeb") ManageHomeDirectoryProperty("Server_Name", 1, "","Query","HttpRedirect") 
Set Home Directory Properties
 ManageHomeDirectoryProperty("Server_Name", 1, "","Set","Path","c:\inetpub\wwwroot") [Local] ManageHomeDirectoryProperty("Server_Name", 1, "","Set","Path","\\servername\share") [Remote] ManageHomeDirectoryProperty("Server_Name", 1, "","Set","UNCUsername","Server_Name\ administrator") ManageHomeDirectoryProperty("Server_Name", 1, "","Set","UNCUserPass","sih93f91hfsNA") ManageHomeDirectoryProperty("Server_Name", 1, "","Set","AccessRead", True) ManageHomeDirectoryProperty("Server_Name", 1, "","Set","AccessWrite", True) ManageHomeDirectoryProperty("Server_Name", 1, "","Set","DontLog", False) ManageHomeDirectoryProperty("Server_Name", 1, "","Set","EnableDirBrowsing", True) ManageHomeDirectoryProperty("Server_Name", 1, "","Set","ContentIndexed", True) ManageHomeDirectoryProperty("Server_Name", 1, "","Set","FrontPageWeb", True) ManageHomeDirectoryProperty("Server_Name", 1, "","Set","HttpRedirect","SiteName,FLAG")
Query Application Properties
 ManageApplicationProperty("Server_Name", 1, "","Query","AppFriendlyName") ManageApplicationProperty("Server_Name", 1, "", "Query","AppRoot") ManageApplicationProperty("Server_Name", 1, "", "Query","AppIsolated") ManageApplicationProperty("Server_Name", 1, "", "Query","AccessRead") ManageApplicationProperty("Server_Name", 1, "", "Query","AccessExecute") ManageApplicationProperty("Server_Name", 1, "", "Query","AspSessionTimeout") ManageApplicationProperty("Server_Name", 1, "", "Query","AspBufferingOn") ManageApplicationProperty("Server_Name", 1, "", "Query","AspEnableParentPaths") ManageApplicationProperty("Server_Name", 1, "", "Query","AspScriptLanguage") ManageApplicationProperty("Server_Name", 1, "", "Query","AspScriptTimeout") ManageApplicationProperty("Server_Name", 1, "", "Query","AspLogErrorRequests") ManageApplicationProperty("Server_Name", 1, "", "Query","AspExceptionCatchEnable") ManageApplicationProperty("Server_Name", 1, "", "Query","AspScriptEngineCacheMax") ManageApplicationProperty("Server_Name", 1, "", "Query","AspScriptFileCacheSize") ManageApplicationProperty("Server_Name", 1, "", "Query","CGITimeout") ManageApplicationProperty("Server_Name", 1, "", "Query","AppAllowDebugging") ManageApplicationProperty("Server_Name", 1, "", "Query","AppAllowClientDebug") ManageApplicationProperty("Server_Name", 1, "", "Query","AspScriptErrorSentToBrowser") ManageApplicationProperty("Server_Name", 1, "", "Query","AspScriptErrorMessage") 
Set Application Properties
 ManageApplicationProperty("Server_Name", 1, "", "Set","AppFriendlyName","Default Application") ManageApplicationProperty("Server_Name", 1, "", "Set","AppRoot","/LM/W3SVC/1/ROOT") ManageApplicationProperty("Server_Name", 1, "", "Set","AppIsolated", False) ManageApplicationProperty("Server_Name", 1, "", "Set","AccessRead", False) ManageApplicationProperty("Server_Name", 1, "", "Set","AccessExecute", False) ManageApplicationProperty("Server_Name", 1, "", "Set","AspSessionTimeout", 60) ManageApplicationProperty("Server_Name", 1, "", "Set","AspBufferingOn", True) ManageApplicationProperty("Server_Name", 1, "", "Set","AspEnableParentPaths", True) ManageApplicationProperty("Server_Name", 1, "", "Set","AspScriptLanguage","VBScript") ManageApplicationProperty("Server_Name", 1, "", "Set","AspScriptTimeout", 360) ManageApplicationProperty("Server_Name", 1, "", "Set","AspLogErrorRequests", False) ManageApplicationProperty("Server_Name", 1, "", "Set","AspExceptionCatchEnable", False) ManageApplicationProperty("Server_Name", 1, "", "Set","AspScriptEngineCacheMax", 60) ManageApplicationProperty("Server_Name", 1, "", "Set","AspScriptFileCacheSize", 1024) ManageApplicationProperty("Server_Name", 1, "", "Set","CGITimeout", 300) ManageApplicationProperty("Server_Name", 1, "", "Set","AppAllowDebugging", True) ManageApplicationProperty("Server_Name", 1, "", "Set","AppAllowClientDebug", True) ManageApplicationProperty("Server_Name", 1, "", "Set","AspScriptErrorSentToBrowser", False) ManageApplicationProperty("Server_Name", 1, "", "Set","AspScriptErrorMessage","An error has occurred. Please call the corporate technical support center at x9321") 
Query SSL COnfiguration Properties
 ManageSSLConfigProperty("Server_Name", 1, "", "Query","AccessSSL") ManageSSLConfigProperty("Server_Name", 1, "", "Query","AccessSSL128") ManageSSLConfigProperty("Server_Name", 1, "", "Query","AccessSSLMapCert") ManageSSLConfigProperty("Server_Name", 1, "", "Query","AccessSSLNegotiateCert") ManageSSLConfigProperty("Server_Name", 1, "", "Query","AccessSSLRequireCert") 
Set SSL Configuration Properties
 ManageSSLConfigProperty("Server_Name", 1, "", "Set","AccessSSL", False) ManageSSLConfigProperty("Server_Name", 1, "", "Set","AccessSSL128", False) ManageSSLConfigProperty("Server_Name", 1, "", "Set","AccessSSLMapCert", False) ManageSSLConfigProperty("Server_Name", 1, "", "Set","AccessSSLNegotiateCert", False) ManageSSLConfigProperty("Server_Name", 1, "", "Set","AccessSSLRequireCert", False) 
Query Default Document and Default Footer Properties
 ManageDefaultDocumentProperty("Server_Name", 1, "","Query","DefaultDoc") ManageDefaultDocumentProperty("Server_Name", 1, "","Query","EnableDefaultDoc") ManageDefaultDocumentProperty("Server_Name", 1, "","Query","DefaultDocFooter") ManageDefaultDocumentProperty("Server_Name", 1, "","Query","EnableDocFooter") 
Set Default Document and Default Footer Properties
 ManageDefaultDocumentProperty("Server_Name", 1, "","Set","DefaultDoc","default.asp") ManageDefaultDocumentProperty("Server_Name", 1, "","Set","EnableDefaultDoc", True) ManageDefaultDocumentProperty("Server_Name", 1, "","Set","DefaultDocFooter","C:\Inetpub\ wwwroot\LegalFooter.htm") ManageDefaultDocumentProperty("Server_Name", 1, "","Set","EnableDocFooter", True) 
Query Custom HTTP Header Configuration
 For Each Header In ManageHTTPHeaderProperty ("Server_Name", 1, "","Query", "HttpCustomHeaders")     Debug.Print Header Next 
Add New Custom HTTP Header
 ManageHTTPHeaderProperty("Server_Name", 1, "", "Set","HttpCustomHeaders","CustomHeader1: True")
Query RSACi/PICS Ratings for a Given Resource
 For Each Header In ManageHTTPHeaderProperty ("Server_Name", 1, "","Query","PicsRating")     Debug.Print Header Next 
Set New RSACi/PICS Rating for a Given Resource
 Dim PICSLabel As String PICSLabel = CreatePICSLabel("thomas.eck@wdr.com", #1/1/2001#, 0, 0, 0, 0) ManageHTTPHeaderProperty("Server_Name", 1, "", "Set","PicsRating", PICSLabel) 

Top


Windows NT. 2000 ADSI Scripting for System Administration
Windows NT/2000 ADSI Scripting for System Administration
ISBN: 1578702194
EAN: 2147483647
Year: 2000
Pages: 194
Authors: Thomas Eck

flylib.com © 2008-2017.
If you may any questions please contact us: flylib@qtcs.net