windows-server-2003/inetsrv/iis/img/scripts/iisschlp.wsc

<?xml version="1.0" ?>
<package>
	<component id="IIS Script Helper">
		<?component error="true" debug="true" ?>
		<registration progid="Microsoft.IIsScriptHelper" classid="{BC47120F-1612-4CA5-A89F-FDFF76C28AB6}" description="IIS Script Helper" version="1.0">
		</registration>
		<public>
			<property internalname="WScript" name="ScriptHost">
			</property>
			<property name="ProviderObj">
				<get/>
			</property>
			<property name="Switches">
				<get/>
			</property>
			<property internalname="aNamedArguments" name="NamedArguments">
				<get/>
			</property>
			<property name="GlobalHelpRequested">
				<get/>
			</property>
			<property name="FSObj">
				<get/>
			</property>
			<property name="ERROR_UNKNOWN_SWITCH">
				<get/>
			</property>
			<property name="ERROR_NOT_ENOUGH_ARGS">
				<get/>
			</property>
			<method name="BuildNameSpace">
				<parameter name="strPath"/>
			</method>
			<method name="CheckScriptEngine">
			</method>
			<method name="CreateFSDir">
				<parameter name="strRoot"/>
			</method>
			<method name="DumpCmdLineOptions">
			</method>
			<method name="FindSite">
				<parameter name="strType"/>
				<parameter name="aArgs"/>
			</method>
			<method name="GetAbsolutePath">
				<parameter name="strPath"/>
			</method>
			<method name="GetEnvironmentVar">
				<parameter name="strVar"/>
			</method>
			<method name="GetSwitch">
				<parameter name="strSwitchName"/>
			</method>
			<method name="InitAuthentication">
				<parameter name="Server"/>
				<parameter name="User"/>
				<parameter name="Password"/>
			</method>
			<method name="IsHelpRequested">
				<parameter name="strSwitch"/>
			</method>
			<method name="IsHelpSwitch">
				<parameter name="strSwitch"/>
			</method>
			<method name="IsValidIPAddress">
				<parameter name="strIPAddress"/>
			</method>
			<method name="IsValidPortNumber">
				<parameter name="intPort"/>
			</method>
			<method name="NormalizeFilePath">
				<parameter name="strPath"/>
			</method>
			<method name="ParseBindings">
				<parameter name="bindings"/>
			</method>
			<method name="ParseCmdLineOptions">
				<parameter name="ArgObj"/>
				<parameter name="strCmdLine"/>
			</method>
			<method name="WMIConnect">
				<parameter name="strServer"/>
				<parameter name="strUser"/>
				<parameter name="strPassword"/>
			</method>
		</public>
		<object id="FSObj" progid="Scripting.FileSystemObject" events="false"/>
		<object id="ShellObj" progid="WScript.Shell" events="false"/>
		<object id="NetObj" progid="WScript.Network" events="false"/>
		<object id="DictObj" progid="Scripting.Dictionary" events="false"/>
		<resource id="ProductInfoRegValue">ProductSuite</resource>
		<resource id="ProductInfoRegKey">System\CurrentControlSet\Control\ProductOptions</resource>
		<resource id="L_RegProc_ErrorMessage">Error querying the WMI Registry provider.</resource>
		<resource id="L_OnlyIIS6Supported_ErrorMessage">The IIS Admin scripts only support IIS 6.0.</resource>
		<resource id="L_CredentialsIgnored_Message">Using local machine will cause supplied credentials to be ignored.</resource>
		<resource id="L_Warning_Text"><![CDATA[WARNING]]></resource>
		<resource id="L_WriteReg_ErrorMessage">Error trying to write the registry settings!</resource>
		<resource id="L_MetabasePath_Message">Metabase Path</resource>
		<resource id="L_SiteName_Text">Site Name</resource>
		<resource id="L_NotUnique2_Message">identify these sites:</resource>
		<resource id="L_NotUnique1_Message">The following site names are not unique. Please use the Metabase Paths to</resource>
		<resource id="L_Done_Message">Done.</resource>
        <resource id="L_ConnectObject_ErrorMessage">The server you have requested could not be found, either you have entered an incorrect server name or the server is not currently available.  Please verify that you have entered the correct server name and try to reconnect to the server.</resource>
        <resource id="L_BadCredentials_ErrorMessage">The remote logon credentials you have supplied are invalid.  Verify that you have entered the correct logon username and password for the remote server.</resource>
		<resource id="L_Error_ErrorMessage">Error</resource>
		<resource id="L_Locator_ErrorMessage">Error trying to get WMI SWbemLocator object</resource>
		<resource id="L_Connecting_Message">Connecting to server ...</resource>
		<resource id="L_OkWriteReg_Message">Successfully registered CScript</resource>
		<resource id="L_UseCScript_Message">To run this script type: "CScript.Exe IIsCnfg.vbs [params]"</resource>
		<resource id="CIMv2_NAMESPACE">root/CIMv2</resource>
		<resource id="WMI_NAMESPACE">root/MicrosoftIISv2</resource>
		<resource id="LOCATOR_OBJ">WbemScripting.SWbemLocator</resource>
		<resource id="WBemImpersonationLevelImpersonate">3</resource>
		<resource id="WQL">WQL</resource>
		<resource id="L_RegisterCScript_Message">Register CScript</resource>
        <resource id="L_Admin_ErrorMessage">You cannot run this command because you are not an administrator on the server you are trying to configure.</resource>
		<resource id="L_AskChangeScriptProcessor_Message"><![CDATA[Would you like to register CScript as your default host for VBscript?]]></resource>
		<resource id="L_WrongScriptProcessor_Message">This script does not work with WScript.</resource>
		<resource id="CONST_NO_MATCHES_FOUND">0</resource>
		<resource id="PATTERN_VBPRINTF">%\d</resource>
		<script id="IIs Script Helper" language="VBScript">
<![CDATA[
'
' Copyright (c) Microsoft Corporation.  All rights reserved.
'
' VBScript Source File 
'
' Script Component Name: IIsScHlp.wsc
'

Option Explicit
On Error Resume Next

Dim LocatorObj, ProviderObj
Dim dictSwitches, dictHelpRequested
Dim aNamedArguments
Dim fGlobalHelpRequested
Dim strServer, strUser, strPassword

' Parser errors
Const ERROR_NOT_ENOUGH_ARGS = 1
Const ERROR_UNKNOWN_SWITCH = 2

' Object initialization
fGlobalHelpRequested = False
Set LocatorObj = Nothing
Set ProviderObj = Nothing
Set dictSwitches = Nothing
Set dictHelpRequested = Nothing
aNamedArguments = Array()

' Property get methods
Function get_ProviderObj()
	Set get_ProviderObj = ProviderObj
End Function

Function get_Switches()
	Set get_Switches = dictSwitches
End Function

Function get_aNamedArguments()
	get_aNamedArguments = aNamedArguments
End Function

Function get_GlobalHelpRequested()
	get_GlobalHelpRequested = fGlobalHelpRequested
End Function

Function get_FSObj()
	Set get_FSObj = FSObj
End Function

Function get_ERROR_UNKNOWN_SWITCH()
	get_ERROR_UNKNOWN_SWITCH = ERROR_UNKOWN_SWITCH
End Function

Function get_ERROR_NOT_ENOUGH_ARGS()
	get_ERROR_NOT_ENOUGH_ARGS = ERROR_NOT_ENOUGH_ARGS
End Function

'''''''''''''''''''''''''''''''''
' Class Definitions
''''''''''''''''''''''
Class OptionItem
    Public Name
    Public ShortName
    Public RequiredArgs
    Public GroupID
    
    Public fSearchChildren
    Public aChildOptions
    
    Public Sub SetInfo(strName, strShortName, strReqArg, intGroupID)
        If Left(strName, 1) = "[" Then
            Name = Mid(strName, 2)
        Else
  	        Name = CStr(strName)
  	    End If
  	    
    	ShortName = CStr(strShortName)
    	
    	If Right(strReqArg, 1) = "]" Then
    	    RequiredArgs = Mid(strReqArg, 1, Len(strReqArg) - 1)
    	Else
   	        RequiredArgs = CStr(strReqArg)
   	    End If
    	GroupID = CInt(intGroupID)

    	fSearchChildren = False
    	aChildOptions = Empty
    End Sub
    
    Public Sub AddChild(element)
        If IsEmpty(aChildOptions) Then
            aChildOptions = Array(element)
        Else
            ReDim Preserve aChildOptions(Ubound(aChildOptions) + 1)
            Set aChildOptions(Ubound(aChildOptions)) = element
        End If
    End Sub

    Public Sub Visit()
        ' This options was recognized. If it has child options, make them available
        If Not IsEmpty(aChildOptions) Then
            fSearchChildren = True
        End If
    End Sub
End Class


Class Options
    Private intOptionIndex
	Public aOptions

	Public Sub SetOptions(strCmdLineKeys)
		Dim aCmdLineOptions, aOption
		Dim intCount, i
	
	    aCmdLineOptions = Split(strCmdLineKeys, ";")
	    
		ReDim aOptions(UBound(aCmdLineOptions))
	
	    intOptionIndex = LBound(aCmdLineOptions)
	    InsertOptionsInArray aOptions, aCmdLineOptions, Empty
	End Sub

	Public Function GetInfo(strName)
		Set GetInfo = Lookup(aOptions, strName)
	End Function
	
    '
    ' Private functions/subrotines
    '
	Private Function Lookup(aArray, strName)
		Dim oOption
		Dim oResult
		Dim i
		
		Set oResult = Nothing
		For i = LBound(aArray) to UBound(aArray)
			Set oOption = aArray(i)
			If UCase(oOption.Name) = UCase(strName) Or UCase(oOption.ShortName) = UCase(strName) Then
				Set oResult = oOption
				Exit For
			End If
			
			If oOption.fSearchChildren Then
			    Set oResult = Lookup(oOption.aChildOptions, strName)
			    If Not oResult Is Nothing Then
			        Exit For
			    End If
			End If
		Next
		
		Set Lookup = oResult
    End Function

    ' InsertOptionsInArray(
    '   array to receive the options,
    '   options array to be parser,
    '   start index of the options array above,
    '   current scope (-1 to root)
    ')
    Private Sub InsertOptionsInArray(aArray, aCmdLineOptions, intScope)
        Dim intCount, i
        Dim aOption, oOption
        
	    intCount = 0
	    Do While intOptionIndex <= UBound(aCmdLineOptions)
	        aOption = Split(aCmdLineOptions(intOptionIndex), ":")
	        
	        Set oOption = New OptionItem
	        oOption.SetInfo aOption(0), aOption(1), aOption(2), intScope
	        
	        ' First, do we see a start of a block ('[')?
	        If Left(aOption(0), 1) = "[" Then
	            intOptionIndex = intOptionIndex + 1
	            InsertOptionsInArray oOption, aCmdLineOptions, intScope + 1
	        End If
	        
	        If IsArray(aArray) Then
			    Set aArray(intCount) = oOption
			Else
			    ' aArray is actually an object
			    aArray.AddChild oOption
			End If
			
	        ' Now, do we see an end of a block (']')?
	        If Right(aOption(UBound(aOption)), 1) = "]" Then
	            Exit Sub
	        End If
	      
			intCount = intCount + 1        
            intOptionIndex = intOptionIndex + 1
	    Loop
	    
	    ReDim Preserve aArray(intCount - 1)
    End Sub
End Class


Class ParserError
    Public SwitchName
    Public ErrorCode
End Class

''''''''''''''''''''''''''''''''''''
' Methods
'''''''''''''''''''''''''

' Initialization
Function InitAuthentication(Server, User, Password)
    Dim DefaultNamespaceObj, RegistryObj
    Dim IISNameSpaceObj, ComputerObj
    Dim iMajorVersion, iResult
    Dim aResult
    
    On Error Resume Next
    
    iResult = 0
    strServer = Server
    strUser = User
    strPassword = Password
    
    If Server = "." Or UCase(Server) = UCase(GetEnvironmentVar("%COMPUTERNAME%")) Then
        If User <> "" Or Password <> "" Then
            WScript.Echo getResource("L_Warning_Text") & ": " & getResource("L_CredentialsIgnored_Message")
            strUser = ""
            strPassword = ""
        End If
    End If

    ' Initializes the WMI Locator object
    Set LocatorObj = CreateObject(getResource("LOCATOR_OBJ"))
    If Err.Number Then
    	WScript.Echo getResource("L_Locator_ErrorMessage")
    	WScript.Echo getResource("L_Error_ErrorMessage") & " &H" & Hex(Err.Number) & ": " & Err.Description
    	InitAuthentication = Err.Number
    	Exit Function
    End If

    LocatorObj.Security_.ImpersonationLevel = getResource("WBemImpersonationLevelImpersonate")

    ' Check if target machine has IIS6 installed (server and above)
    Set IISNameSpaceObj = LocatorObj.ConnectServer(strServer, getResource("WMI_NAMESPACE"), strUser, strPassword)
    If Err.Number Then
        ' Error connecting to the IIS namespace. If NOT_FOUND, this is probably not a Win2002 box
        If Err.Number = &H8004100E Then  ' INVALID_NAMESPACE
            WScript.Echo getResource("L_OnlyIIS6Supported_ErrorMessage")
        ElseIf Err.Number = &H800706BA Then           
        	WScript.Echo getResource("L_ConnectObject_ErrorMessage")
        ElseIf Err.Number = &H80070005 Then
            WScript.Echo getResource("L_BadCredentials_ErrorMessage")
        Else
           	WScript.Echo getResource("L_Error_ErrorMessage") & " &H" & Hex(Err.Number) & ": " & Err.Description
        End If

    	InitAuthentication = Err.Number
    	Exit Function
    End If
    
    Set ComputerObj = IISNameSpaceObj.get("IIsWebInfo='W3SVC/Info'")
    If Err.Number Then
        Select Case Err.Number
            Case &H80070005
                WScript.Echo getResource("L_Admin_ErrorMessage")
                InitAuthentication = Err.Number
            
            Case Else
                WScript.Echo getResource("L_OnlyIIS6Supported_ErrorMessage")
    	        InitAuthentication = Err.Number
            End Select
    	Exit Function
    End If

    iMajorVersion = ComputerObj.MajorIIsVersionNumber
    If Err.Number Or iMajorVersion <> 6 Then
        WScript.Echo getResource("L_OnlyIIS6Supported_ErrorMessage")
    	InitAuthentication = 1
    	Exit Function
    End If    

    InitAuthentication = 0
End Function

''''''''''''''''''''''''''''''
' ParseCmdLineOptions
''''''''''''''''''''''''''
Function ParseCmdLineOptions(strCmdLine)
    Dim oOptions, oOption, oError
    Dim strItem, strValue
    Dim intCount, intIndex, i
    Dim ArgObj
    Dim aValues
    
    Set ArgObj = WScript.Arguments
	If ArgObj.Count = 0 Then Exit Function

	Set dictSwitches = CreateObject("Scripting.Dictionary")
	Set dictHelpRequested = CreateObject("Scripting.Dictionary")
	ReDim aNamedArguments(ArgObj.Count - 1)

	Set oOptions = New Options
	oOptions.SetOptions strCmdLine

	' intCount has the number of named arguments in the command line
	intCount = 0

    ' Parse command line options
    For intIndex = 0 to ArgObj.Count - 1
        strItem = ArgObj.Item(intIndex)
        
        ' Is this a help switch?
        If IsHelpSwitch(strItem) Then
            fGlobalHelpRequested = True
            Exit For
        End If

        ' Is this item a switch?
        If (Left(strItem, 1) = "/" Or Left(strItem, 1) = "-") And Len(strItem) > 1 Then
        	' Check for required argument
        	strItem = Mid(strItem, 2)
        	
            ' Do we have a switch with syntax '-switch:value'?
            If InStr(strItem, ":") <> 0 Then
                Dim aSwitch
                aSwitch = Split(strItem, ":")
                strItem = aSwitch(0)
                strValue = aSwitch(1)
            Else
                strValue = Null
            End If
            
        	Set oOption = oOptions.GetInfo(strItem)
        	If Not oOption Is Nothing And fGlobalHelpRequested = False Then
            	' Check if we already processed this switch before
            	If dictSwitches.Exists(oOption.Name) Then
            	    dictSwitches.Remove(oOption.Name)
            	End If
        	
        		' Option exists. Mark as visited
        		oOption.Visit
        		
        		' Check for argument requirement
        		If IsNumeric(oOption.RequiredArgs) Then
    			    ' Is there an argument in the -switch:value,value,... format?
    			    If oOption.RequiredArgs = 0 Then
            		    ' First, look for help switch
            		    If intIndex + 1 < ArgObj.Count Then
            		        If IsHelpSwitch(ArgObj(intIndex + 1)) Then
                  		        intIndex = intIndex + 1
            		            dictHelpRequested.Add oOption.Name, True
            		        End If
            		    End If
            		    
        			    ' Option does not require an argument
        			    dictSwitches.Add oOption.Name, ""
        			Else
        			    If Not IsNull(strValue) Then
        			        ' Check how many arguments we get    			        
        		            aValues = Split(strValue, ",")
        		            If CInt(oOption.RequiredArgs) <> (UBound(aValues) + 1) Then
        		                Set oError = New ParserError
        		                oError.SwitchName = oOption.Name
        		                oError.ErrorCode = ERROR_NOT_ENOUGH_ARGS
        		                Set ParseCmdLineOptions = oError
        		                Exit Function
        		            End If
        		            
        			        If InStr(strValue, ",") <> 0 Then
        			            dictSwitches.Add oOption.Name, aValues
        			        Else
        			            dictSwitches.Add oOption.Name, strValue
        			        End If 
           			    Else
        			        ' We don't have '-switch:value1,value2,...'.
        			        ' Loop to get all RequiredArgs arguments asked for
        			        If oOption.RequiredArgs > 1 Then
            			        ReDim aValues(oOption.RequiredArgs - 1)
            			        For i = 0 to oOption.RequiredArgs - 1
            			            If intIndex + 1 < ArgObj.Count Then
                    				    ' Get it. Add option to dictionary
            				            intIndex = intIndex + 1
                   			            aValues(i) = ArgObj(intIndex)

            				            ' Is this option a help switch? 
                			            If IsHelpSwitch(ArgObj(intIndex)) Then
            				                dictHelpRequested.Add oOption.Name, True
                			                ReDim Preserve aValues(UBound(aValues) - i -1)
                			                Exit For
                			            End If
            			            
                			        Else
                		                Set oError = New ParserError
                		                oError.SwitchName = oOption.Name
                		                oError.ErrorCode = ERROR_NOT_ENOUGH_ARGS
                		                Set ParseCmdLineOptions = oError
                		                Exit Function
                			        
            		    	        End If
            		    	        
                                Next
                                
                                dictSwitches.Add oOption.Name, aValues
                            Else
                                ' Just one argument (most common scenario)
                                
        			            If intIndex + 1 < ArgObj.Count Then
                				    ' Get it. Add option to dictionary
        				            intIndex = intIndex + 1
        				            
        				            If IsHelpSwitch(ArgObj(intIndex)) Then
        				                dictHelpRequested.Add oOption.Name, True
        		  			        End If

      		  			            dictSwitches.Add oOption.Name, ArgObj(intIndex)
            			        Else
            		                Set oError = New ParserError
            		                oError.SwitchName = oOption.Name
            		                oError.ErrorCode = ERROR_NOT_ENOUGH_ARGS
            		                Set ParseCmdLineOptions = oError
            		                Exit Function

        		    	        End If
                            End If
           			    End If
        			End If
        		Else
    			    ' RequiredArgs not numeric
    			    ' We should read parameters until we find another switch
    			    If Not IsNull(strValue) Then
    			        ' Check how many arguments we get    			        
    			        If InStr(strValue, ",") <> 0 Then
        		            aValues = Split(strValue, ",")
    			            dictSwitches.Add oOption.Name, aValues
    			        Else
    			            If IsHelpSwitch(strValue) Then
    			                dictHelpRequested.Add oOption.Name, True
    			            Else
    			                dictSwitches.Add oOption.Name, strValue
    			            End If
    			        End If 
       			    Else
    			        ' We don't have '-switch:value1,value2,...'.
    			        ' Loop to get all RequiredArgs until the end of the command line arguments
    			        ' or until we find another switch
    			        i = 0
    			        intIndex = intIndex + 1
    			        
        			    ReDim aValues(ArgObj.Count - intIndex - 1)
        			    
        			    Do While intIndex < ArgObj.Count
        			        If IsHelpSwitch(ArgObj(intIndex)) Then
        			            dictHelpRequested.Add oOption.Name, True
                            Else
            			        ' Exit if we find another switch
            			        If Left(ArgObj(intIndex), 1) = "/" Or Left(ArgObj(intIndex), 1) = "-" Then
                                    intIndex = intIndex - 1
            			            Exit Do
                			    Else
                			        aValues(i) = ArgObj(intIndex)
            			        End If
        			        End If        			        
        			        
        			        intIndex = intIndex + 1
        			        i = i + 1
        			    Loop
                        
        			    ReDim Preserve aValues(i - 1)
                        dictSwitches.Add oOption.Name, aValues
       			    End If
      			End If
        	Else
        		' Item not present in the list of options
                Set oError = New ParserError
                oError.SwitchName = strItem
                oError.ErrorCode = ERROR_UNKNOWN_SWITCH
                Set ParseCmdLineOptions = oError
                Exit Function
                
'        		WScript.Echo "ERROR: Unknown switch: /" & strItem
'        		WScript.Quit(-1)
        	End If
        
        Else
        	' This is not a switch (named argument)
        	' Add argument to the array of named arguments
        	aNamedArguments(intCount) = strItem
        	intCount = intCount + 1
        End If
    Next

    ReDim Preserve aNamedArguments(intCount - 1)
    
    ' Release Options object
    Set oOptions = Nothing
    
    Set ParseCmdLineOptions = Nothing
End Function

''''''''''''''''''''''''''''''''''''''''''''''
' GetSwitch(switchName)
' Return the value associated with a switch
' passed in the command line
'''''''''''''''''''''''''''''''''''''''''''''
Function GetSwitch(strSwitchName)
    If IsObject(dictSwitches(strSwitchName)) Then
	    Set GetSwitch = dictSwitches(strSwitchName)
	Else
	    GetSwitch = dictSwitches(strSwitchName)
	End If
End Function

''''''''''''''''''''''''''''''''''''''''''''''
' IsHelpRequested(switchName)
' Return if the help switch was activated for
' a certain switch
'''''''''''''''''''''''''''''''''''''''''''''
Function IsHelpRequested(strSwitch)
    Dim fHelpRequested
    Dim fResult
    
    fResult = False
    If dictHelpRequested.Exists(strSwitch) Then
        fResult = dictHelpRequested(strSwitch)
    End If

    IsHelpRequested = fResult
End Function

'''''''''''''''''''''''''''''''
' DumpCmdLineOptions()
' Show all command line options
' Used for debugging
''''''''''''''''''''''''''''''
Sub DumpCmdLineOptions()
	Dim k
	Dim value
	
	If IsNull(dictSwitches) Or dictSwitches Is Nothing Then Exit Sub
	
	WScript.Echo "Switches:"
	For Each k in dictSwitches.Keys
	    If IsArray(dictSwitches(k)) Then 
	        value = Join(dictSwitches(k), " and ")
	    Else
	        value = dictSwitches(k)
	    End If
	    
	    If IsHelpRequested(k) Then
		    WScript.Echo k & " = " & value & " (HELP switch set)"
        Else
		    WScript.Echo k & " = " & value
		End If
	Next
	
	WScript.Echo
	WScript.Echo "Named arguments:"
	For k = LBound(aNamedArguments) to UBound(aNamedArguments)
		WScript.Echo k & ". " & aNamedArguments(k)
	Next
End Sub


'''''''''''''''''''''''''''
' CheckScriptEngine
'
' This can detect the type of exe the
' script is running under and warns the
' user of the popups.
'''''''''''''''''''''''''''
Sub CheckScriptEngine()
    Dim ScriptHost

    Dim CurrentPathExt
    Dim EnvObject

    Dim RegCScript
    Dim RegPopupType ' This is used to set the pop-up box flags.
                     
    RegPopupType = 32 + 4

    On Error Resume Next

    ScriptHost = WScript.FullName
    ScriptHost = Right(ScriptHost, Len(ScriptHost) - InStrRev(ScriptHost, "\"))

    If (UCase(ScriptHost) = "WSCRIPT.EXE") Then
        WScript.Echo getResource("L_WrongScriptProcessor_Message")

        ' Create a pop-up box and ask if they want to register cscript as the default host.
        ' -1 is the time to wait.  0 means wait forever.
        RegCScript = ShellObj.PopUp(getResource("L_AskChangeScriptProcessor_Message"), 0, _
        	getResource("L_RegisterCScript_Message"), RegPopupType)
                                                                        
        If (Err.Number <> 0) Then
            WScript.Echo getResource("L_UseCScript_Message")
            WScript.Quit(Err.Number)
        End If

        ' Check to see if the user pressed yes or no.  YES is 6, NO is 7
        If (RegCScript = 6) Then
            ShellObj.RegWrite "HKEY_CLASSES_ROOT\VBSFile\Shell\Open\Command\", "%WINDIR%\System32\CScript.exe //nologo ""%1"" %*", "REG_EXPAND_SZ"
            ShellObj.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Classes\VBSFile\Shell\Open\Command\", "%WINDIR%\System32\CScript.exe //nologo ""%1"" %*", "REG_EXPAND_SZ"
            
            ' Check if PathExt already existed
            CurrentPathExt = ShellObj.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PATHEXT")
            If Err.Number = &H80070002 Then
                Err.Clear
                Set EnvObject = ShellObj.Environment("PROCESS")
                CurrentPathExt = EnvObject.Item("PATHEXT")
            End If

            ShellObj.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PATHEXT", CurrentPathExt & ";.VBS", "REG_SZ"

            If (Err.Number <> 0) Then
                WScript.Echo getResource("L_WriteReg_ErrorMessage")
                WScript.Quit (Err.Number)
            Else
                WScript.Echo getResource("L_OkWriteReg_Message")
            End If
        Else
            WScript.Echo getResource("L_UseCScript_Message")
        End If

        Dim ProcString
        Dim ArgIndex
        Dim ArgObj
        Dim Result

        ProcString = "Cscript //nologo " & WScript.ScriptFullName

        Set ArgObj = WScript.Arguments

        For ArgIndex = 0 To ArgCount - 1
            ProcString = ProcString & " " & Args(ArgIndex)
        Next

        'Now, run the original executable under CScript.exe
        Result = ShellObj.Run(ProcString, 0, True)

        WScript.Quit (Result)
    End If
End Sub



''''''''''''''''''''''''''''''''''''''''
' FindSite
'
' Return a web/ftp site paths given 
' site names or site comments
''''''''''''''''''''''''''''''''''''''
Function FindSite(strType, aArgs)
	Dim Server, Servers
	Dim strQuery, strSvcName, line
	Dim aSites, aResult, aComments
	Dim bFoundDuplicate, bCheckForDuplicates
	Dim i, j, iCount, k, spacing
	
    On Error Resume Next

	bCheckForDuplicates = False
    If UCase(strType) = "WEB" Then
	    strQuery = "select Name, ServerComment from IIsWebServerSetting where "
	    strSvcName = "W3SVC"
    Else
	    strQuery = "select Name, ServerComment from IIsFtpServerSetting where "
	    strSvcName = "MSFTPSVC"
	End If
	For i = LBound(aArgs) to UBound(aArgs)
		strQuery = strQuery & "(Name=""" & aArgs(i) & """ or ServerComment=""" & aArgs(i) & """)"
		If (i <> UBound(aArgs)) Then
			strQuery = strQuery & " or "
		End If
		
		' Verify if we need to check for duplicate (occurs only when the user supply a site 
		' name instead of metabase path)
		' Is this a site name?
		If (InStr(UCase(aArgs(i)), strSvcName) = 0) Then
			bCheckForDuplicates = True
		End If
	Next
		
    ' Semi-sync query. (flags = ForwardOnly Or ReturnImediately = &H30)
	Set Servers = ProviderObj.ExecQuery(strQuery, , &H30)
	If (Err.Number <> 0) Then
		WScript.Echo L_Query_ErrorMessage
		WScript.Echo getResource("L_Error_ErrorMessage") & " &H" & Hex(Err.Number) & ": " & Err.Description
		WScript.Quit(Err.Number)
	End If

    ReDim aResult(0)
    ReDim aComments(0)
    ReDim aPrinted(0)

    bFoundDuplicate = False
    i = 0
    For Each Server in Servers
        If Err Then
            Exit For
        End If
        
        aPrinted(i) = False

        ' Check for duplicates
        If bCheckForDuplicates Then
            For j = 0 to i - 1
                If (UCase(Server.ServerComment) = UCase(aComments(j))) Then
                    If Not bFoundDuplicate Then
                        WScript.Echo getResource("L_NotUnique1_Message")
                        WScript.Echo getResource("L_NotUnique2_Message")
                        WScript.Echo
                        WScript.Echo getResource("L_SiteName_Text") & Space(20) & getResource("L_MetabasePath_Message")
                        WScript.Echo "================================================================="
                        bFoundDuplicate = True
                    End If

                    aPrinted(j) = True
                    aPrinted(i) = True
                End If
            Next
        End If

        aComments(i) = Server.ServerComment
        aResult(i) = Server.Name
        i = i + 1
        ReDim Preserve aComments(i)
        ReDim Preserve aResult(i)
        ReDim Preserve aPrinted(i)
    Next

    ReDim Preserve aComments(i - 1)
    ReDim Preserve aResult(i - 1)
    ReDim Preserve aPrinted(i - 1)

    If bFoundDuplicate Then

        For k = 0 to UBound(aPrinted)
            If aPrinted(k) = True Then
                spacing = 29 - Len(aComments(k))
                If spacing < 1 Then
                    spacing = 1
                End If
                WScript.Echo aComments(k) & Space(spacing) & aResult(k)
            End If    
        Next

        FindSite = ""
    Else
        FindSite = aResult
    End If
End Function


'''''''''''''''''''''''''''
' IsHelpSwitch
''''''''''''''''''''
Function IsHelpSwitch(strSwitch)
	Dim fResult
	
	fResult = False
	
	If Left(strSwitch, 1) = "/" or Left(strSwitch, 1) = "-" Then
		Select Case UCase(Right(strSwitch, Len(strSwitch) - 1))
			Case "?"
				fResult = True
			Case "H"
				fResult = True
			Case "HELP"
				fResult = True
				
			Case Else
				fResult = False
		End Select
	End If
	
	IsHelpSwitch = fResult
End Function


'''''''''''''''''''''''''''
' CreateFSDir
'
''''''''''''''''''''''''''
Function CreateFSDir(strRoot)
    Dim FolderObj
    Dim intResult, iIndex
    Dim strRemotePath, strFSPath
    Dim strDrive, strDrvLetter
    
    'On Error Resume Next

    intResult = 0

    If Mid(strRoot, 2, 2) <> ":\" Then
        ' Invalid Path - using Win32Error ERROR_INVALID_ACCESS
        Err.Raise &H8007000C
        Exit Function
    End If

	If strServer <> "." Then
	    ' Server is remote. Find out first drive letter is available for mapping
        strDrive = "NO DRIVE"
        For strDrvLetter = Asc("C") to Asc("Z")
            If Not FSObj.DriveExists(Chr(strDrvLetter)) Then
                strDrive = Chr(strDrvLetter)
                Exit For
            End If
        Next
    
        If strDrive = "NO DRIVE" Then
            ' No drive letter available
            ' &H8007000F is Win32 error ERROR_INVALID_DRIVE
            Err.Raise &H8007000F 
            Exit Function
        End If
        
	    ' Look for drive specification
	    strRemotePath = "\\" & strServer & "\" & Mid(strRoot, 1, 1) & "$"
	
        ' Map network drive
        strDrive = strDrive & ":"

        If strUser <> "" Then
            NetObj.MapNetworkDrive strDrive, strRemotePath, False, strUser, strPassword
        Else
            NetObj.MapNetworkDrive strDrive, strRemotePath, False
        End If
        
        strFSPath = strDrive & Mid(strRoot, 3)
	Else
	    strFSPath = strRoot
	End If
	
    If Not FSObj.FolderExists(strFSPath) Then
        'WScript.Echo L_CreatingRootDir_Message
        
        ' Have to create path, piece by piece
        Dim aPathParts, strPathPart
        aPathParts = Split(strFSPath, "\", -1)
        strPathPart = aPathParts(0)
        iIndex = 1
        
        Do While iIndex <= UBound(aPathParts)
      	    strPathPart = strPathPart & "\" & aPathParts(iIndex)
      	    
            If Not FSObj.FolderExists(strPathPart) Then
      	        Set FolderObj = FSObj.CreateFolder(strPathPart)
      	    End If 
      	    
            iIndex = iIndex + 1
        Loop
  	    
    End If
    
    If strServer <> "." Then
        NetObj.RemoveNetworkDrive strDrive, True
    End If
    
    CreateFSDir = intResult
End Function


'''''''''''''''''''''''''''
' ParseBindings
'
' Try to get IP address, port number
' and host name from the 
' ServerBindings property
'''''''''''''''''''''''''''
Function ParseBindings(bindings)
	Dim firstColon, secondColon	
	Dim strIP, strPort, strHost

	firstColon = Instr(bindings, ":")
	secondColon = Instr(firstColon + 1, bindings, ":")
	
	strIP = Mid(bindings, 1, firstColon - 1)
	strPort = Mid(bindings, firstColon + 1, secondColon - firstColon - 1)
	strHost = Mid(bindings, secondColon + 1)
	
	ParseBindings = Array(strIP, strPort, strHost)
End Function


''''''''''''''''''''''''''''''
' WMIConnect()
'''''''''''''''''''''
Function WMIConnect()
    'On Error Resume Next

    If Not IsObject(LocatorObj) Then
        Exit Function
    End If
    
    WScript.StdOut.Write getResource("L_Connecting_Message")

    Set ProviderObj = LocatorObj.ConnectServer(strServer, getResource("WMI_NAMESPACE"), strUser, strPassword)

    WScript.StdOut.WriteLine getResource("L_Done_Message")
End Function


'''''''''''''''''''''''''
' ValidateIPAddress
' Returns TRUE if IP Address is associated with one of the network adapters
'''''''''''''''''''
Function IsValidIPAddress(strIPAddress)
	Dim CIMv2ProviderObj, IPConfig, IPConfigSet
	Dim strQuery, iCounter
	Dim regExpObj, Matches, Match
	Dim bResult
	
	On Error Resume Next
	
	bResult = False
	
	' First test the IP address against a mask
	Set regExpObj = New RegExp
	regExpObj.Pattern = "(\d+)\.(\d+)\.(\d+)\.(\d+)"
	regExpObj.Global = True
	Set Matches = regExpObj.Execute(strIPAddress)
    If Matches.Count <> 1 Then
        IsValidIPAddress = bResult
        Exit Function
    End If
	For Each Match in Matches(0).SubMatches
	    If Match < 0 Or Match > 255 Then
            IsValidIPAddress = bResult
	        Exit Function
	    End If
	Next
	
	' Check if IP address belongs to the target machine
    If Not IsObject(LocatorObj) Then
        IsValidIPAddress = bResult
        Exit Function
    End If
    
	Set CIMv2ProviderObj = LocatorObj.ConnectServer(strServer, "root/CIMv2", strUser, strPassword)
    If Err.Number Then
    	WScript.Echo getResource("L_ConnectObject_ErrorMessage")
    	WScript.Echo getResource("L_Error_ErrorMessage") & " &H" & Hex(Err.Number) & ": " & Err.Description
    	'WScript.Quit(Err.Number)
    End If

    strQuery = "SELECT IPAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = TRUE"
    ' Semi-sync query. (flags = ForwardOnly Or ReturnImediately = &H30)
	Set IPConfigSet = CIMv2ProviderObj.ExecQuery(strQuery, , &H30)
	For Each IPConfig in IPConfigSet
	    If Not IsNull(IPConfig.IPAddress) Then
    	    iCounter = LBound(IPConfig.IPAddress)
    	    Do While iCounter <= UBound(IPConfig.IPAddress)
        	    If IPConfig.IPAddress(iCounter) = strIPAddress Then
        	        bResult = True
        	        Exit For
        	    End If
        	    
        	    iCounter = iCounter + 1
    	    Loop
    	End If
	Next
	
	IsValidIPAddress = bResult
End Function

Function IsValidPortNumber(intPort)
    Dim bResult
    
    bResult = False
    
    If IsNumeric(intPort) And intPort > 0 And intPort < 65535 Then
        bResult = True
    End If
    
    IsValidPortNumber = bResult
End Function

Function GetEnvironmentVar(strVar)
	GetEnvironmentVar = ShellObj.ExpandEnvironmentStrings(strVar)
End Function


Sub BuildNameSpace(strPath)
    Dim aPath
    Dim strNewPath, strVDirPath
    Dim strQuery
    Dim VDirObj, Dir, NewWebDir
    Dim iStart, i, iErrNumber
    
    ' Skip the *SVC/n/ROOT part
    iStart = InStr(InStr(strPath, "ROOT"), strPath, "/")
    ' If strPath is equal to *SVC/n/ROOT, there's nothing left to do.
    If iStart = 0 Or iStart = Len(strPath) Then
        Exit Sub
    End If
    
    ' strPath now start from the first node after ROOT in the metabase path
    strNewPath = Mid(strPath, iStart + 1)
    strVDirPath = Mid(strPath, 1, iStart - 1)
    aPath = Split(strNewPath, "/", -1)

    ' Now let's build the web directories for each path component
    If strServer = "." Then 
        strVDirPath = "IIS://" & GetEnvironmentVar("%COMPUTERNAME%") & "/" & strVDirPath
    Else
        strVDirPath = "IIS://" & strServer & "/" & strVDirPath
    End If
    
    On Error Resume Next

    ' Search for the first path component that doesn't exist.
    For i = LBound(aPath) to UBound(aPath)
        ' For each path component, check if the component exists in the metabase
        Set Dirs = GetObject(strVDirPath & "/" & aPath(i))
        If Err = &H80070003 Then
            Err.Clear
            Exit For
        End If

        strVDirPath = strVDirPath & "/" & aPath(i)
    Next

    On Error Goto 0            

    ' Create all path components that doesn't exist
    For i = i to UBound(aPath)
        Set Dir = GetObject(strVDirPath)
        Set NewWebDir = Dir.Create("IIsWebDirectory", aPath(i))
        If Err Then
            iErrNumber = Err.Number
            On Error Goto 0
            Err.Raise iErrNumber
        End If
        
        NewWebDir.SetInfo
        If Err Then
            iErrNumber = Err.Number
            On Error Goto 0
            Err.Raise iErrNumber
        End If

        strVDirPath = strVDirPath & "/" & aPath(i)
    Next
    
End Sub


Function GetAbsolutePath(strPath)
	GetAbsolutePath = FSObj.GetAbsolutePathName(strPath)
End Function


Function NormalizeFilePath(strPath)
    Dim strPathName
    
    strPathName = GetAbsolutePath(strPath)
    If FSObj.FolderExists(strPathName) Then
        ' Should not be a folder path
        Err.Raise &H80070002 ' Could not find FILE specified
    End If
    
    NormalizeFilePath = strPathName
End Function
]]>
		</script>
	</component>
</package>