'------------------------------------------------------------------------------------------------
'
' This is a simple script to create a new virtual web server.
'
' Usage: MakeWebSite      <--RootDirectory|-r ROOT DIRECTORY>
'                         <--Comment|-t SERVER COMMENT>
'                         [--computer|-c COMPUTER1[,COMPUTER2...]]
'                         [--HostName|-h HOST NAME[,HOSTNAME2...]]
'                         [--port|-o PORT NUM]
'                         [--IPAddress|-i IP ADDRESS]
'                         [--SiteNumber|-n SITENUMBER]
'                         [--DontStart]
'                         [--verbose|-v]
'                         [--Write]"
'                         [--Execute { NONE, SCRIPTS, EXECUTABLES } ]"
'                         [--AppProtection { LOW, MEDIUM, HIGH } ]"
'                         [--AppName Name]"
'                         [--LogPeriod { DAILY, WEEKLY, MONTHLY, HOURLY} ]"
'                         [--LogFolder LogFileDirectory]"
'                         [--URL Redirectionpath]
'                         [--URLExact]
'                         [--URLChildOnly]
'                         [--URLPermanent]
'                         [--help|-?]
'
' IP ADDRESS            The IP Address to assign to the new server.  Optional.
' HOST NAME             The host name of the web site for host headers.
'						WARNING: Only use Host Name if DNS is set up find the server.
' PORT NUM              The port to which the server should bind
' ROOT DIRECTORY        Full path to the root directory for the new server.
' SERVER COMMENT        The server comment -- this is the name that appers in the MMC.
' SITENUMBER		    The Site Number is the number in the path that the web server
'						will be created at.  i.e. w3svc/3
'
' Example 1: MakeWebSite.vbs -r D:\Roots\Company11 --DontStart -t "My Company Site"
' Example 2: MakeWebSite.vbs -r C:\Inetpub\wwwroot -t Test -o 8080
'
'
' Modified by chris crowe - www.iisfaq.com to support multiple host headers and URL Redirection
'------------------------------------------------------------------------------------------------


' Force explicit declaration of all variables
Option Explicit

'On Error Resume Next

Dim ArgIPAddress, ArgRootDirectory, ArgServerComment, ArgSkeletalDir, ArgHostName, ArgPort
Dim ArgComputers, ArgStart
Dim ArgSiteNumber
Dim oArgs, ArgNum
Dim verbose, FSO

' Chris Crowe - blog.crowe.co.nz
dim ArgLogFolder
dim ArgLogFilePeriod
dim ArgAppFriendlyName
dim ArgAppProtection
dim ArgExecute
dim ArgExecuteScripts
dim ArgExecuteExecutables 
dim ArgWrite

const MD_LOGFILE_PERIOD_MAXSIZE = 0 ' Create new log file after reaching maximum size. 
const MD_LOGFILE_PERIOD_DAILY   = 1 ' Create new log file daily. 
const MD_LOGFILE_PERIOD_WEEKLY  = 2 ' Create new log file weekly. 
const MD_LOGFILE_PERIOD_MONTHLY = 3 ' Create new log file monthly. 
const MD_LOGFILE_PERIOD_HOURLY  = 4 ' Create a new log file hourly. 

' Chris Crowe - iisfaq.com
Dim ArgURL, ArgURLExact, ArgURLChildOnly, ArgURLPermanent

ArgIPAddress = ""
ArgHostName = ""
ArgPort = 80
ArgStart = True
ArgComputers = Array(1)
ArgComputers(0) = "LocalHost"
ArgSiteNumber = 0
verbose = false

' Chris Crowe - blog.crowe.co.nz
ArgLogFolder            = ""
ArgLogFilePeriod        = ""
ArgAppFriendlyName      = ""
ArgAppProtection        = 2
ArgExecute              = ""
ArgWrite                = false

' Chris Crowe - iisfaq.com
ArgURL = ""
ArgURLChildonly = false
ArgURLExact = false
ArgURLPermanent = false

Set oArgs = WScript.Arguments
ArgNum = 0

While ArgNum < oArgs.Count

	Select Case LCase(oArgs(ArgNum))
		Case "--port","-o":
			ArgNum = ArgNum + 1
			ArgPort = oArgs(ArgNum)	
		Case "--ipaddress","-i":
			ArgNum = ArgNum + 1
			ArgIPAddress = oArgs(ArgNum)
		Case "--rootdirectory","-r": 
			ArgNum = ArgNum + 1
			ArgRootDirectory = oArgs(ArgNum)
		Case "--comment","-t":
			ArgNum = ArgNum + 1
			ArgServerComment = oArgs(ArgNum)
		Case "--hostname","-h":
			ArgNum = ArgNum + 1
			ArgHostName = oArgs(ArgNum)
		Case "--computer","-c":
			ArgNum = ArgNum + 1
			ArgComputers = Split(oArgs(ArgNum), ",", -1)
		Case "--sitenumber","-n":
			ArgNum = ArgNum + 1
			ArgSiteNumber = CLng(oArgs(ArgNum))

        ' Chris Crowe - blog.crowe.co.nz
		Case "--logfolder": 
			ArgNum = ArgNum + 1
			ArgLogFolder = oArgs(ArgNum)
		Case "--logperiod": 
			ArgNum = ArgNum + 1
			ArgLogFilePeriod = oArgs(ArgNum)
		Case "--appname": 
			ArgNum = ArgNum + 1
			ArgAppFriendlyName = oArgs(ArgNum)
		Case "--appprotection": 
			ArgNum = ArgNum + 1
			ArgAppProtection= oArgs(ArgNum)
		Case "--execute": 
			ArgNum = ArgNum + 1
			ArgExecute = oArgs(ArgNum)
		Case "--write"
			ArgWrite = true
		
		' Chris Crowe - iisfaq.com
		Case "--url","-u": 
			ArgNum = ArgNum + 1
			ArgURL = oArgs(ArgNum)
		Case "--urlexact"
			ArgURLEXACT = true
		Case "--urlchildonly"
			ArgURLChildOnly = true
		Case "--urlpermanent"
			ArgURLPERMANENT = true

			
		Case "--dontstart":
			ArgStart = False
		Case "--help","-?":
			Call DisplayUsage
		Case "--verbose", "-v":
			verbose = true
		Case Else:
			WScript.Echo "Unknown argument "& oArgs(ArgNum)
			Call DisplayUsage
	End Select	

	ArgNum = ArgNum + 1
Wend

' Chris Crowe - iisfaq.com
If (ArgRootDirectory = "") Then
	WScript.Echo "Missing Root Directory (Required even with URL redirection path)"
	WScript.Echo ""
	Call DisplayUsage
	WScript.Quit(1)
End If

' Check if the root directory exists
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
		if (FSO.FolderExists(ArgRootDirectory) = False) then
			 WScript.echo "The specified root directory does not exist : '" & ArgRootDirectory & "'"
			 WScript.Quit(2)
		end if
		
		
		' Chris Crowe - July 2006
		if (ArgLogFolder > "") then
		    if (FSO.FolderExists(ArgLogFolder) = False) then
			     WScript.echo "The specified LogFolder directory does not exist : " & ArgLogFolder
			     WScript.Quit(2)
		    end if
		end if		
		
Set FSO = Nothing


' Chris Crowe - July 2006
if (ArgExecute> "") then
    ArgExecute = ucase(ArgExecute)
    if (ArgExecute = "NONE") then 
        ArgExecuteScripts = false
        ArgExecuteExecutables = false
    elseif (ArgExecute = "SCRIPTS") then 
        ArgExecuteScripts = true
        ArgExecuteExecutables = false
    elseif (ArgExecute = "EXECUTABLES") then 
        ArgExecuteScripts = true
        ArgExecuteExecutables = true
    else
	     WScript.echo "The specified Execute value is invalid : " & ArgAppProtection
	     WScript.Quit(2)
    end if
end if

if (ArgAppProtection > "") then
    ArgAppProtection = ucase(ArgAppProtection)
    if (ArgAppProtection = "LOW") then ArgAppProtection = 0
    if (ArgAppProtection = "INPROCESS") then ArgAppProtection = 0
    
    if (ArgAppProtection = "HIGH") then ArgAppProtection = 1
    if (ArgAppProtection = "OUTOFPROCESS") then ArgAppProtection = 1
    
    if (ArgAppProtection = "MEDIUM") then ArgAppProtection= 2
    if (ArgAppProtection = "POOLED") then ArgAppProtection = 2
    
    if ((ArgAppProtection = 0) or (ArgAppProtection = 1) or (ArgAppProtection = 2)) then
    else
	     WScript.echo "The specified AppProtection value is invalid : " & ArgAppProtection
	     WScript.Quit(2)
    end if
end if		

if (ArgLogFilePeriod > "") then
    ArgLogFilePeriod = ucase(ArgLogFilePeriod)
    if (ArgLogFilePeriod = "DAILY") then ArgLogFilePeriod = 1
    if (ArgLogFilePeriod = "WEEKLY") then ArgLogFilePeriod = 2   
    if (ArgLogFilePeriod = "MONTHLY") then ArgLogFilePeriod = 3
    if (ArgLogFilePeriod = "HOURLY") then ArgLogFilePeriod = 4
    
    if ((ArgLogFilePeriod= 0) or (ArgLogFilePeriod= 1) or (ArgLogFilePeriod= 2) or (ArgLogFilePeriod= 3)) then
    else
	     WScript.echo "The specified LogFilePeriod is invalid : " & ArgLogFilePeriod
	     WScript.Quit(2)
    end if
end if		



If (ArgServerComment = "") Then
	WScript.Echo "Missing Server Comment"
	WScript.Echo ""
	Call DisplayUsage
	WScript.Quit(1)
End If
' end - chris Crowe - iisfaq.com

' chris Crowe - iisfaq.com
Call ASTCreateWebSite(ArgIPAddress, ArgRootDirectory, ArgURL, ArgURLEXACT, ArgURLCHILDONLY, ArgURLPERMANENT, ArgServerComment, ArgHostName, ArgPort, ArgComputers, ArgStart)

' chris Crowe - iisfaq.com
Sub ASTCreateWebSite(IPAddress, RootDirectory, URL, ArgURLEXACT, ArgURLCHILDONLY, ArgURLPERMANENT, ServerComment, HostName, PortNum, Computers, Start)
	Dim w3svc, WebServer, NewWebServer, NewDir, Bindings, BindingString, NewBindings, ComputerIndex, Index, SiteObj, bDone
	Dim comp, BindingIndex, HostNameINdex, HostNames
	
   'Chris Crowe - www.iisfaq.com
	Dim URLOPTIONS 
	
	On Error Resume Next

	hostNames = Split(HostName,",")
	For ComputerIndex = 0 To UBound(Computers)
		comp = Computers(ComputerIndex)
		If ComputerIndex <> UBound(Computers) Then
			Trace "Creating web site on " & comp & "."
		End If

		' Grab the web service object
		Err.Clear
		Set w3svc = GetObject("IIS://" & comp & "/w3svc")
		If Err.Number <> 0 Then
			Display "Unable to open: "&"IIS://" & comp & "/w3svc"
		End If

		Trace "Making sure this web server doesn't conflict with another..."
		For Each WebServer in w3svc
			If WebServer.Class = "IIsWebServer" Then
				Bindings = WebServer.ServerBindings

				For HostNameINdex = 0 To UBound(HostNames)
					for BindingIndex = 0 to Ubound(Bindings)
						BindingString = IpAddress & ":" & PortNum & ":" & HostNames(HostNameINdex)
						If (BindingString = bindings(BindingIndex)) Then
							Trace "The server bindings you specified are duplicated in another virtual web server."
							Trace "The Web Server name is [" & WebServer.ServerComment & "], Instance ID [" & WebServer.name & "]"
							Trace "The Conflicting Bindings are at index [" & bindingIndex & "], [" & bindings(BindingIndex) & "]"
							WScript.Quit (1)
						End If
					next
				next
			End If
		Next

		Index = 1
		bDone = False
		Trace "Creating new web server..."

		' If the user specified a SiteNumber, then use that.  Otherwise,
		' test successive numbers under w3svc until an unoccupied slot is found
		If ArgSiteNumber <> 0 Then
			Set NewWebServer = w3svc.Create("IIsWebServer", ArgSiteNumber)
			NewWebServer.SetInfo
			If (Err.Number <> 0) Then
				WScript.Echo "Couldn't create a web site with the specified number: " & ArgSiteNumber
				WScript.Quit (1)
			Else
				Err.Clear
				' Verify that the newly created site can be retrieved
				Set SiteObj = GetObject("IIS://"&comp&"/w3svc/" & ArgSiteNumber)
				If (Err.Number = 0) Then
					bDone = True
					Trace "Web server created. Path is - "&"IIS://"&comp&"/w3svc/" & ArgSiteNumber
				Else
					WScript.Echo "Couldn't create a web site with the specified number: " & ArgSiteNumber
					WScript.Quit (1)
				End If
			End If
		Else
			While (Not bDone)
				Err.Clear
				Set SiteObj = GetObject("IIS://"&comp&"/w3svc/" & Index)

				If (Err.Number = 0) Then
					' A web server is already defined at this position so increment
					Index = Index + 1
				Else
					Err.Clear
					Set NewWebServer = w3svc.Create("IIsWebServer", Index)
					NewWebServer.SetInfo
					If (Err.Number <> 0) Then
						' If call to Create failed then try the next number
						Index = Index + 1
					Else
						Err.Clear
						' Verify that the newly created site can be retrieved
						Set SiteObj = GetObject("IIS://"&comp&"/w3svc/" & Index)
						If (Err.Number = 0) Then
							bDone = True
							Trace "Web server created. Path is - "&"IIS://"&comp&"/w3svc/" & Index
						Else
							Index = Index + 1
						End If
					End If
				End If

				' sanity check
				If (Index > 10000) Then
					Trace "Seem to be unable to create new web server.  Server number is "&Index&"."
					WScript.Quit (1)
				End If
			Wend
		End If

on error goto 0

		redim NewBindings (ubound(HostNames))

		For HostNameINdex = 0 To UBound(HostNames)
			BindingString = IpAddress & ":" & PortNum & ":" & HostNames(HostNameINdex)
			Trace "Binding = " & BindingString 
			NewBindings(HostNameINdex) = BindingString
		next

        ' Modified by Chris Crowe - July 2006 (Start)
		
		if (ArgLogFolder > "") then
		    NewWebServer.LogFileDirectory = ArgLogFolder
		end if
		
		if (ArgLogFilePeriod > "") then
    	    NewWebServer.LogFilePeriod = ArgLogFilePeriod
		end if
		
		' Modified by Chris Crowe - July 2006 (End)

		NewWebServer.ServerBindings = NewBindings
		NewWebServer.ServerComment = ServerComment
		NewWebServer.SetInfo

		' Now create the root directory object.
		Trace "Setting the home directory..."
		Set NewDir = NewWebServer.Create("IIsWebVirtualDir", "ROOT")
		NewDir.Path = RootDirectory
		NewDir.AccessRead = true

		' Chris Crowe - July 2006
		if (ArgWrite = true) then
		    NewDir.AccessWrite = true
		end if

		if (ArgExecute > "") then
		    NewDir.AccessScript = ArgExecuteScripts
		    NewDir.AccessExecute = ArgExecuteExecutables
		end if
		
		' Modified by Chris crowe - January 2002
		if (URL <> "") then
		   trace "Redirection to a URL: " & URL
		   URLOPTIONS= ""

		   if (ArgURLEXACT = true) then
  			URLOPTIONS = ", EXACT_DESTINATION"
		   end if
		   if (ArgURLCHILDONLY = true) then
			if (URLOPTIONS > "") then
				URLOPTIONS = URLOPTIONS & ", CHILD_ONLY"	
			else
  				URLOPTIONS = ", CHILD_ONLY"	
			end if
		   end if
		   if (ArgURLPERMANENT = true) then
			if (URLOPTIONS > "") then
				URLOPTIONS = URLOPTIONS & ", PERMANENT"	
			else
  				URLOPTIONS = ", PERMANENT"	
			end if
		   end if
		   trace "Redirection Flags : " & URLOPTIONS
   		   newDir.httpredirect= URL & URLOPTIONS
		end if
		' Modified by Chris crowe - January 2002
						
		
		Err.Clear
		NewDir.SetInfo
		' Chris Crowe - July 2006
		NewDir.AppCreate2 (ArgAppProtection)
		
		if (ArgAppFriendlyName > "") then
		    NewDir.AppFriendlyName = ArgAppFriendlyName
		    NewDir.SetInfo
		end if

		If (Err.Number = 0) Then
			Trace "Home directory set."
		Else
			Display "Error setting home directory."
		End If

		Trace "Web site created!"

		If Start = True Then
			Trace "Attempting to start new web server..."
			Err.Clear
			Set NewWebServer = GetObject("IIS://" & comp & "/w3svc/" & Index)
			NewWebServer.Start
			If Err.Number <> 0 Then
				Display "Error starting web server!"
				Err.Clear
			Else
				Trace "Web server started succesfully!"
			End If
		End If
	Next
End Sub


' Display the usage message
Sub DisplayUsage
	WScript.Echo "Usage: MakeWebSite <--RootDirectory|-r ROOT DIRECTORY>"
	WScript.Echo "                   <--Comment|-t SERVER COMMENT>"
	WScript.Echo "                   [--computer|-c COMPUTER1[,COMPUTER2...]]"
	WScript.Echo "                   [--port|-o PORT NUM]"
	WScript.Echo "                   [--IPAddress|-i IP ADDRESS]"
	WScript.Echo "                   [--HostName|-h HOST NAME[,HOSTNAME2...]]"
	WScript.Echo "                   [--SiteNumber|-n SITENUMBER]"
	WScript.Echo "                   [--AppProtection Level { LOW, MEDIUM, HIGH } ]"
	WScript.Echo "                   [--AppName Name]"
	WScript.Echo "                   [--Write]"
	WScript.Echo "                   [--Execute { NONE, SCRIPTS, EXECUTABLES } ]"
	WScript.Echo "                   [--LogPeriod LogFilePeriod { DAILY, WEEKLY, MONTHLY, HOURLY}]"
	WScript.Echo "                   [--LogFolder LogFileDirectory]"
	WScript.Echo "                   [--URL RedirectionPath]"
	WScript.Echo "                   [--URLExact]"
	WScript.Echo "                   [--URLChildOnly]"
	WScript.Echo "                   [--URLPermanent]"
	WScript.Echo "                   [--DontStart]"
	WScript.Echo "                   [--verbose|-v]"
	WScript.Echo "                   [--help|-?]"
	WScript.Echo ""
	WScript.Echo "WARNING: Only use Host Name if DNS is set up find the server."
	WScript.Echo ""
	WScript.Echo "Example 1: MakeWebSite.vbs -r D:\Roots\Company11 --DontStart -t ""My Company Site"""
	WScript.Echo "Example 2: MakeWebSite.vbs -r D:\Roots\Company11 -h ""www.iisfaq.com,www.iis.com"" --DontStart -t ""My Company Site"""
	WScript.Echo "Example 3: MakeWebSite.vbs -r D:\Roots\Company11 -i 192.168.0.1 -t ""My Company Site"" --URL http://www.iisfaq.com --URLExact --URLPermanent"
	WScript.Echo "Example 4: MakeWebSite.vbs -r D:\Roots\Company11 --DontStart -t ""My Company Site"" --LogPeriod MONTHLY --LogFolder c:\Root\Company1"
	WScript.Echo "Example 5: MakeWebSite.vbs -r D:\Roots\Company11 --DontStart -t ""My Company Site"" --AppName XYZ --LogFolder c:\Root\Company1"
	WScript.Echo ""
	WScript.Echo "Note: URLRedirection requires a HTTP:// prefix and a root directory also!"
	WScript.Echo "      Write enables write access to the directory"
	WScript.Echo ""

	WScript.Quit (1)
End Sub

Sub Display(Msg)
	WScript.Echo Now & ". Error Code: " & Hex(Err) & " - " & err.Description &  " - " & Msg
End Sub

Sub Trace(Msg)
	if verbose = true then
		WScript.Echo Now & " : " & Msg	
	end if
End Sub