' ************************************************************
' *  WebSetup.vbs         
' *  (cscript WebSetup.vbs [-n <instancenum>] [-s <server>])
' *  
' *  This sample file shows how to set up many of the IIS 5.0
' *  webserver options via ADSI scripting.  Where possible, 
' *  this script follows the configuration dialogs in the 
' *  Internet Services MMC module.
' *
' *  This script is designed to make it easy to locate the 
' *  steps for a specific task by (more or less) following 
' *  along with the setting in the MMC.  Subroutines have 
' *  only been used when necessary to preserve the author's 
' *  sanity. A more efficient script would have most of the 
' *  code in subroutines to allow reuse when setting up 
' *  multiple web servers or directories with different 
' *  settings.  
' *  
' *  DISCLAIMER: This script is intended for instructional 
' *  purposes only.  RUNNING THIS SCRIPT "AS-IS" MAY CAUSE 
' *  DISRUPTION AND/OR CORRUPTION OF CURRENT IIS SETTINGS.
' *  The author and Colorbox7.com make no claims regarding 
' *  this script and are not responsible for any damages 
' *  which may occur as a result of running this script.
' *  
' *  For more information about the IIS ADSI object model, 
' *  see "Administering IIS Programmatically" at 
' *  http://msdn.microsoft.com/library/psdk/iisref/aint7e9l.htm
' *
' *  NOTE:  Many of the settings created by this script simply 
' *  duplicate the default IIS settings and are included only 
' *  to indicate how these default settings could be changed.  
' *  Most IIS servers can be configured with a much simpler 
' *  script.  For simple examples, see the scripts in 
' *  c:\inetpub\AdminScripts.
' *
' *  Copyright 2000 - Colorbox7.com 
' *  Author: Sandra Lee (slee at colorbox7)
' *  Last Updated: 3/4/2000
' ************************************************************

Option Explicit
On Error Resume Next

' Define Constants

' Initialize variables
Dim nArgCount, nWebSeqNum, nIndex
Dim szExtension, szMapString, szComment, szLogCLSID, szServerName, szMap, szErrorMsg, szType
Dim szError, szCustomErr 
Dim aBindingsList, aMaps, aDomains, aIPs, aHeaders, aRatings, aMimeMap, aHTTPErrors
Dim oService, oServer, oLog, oVDir, oIPSecurity, oMap
Dim bServerRun, bNewServer, bFound

szServerName = "localhost"

nWebSeqNum = 9

' Get script arguments
nArgCount = 0
While nArgCount < Wscript.Arguments.Count
	Select Case Wscript.Arguments(nArgCount)
	Case "-s":	 ' Server Name
        ' Move to next arg, which should be parameter
		nArgCount =	nArgCount + 1  
		If nArgCount => Wscript.Arguments.Count Then
			Call UsageMsg
		Else
			szServerName = Wscript.Arguments(nArgCount)
		End If
	Case "-n":	 ' Server Name
        ' Move to next arg, which should be parameter
		nArgCount =	nArgCount + 1  
		If nArgCount => Wscript.Arguments.Count Then
			Call UsageMsg
		Else
			nWebSeqNum = Wscript.Arguments(nArgCount)
		End If
	End Select
Wend

' Run server after setup?
bServerRun = True
bNewServer = False

' Create an instance of the web service
Set oService = GetObject("IIS://" & szServerName & "/W3SVC")

' Now get or create the server
Set oServer = oService.GetObject("IIsWebServer", nWebSeqNum)
  
If oServer Is Nothing Then    ' Doesn't exist - create it  
	Set oServer = oService.Create("IIsWebServer", nWebSeqNum)
  
	' Error creating?
	If oServer Is Nothing Then	 ' Error!
		Wscript.Echo "Error:  ADSI Create failed to create server, Error #" & Err.Number
	End If
	bNewServer = True
Else
	bNewServer = False
End If

' ****************************************
' WEB SITE
' ****************************************

' IP Address

' Description
oServer.ServerComment = "Test Server"
' TCP Port (a collection of port bindings)
aBindingsList = Array(0)
aBindingsList(0) = ":80:"
oServer.ServerBindings = aBindingsList
' Tuning (small=0, medium=1, large=2)
oServer.ServerSize = 2	  
' Write info back to Metabase
oServer.SetInfo
' Connections (limited/unlimited)
	' Connections limited to (#)
	oServer.MaxConnections = 999

' HTTP Keep-alives enabled?
	oServer.AllowKeepAlives = True 	' True is the default

' Enable Logging?
	oServer.DontLog = False   ' False is the default
	
	' Logging format
	
  	' ** Get Logging Module info **	
	' Built-In formats available:
	'	Custom Logging
	'	NCSA Common Log File Format
	'	ODBC Logging
	'	Microsoft IIS Log File Format
	'	W3C Extended Log File Format 		(default)
    
    ' Get the CLSID for W3C Extended format
  	Set oLog = GetObject("IIS://" & szServerName & "/logging/W3C Extended Log File Format")
	szLogCLSID = oLog.LogModuleID
	oServer.LogPluginClsid = szLogCLSID
    
	' Log File Period (hourly=4, daily=1, weekly=2, monthly=3, when filesize reaches=0)
	' Set it to create a new log when file reaches 10MB
	oServer.LogFilePeriod = 0
	' Max log file size (unlimited = -1)
	oServer.LogFileTruncateSize = Hex(10485760)
	' Use Local Time?  If false (the default), uses UTC time for log file rollovers.
	oServer.LogFileLocaltimeRollover = True
	' Log file directory
	oServer.LogFileDirectory = "%WinDir%\System32\MyLogs"
	
    ' Extended properties  (W3C Extended format only)
    ' (Equivalent properties for each of these flags are also available, but why bother?)
    Const MD_EXTLOG_DATE 			= 1 	    ' Log date.  
    Const MD_EXTLOG_TIME 			= 2	        ' Log time. 
    Const MD_EXTLOG_CLIENT_IP 		= 4	        ' Log client IP address. 
    Const MD_EXTLOG_USERNAME 		= 8	        ' Log user name. 
    Const MD_EXTLOG_SITE_NAME 		= 16	    ' Log site name. 
    Const MD_EXTLOG_COMPUTER_NAME 	= 32	    ' Log computer name. 
    Const MD_EXTLOG_SERVER_IP 		= 64	    ' Log server's own IP address. 
    Const MD_EXTLOG_METHOD 			= 128	    ' Log protocol method. 
    Const MD_EXTLOG_URI_STEM 		= 256	    ' Log URI stem. 
    Const MD_EXTLOG_URI_QUERY 		= 512	    ' Log URI query. 
    Const MD_EXTLOG_HTTP_STATUS 	= 1024	    ' Log HTTP status. 
    Const MD_EXTLOG_WIN32_STATUS 	= 2048	    ' Log WIN32 status. 
    Const MD_EXTLOG_BYTES_SENT 		= 4096 	    ' Log total bytes sent. 
    Const MD_EXTLOG_BYTES_RECV 		= 8192	    ' Log total bytes received. 
    Const MD_EXTLOG_TIME_TAKEN 		= 16384 	' Log total time elapsed.  
    Const MD_EXTLOG_SERVER_PORT 	= 32768 	' Log server port. 
    Const MD_EXTLOG_USER_AGENT 		= 65536 	' Log user agent. 
    Const MD_EXTLOG_COOKIE 			= 131072 	' Log cookie. 
    Const MD_EXTLOG_REFERER 		= 262144	' Log referrer. 
    Const MD_EXTLOG_PROTOCOL_VERSION = 524288   ' Log client server protocol version.
    
    oServer.LogExtFileFlags = MD_EXTLOG_DATE Or MD_EXTLOG_TIME Or MD_EXTLOG_CLIENT_IP Or _
            MD_EXTLOG_METHOD Or MD_EXTLOG_HTTP_STATUS Or MD_EXTLOG_BYTES_SENT Or MD_EXTLOG_BYTES_RECV Or _
            MD_EXTLOG_USER_AGENT Or MD_EXTLOG_REFERER
		
' Write info back to Metabase
oServer.SetInfo

' ****************************************
' OPERATORS
' ****************************************

' ****************************************
' PERFORMANCE
' ****************************************
' Enable bandwidth throttling?
	' Maximum Network use (KB/second)

' Enable process throttling?
oServer.CpuAppEnabled = True
oServer.CpuEnableTotalProcs = True
oServer.CpuEnableAllProcLogging = True
oServer.CpuLoggingInterval = 60 	'Minutes
	' Maximum CPU Use (1/1000%)
	oServer.CpuLimitPriority = 10000
	' If CPU time limit is surpassed, change priority of the server processes to IDLE
	oServer.CpuLimitsEnabled = True
	oServer.CpuLimitPriority = True

' Write info back to Metabase
oServer.SetInfo

' ****************************************
' ISAPI FILTERS (list)
' ****************************************
'InstallFilter(Friendly Name, Filter Path & Filename, oServer)

' ****************************************
' HOME DIRECTORY
' ****************************************
' When connecting to this resource, the content should come from:
' (a directory on this computer/a share located on another computer/a redirection to a URL)
' Get or Create virtual root directory       
Set oVDir = oServer.GetObject("IIsWebVirtualDir", "ROOT")
  
If oVDir Is Nothing Then
	Set oVDir = oServer.Create("IIsWebVirtualDir", "ROOT")
End If

' Error creating?
If oVDir Is Nothing Then	  ' Error!
	Wscript.Echo "Error:  ADSI Create failed to create virtual root directory, Error #" & Err.Number
  	Wscript.Quit
End If

' Configure new virtual root
' Local Path
oVDir.Path = "c:\inetpub\myroot"
' Access rights (Script source/Read/Write/Directory Browse)
oVDir.AccessSource = False
oVDir.AccessRead = True
oVDir.AccessWrite = False
oVDir.EnableDirBrowsing = False
' Log Visits?
oVDir.DontLog = False
' Index this directory?
oVDir.ContentIndexed = True
' Execute Permissions (none, scripts only, scripts and executables)
oVDir.AccessScript = True

' Write info back to Metabase
oVDir.SetInfo

' AppCreate must be called after SetInfo
oVDir.AppCreate True
' Application Name
oVDir.AppFriendlyName = "Test Application"
' Application Protection (low - IIS process=0 / medium - pooled=2 / high - isolated=1)
oVDir.AppIsolated = 0
oVDir.SetInfo


' ****************************************
' APPLICATION CONFIGURATION
' ****************************************
' Cache ISAPI Applications?
oVDir.CacheISAPI = True

' App Mappings (list)
	' Associated Extension, Executable/DLL, Flag, Verbs"
	' Flags: 1 = Script Engine 
	'        4 = Check that file exists
	'        5 = Both of the above
' This example redirects .htm files to the SSI processor
szMapString = ".htm,C:\WINNT\System32\inetsrv\ssinc.dll,5,GET, HEAD, POST"
szExtension = ".htm"
aMaps = oVDir.ScriptMaps
nIndex = 0
bFound = False
' Check to see if this extension is already mapped
For Each szMap In aMaps 
	' Look at the extension (before the first comma)
	If Left(szMap, InStr(szMap, ",") - 1) = szExtension Then
		' Found it
		aMaps(nIndex) = szMapString		
		bFound = True
		Exit For
	End If
	nIndex = nIndex + 1
Next
' If it wasn't in the list, add it
If Not bFound Then
	Redim Preserve aMaps(UBound(aMaps)+1)
	aMaps(UBound(aMaps)) = szMapString
End If
oVDir.ScriptMaps = aMaps

' App Options
	' Enable session state?
	oVDir.AspAllowSessionState = True
	' Session timeout (minutes)
	oVDir.AspSessionTimeout = 30
	' Enable buffering?
	oVDir.AspBufferingOn = True
	' Enable parent paths relative to the current directory?
	oVDir.AspEnableParentPaths = False
	' Default ASP language (VBScript, Javascript)
	oVDir.AspScriptLanguage = "VBScript"
	' ASP Script Timeout (seconds)
	oVDir.AspScriptTimeout = 60
	
' App Debugging
	' Enable server-side debugging?
	oVDir.AppAllowDebugging = False
	' Enable client-side debugging?
	oVDir.AppAllowClientDebug = False
	' Send detailed error message to client OR
	'   send text error message to client
		oVDir.AspScriptErrorSentToBrowser = False
		' Text error message
		szErrorMsg = "There was a problem processing your request.<br><br>" 
		szErrorMsg = szErrorMsg & "Please contact <a href=""mailto:support@mydomain.com"">Technical Support</a> " 
		szErrorMsg = szErrorMsg & "if this problem persists."
		oVDir.AspScriptErrorMessage = szErrorMsg
' Write info back to Metabase
oVDir.SetInfo


' ****************************************
' DOCUMENTS
' ****************************************
' Enable default document?
oVDir.EnableDefaultDoc = True	
	' Default documents (multiple files separated by a comma)
	oVDir.DefaultDoc = "default.asp, default.htm, index.html"
	
' Enable document footer?   (This doesn't work as documented - causes errors)
' oVDir.EnableDocFooter = True
	' File location or text string
	' oVDir.DefaultDocFooter = "c:\inetpub\testfooter.txt"

' Write info back to Metabase
oVDir.SetInfo
	
' ****************************************
' DIRECTORY SECURITY
' ****************************************
' Anonymous Access and Authentication Control
	' Allow anonymous access?
	oVDir.AuthAnonymous = True
		' Account used for anonymous access
		'oVDir.AnonymousUserName = "IUSR_" & UCase(szServerName)
		' Allow IIS to control password?
		oVDir.AnonymousPasswordSync = True
			' If above is false, set the password
			' oVDir.AnonymousUserPass = "password"
			
	' Basic Authentication
	oVDir.AuthBasic  = False
		' Default Domain
		 
	' Digest Authentication for Windows domain servers
	' (Win2K server and clients only - there's no individual property documented for 
	' this one yet, so set the flag directly)
	'oVDir.AuthFlags = oVDir.AuthFlags Or 0x10

	' Integrated Windows Authentication (on by default)
	oVDir.AuthNTLM = True

' IP Address and Domain Restrictions
	' By default all computers will be DENIED access
	Set oIPSecurity = oVDir.IPSecurity
	oIPSecurity.GrantByDefault = False
	' Grant access by domain name, comma-delimited string  (this requires a reverse DNS lookup 
	' with every connection and is expensive in terms of resources)
	aDomains = oIPSecurity.DomainGrant
	' Wipe out previous domains
	Redim aDomains(0)
	aDomains(Ubound(aDomains)) = "ourfriends.com"
	oIPSecurity.DomainGrant = aDomains

	' Grant access by IP address - a better way to do it
	aIPs = oIPSecurity.IPGrant
	' Wipe out previous addresses
	Redim aIPs(1)
	aIPs(0) = "192.168.0.1"
	aIPs(1) = "255.255.255.255"
	oIPSecurity.IPGrant = aIPs

	' Note, to grant access to all computers by default and deny access to specific computers,
	' set GrantByDefault to True and use DomainDeny or IPDeny instead. 	
	oVDir.IPSecurity = oIPSecurity

' Write info back to Metabase
oVDir.SetInfo
		
' ****************************************
' HTTP HEADERS
' ****************************************
' Enable content expiration?
	' Expire immediately OR
	'oVDir.HttpExpires = "D, 0x0" 
	
	' Expire after 7 days (in hex seconds)
	oVDir.HttpExpires = "D, Ox93A80" 
		
	' Expire On [Date] at [Time]  (GMT - The MMC will display the corresponding local time)
	'oVDir.HttpExpires = "S, Sun 31 Dec 2000 11:59:59 PM" 
	
	' No expiration date (default)
	'oVDir.HttpExpires = "D, 0xFFFFFFFF" 
	
' Custom HTTP Headers (list)
	aHeaders = oVDir.HttpCustomHeaders
	' Wipe out existing custom headers
	Redim aHeaders(0)
	' Name/Value pair format is "HeaderName:HeaderValue"
	aHeaders(0) = "MyCustomHeaderName:MyCustomHeaderValue"
	oVDir.HttpCustomHeaders = aHeaders
	
' Content Rating
	' Use the RSACi ratings vocabulary
	' Include the e-mail address of the person doing the rating, 
	' the date and time of the rating, the expiration date and time,
	' and ratings (0-4) for violence (v), sex (s), nudity (n), language (l).
	' For more info, see http://www.rsac.org/.
			
	Redim aRatings(0)
	aRatings(0) = "PICS-Label: (PICS-1.0 ""http://www.rsac.org/ratingsv01.html"" l " 
	aRatings(0) = aRatings(0) & "by ""editor@somecompany.com"" on """
	aRatings(0) = aRatings(0) & FormatPICSDate(Now())
	aRatings(0) = aRatings(0) & """ exp """
	aRatings(0) = aRatings(0) & FormatPICSDate(DateAdd("yyyy", 1, Now()))
	aRatings(0) = aRatings(0) & """ r (v 2 s 1 n 1 l 2))"
	oVDir.HttpPics = aRatings
		
' File (MIME) Types (list)
	aMimeMap = oVDir.MimeMap
	' Extension
	szExtension = ".tst"
	' Type
	szType = "test/test-format"
	
	' Check to see if the extension is already in the list
	bFound = False
	For Each oMap In aMimeMap
		If oMap.Extension = szExtension Then
			' Extension found, change the mime type
			oMap.MimeType = szType
			bFound = True
			Exit For
		End If
	Next
	If Not bFound Then
		' Extension not found - add a new MimeMap to the list
		nIndex = UBound(aMimeMap) + 1
		Redim Preserve aMimeMap(nIndex)
		Set aMimeMap(nIndex) = CreateObject("MimeMap") 
		aMimeMap(nIndex).Extension = szExtension
  		aMimeMap(nIndex).MimeType = szType
	End If
	oVDir.MimeMap  = aMimeMap
	
' Write info back to Metabase
oVDir.SetInfo

' ****************************************
' CUSTOM ERRORS 
' ****************************************
' Replace the 404 (File Not Found) error with a custom handler
	' Define the custom error handler 
	' (HTTPErrorCode, HTTPErrorSubcode, "URL" or "File", URL or File location)
	szCustomErr = "404,*,URL,myErrHandler.asp"
	
	' Loop through the existing httperror strings for the same ErrorCode & SubErrorCode
	aHTTPErrors = oVDir.HTTPErrors
	bFound = False
	nIndex = 0
	For Each szError In aHTTPErrors
		If Left(szError, 6) = Left(szCustomErr, 6)  Then
			' Replace with custom string
			aHTTPErrors(nIndex) = szCustomErr
			bFound = True
			Exit For
		End If		
		nIndex = nIndex + 1
	Next
	' If it wasn't found, append it to the end of the list
	If Not bFound Then
		Redim Preserve aHTTPErrors(UBound(aHTTPErrors)+1)
		aHTTPErrors(UBound(aHTTPErrors)) = szCustomErr
	End If
	
	' Save the list back to the metabase
	oVDir.HTTPErrors = aHTTPErrors
	
' Write info back to Metabase
oVDir.SetInfo


Sub InstallFilter(szFilterName, szFilterPath, oSvrPath)
'************************************************
' Create and configure new IIsFilter object
'************************************************
   Dim oFilters, oFilter, LoadOrder

   ' Get or Create IIsFilters collection
	
	 On Error Resume Next
	 Set oFilters = oSvrPath.GetObject("IIsFilters", "Filters")

	 If oFilters Is Nothing Then
		Set oFilters = oSvrPath.Create("IIsFilters", "Filters")
	 End If

	 Set oFilter = oFilters.GetObject("IIsFilter", szFilterName)
	 If oFilter Is Nothing Then
		 Set oFilter = oFilters.Create("IIsFilter", szFilterName)
	 End If

	 oFilter.FilterPath = szFilterPath
	 
	 ' Write info back to Metabase
    oFilter.SetInfo
    
    ' Modify FilterLoadOrder, to include to new filter
	 LoadOrder = oFilters.FilterLoadOrder
  
	 If InStr( LoadOrder, szFilterName ) = 0 Then
		If LoadOrder <> "" Then LoadOrder = LoadOrder & ","

		' Add new filter to end of load order list
      LoadOrder = LoadOrder & szFilterName
      oFilters.FilterLoadOrder = LoadOrder
   End If

    ' Write changes back to Metabase
	 oFilters.SetInfo

	 Wscript.Echo "Filter " &  szFilterName & " has been successfully registered."

End Sub

Function FormatPICSDate(dDate)
	Dim szReturn
	szReturn = Year(dDate) & "." 
	szReturn = szReturn & PadL(Month(dDate), 2, "0") & "." 
	szReturn = szReturn & PadL(Day(dDate), 2, "0") & "T" 
	szReturn = szReturn & PadL(Hour(dDate), 2, "0") & ":" 
	szReturn = szReturn & PadL(Minute(dDate), 2, "0") & ":" 
	szReturn = szReturn & PadL(Second(dDate), 2, "0") & "00" 
	FormatPICSDate = szReturn
End Function

Function PadL(nNum, nLen, szChar)
	Dim szReturn
	szReturn = CStr(nNum)
	While Len(szReturn) < nLen
		szReturn = szChar & szReturn
	Wend
	PadL = szReturn
End Function

Sub UsageMsg
	Wscript.Echo "Usage:  cscript webset.vbs [-n <instancenum>] [-s <server>]"
	Wscript.Quit
End Sub