In this section, you will continue the creation of the IIsAdmin.DLL COM server application started in Chapter 8.
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.
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.
Name the new module IIsWebManagement.
Enter the following code into the General Declarations section of the class module:
Public Function ManageIdentityProperty(ByVal TargetComputer As String, ByVal SiteIndex As Integer, ByVal Action As String, ByVal IdentityProperty As String, Optional ByVal NewValue 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 Integer, ByVal Action As String, ByVal IdentityProperty As String, Optional ByVal NewValue 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 = 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 SiteIndex As Integer, ByVal Action As String, ByVal IdentityProperty As String, Optional ByVal 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: "&Resource.AuthAnonymous If Resource.AuthAnonymous = True Then i = UBound(NewElement) + 1 ReDim Preserve NewElement(i) NewElement(i) = "Anonymous Username: "&Resource.AnonymousUsername i = UBound(NewElement) + 1 ReDim Preserve NewElement(i) NewElement(i) = "Anonymous User Account Password: "&Resource.AnonymousUserPass i = UBound(NewElement) + 1 ReDim Preserve NewElement(i) NewElement(i) = "Anonymous User Account Password Sync Enabled: "& Resource.AnonymousPasswordSync End If i = UBound(NewElement) + 1 ReDim Preserve NewElement(i) NewElement(i) = "Basic Authentication Enabled: "&Resource.AuthBasic If Resource.AuthBasic = True Then i = UBound(NewElement) + 1 ReDim Preserve NewElement(i) NewElement(i) = "Basic Authentication Default Domain: "& Resource.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, ByVal Action As String, Optional ByVal MIMEExtension As String, Optional ByVal MIMEType As 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 Integer, ByVal RelativePath As String, ByVal Action As String, Optional ByVal RestrictAction As String, Optional ByVal Restrict As String, Optional ByVal IPSubnet As String) 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, ", 255.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, ", 255.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 As Integer, ByVal Action As String, ByVal IdentityProperty As String, Optional ByVal NewValue 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/ "&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/ "&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 SiteIndex As Integer, ByVal RelativePath As String, ByVal Action As String, ByVal IdentityProperty As String, Optional ByVal NewValue As Variant) As Variant Dim Resource As IADs Set Resource = GetObject("IIS://"&TargetComputer&"/W3SVC/"&SiteIndex&"/ ROOT"&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 As Integer, ByVal RelativePath As String, ByVal Action As String, ByVal IdentityProperty As String, Optional ByVal NewValue As Variant) As Variant Dim Resource As IADs Set Resource = GetObject("IIS://"&TargetComputer&"/W3SVC/"&SiteIndex&"/ ROOT"&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 As Integer, ByVal RelativePath As String, ByVal Action As String, ByVal IdentityProperty As String, Optional ByVal NewValue As Variant) As Variant Dim Resource As IADs Set Resource = GetObject("IIS://"&TargetComputer&"/W3SVC/"&SiteIndex&"/ ROOT"&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 SiteIndex As Integer, ByVal RelativePath As String, ByVal Action As String, ByVal IdentityProperty As String, Optional ByVal NewValue As Variant) As Variant Dim Site As IADs Set Site = GetObject("IIS://"&TargetComputer&"/W3SVC/"&SiteIndex&"/ ROOT"&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 As Integer, ByVal RelativePath As String, ByVal Action As String, ByVal IdentityProperty As 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&"/ ROOT"&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 ExpirationDate As Date, ByVal ViolenceRating As Integer, ByVal SexRating As Integer, ByVal NudityRating As Integer, ByVal LanguageRating As Integer) As String Dim PicsExpirationDate As String Dim PicsCurrentDate As String PicsExpirationDate = Year(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 by """& ResponsiblePartyEMail&""" on """&PicsCurrentDate&""" exp """&PicsExpirationDate&""" r (v "& ViolenceRating&" s "&SexRating&" n "&NudityRating&" l "&LanguageRating&"))" End Function
Compile the code as IIsAdmin.DLL.
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.
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.
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 |