Edit C:\Windows\System32\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>
            <method name="vbPrintf"/>
            <method name="matchPattern"/>

</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_OnlyIIS6AndHigherSupported_ErrorMessage">The IIS Admin scripts only support IIS 6.0 and higher.</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="WBemAuthenticationLevelPktPrivacy">6</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>
    <resource id="L_INVALID_ERRORMESSAGE_TYPE_AS_INPUT">ERROR: Invalid type passed as input to the function.</resource>
    <resource id="L_INVALID_ERRORMESSAGE_ARG_NUMBER_AS_INPUT_ERRORMESSAGE">ERROR: Invalid number of arguments passed to the Print function.</resource>
    <resource id="EXIT_INVALID_PARAM">999</resource>
    <resource id="L_ERROR_CHECK_VBSCRIPT_VERSION_ERRORMESSAGE">Unexpected Error: Please check the current version of VBScript.</resource>

Option Explicit
On Error Resume Next

''''''''''''''''''''''''
' Globalization related code
'
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Const vbSpace = " "

' Get the overridden UI language.
Function GetLangID()
  Dim args, lang

Set args = WScript.Arguments.Named
  If args.Exists("lang") Then
    lang = args.Item("lang")
    GetLangID = CInt(lang)
  Else
    GetLangID = GetUILanguage()
  End If
End Function

' Get a localized resources for 'resourceID' if available;
' otherwise, get the neutral resource.
Function GetLocalizedResource(resourceID)
  Const ForReading = 1, TristateUseDefault = -2
  Dim lang, value, ini
    
  lang = GetLangID()
  ini = fso.GetParentFolderName(WScript.ScriptFullName) & "\" _
      & ToHex(lang) & "\" & fso.GetBaseName(WScript.ScriptName) &  ".ini"

If fso.FileExists(ini) Then
    Dim stream, file

Set file = fso.GetFile(ini)
    Set stream = file.OpenAsTextStream(ForReading, TristateUseDefault)
    value = ReadResource(stream, resourceID)
  End If

If Not IsEmpty(value) Then
    GetLocalizedResource = value
  Else
    GetLocalizedResource = getResource(resourceID)
  End If
End Function

' Read a resource ID from the TextStream
Function ReadResource(stream, resourceID)
  Const ERROR_FILE_NOT_FOUND = 2
  Dim ln, arr, key, value

If Not IsObject(stream) Then Err.Raise ERROR_FILE_NOT_FOUND

Do Until stream.AtEndOfStream
    ln = stream.ReadLine

arr = Split(ln, "=", 2, 1)
    If UBound(arr, 1) = 1 Then
      ' Trim the key and the value first before trimming quotes
      key = arr(0)
      key = TrimSpace(key)
      'key = Replace(key, String(1, vbTab), "")

If StrComp(resourceID, key, 1) = 0 Then
        value = TrimChar(TrimSpace(arr(1)), """")
        ReadResource = value
        Exit Do
      End If
    End If
  Loop

stream.Close
End Function

Function TrimSpace(s)
  Dim c
  do
    c = Left(s, 1)
    if c <> vbTab and c <> vbSpace then
      exit do
    end if
    s = Right(s, len(s) - 1)
  loop

do
    c = Right(s, 1)
    if c <> vbTab and c <> vbSpace then
      exit do
    end if
    s = Left(s, len(s) - 1)
  loop

TrimSpace = s
End Function

' Trim a character from the text string
Function TrimChar(s, c)
  Dim a
  do
    a = Left(s, 1)
    if a <> c then
      exit do
    end if
    s = Right(s, len(s) - 1)
  loop

do
    a = Right(s, 1)
    if a <> c then
      exit do
    end if
    s = Left(s, len(s) - 1)
  loop

TrimChar = s
End Function

Function ToHex(n)
  Dim s : s = Hex(n)
  ToHex = String(4 - Len(s), "0") & s
End Function

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 GetLocalizedResource("L_Warning_Text") & ": " & GetLocalizedResource("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 GetLocalizedResource("L_Locator_ErrorMessage")
      WScript.Echo GetLocalizedResource("L_Error_ErrorMessage") & " &H" & Hex(Err.Number) & ": " & Err.Description
      InitAuthentication = Err.Number
      Exit Function
    End If

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

' 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 GetLocalizedResource("L_OnlyIIS6AndHigherSupported_ErrorMessage")
        ElseIf Err.Number = &H800706BA Then
          WScript.Echo GetLocalizedResource("L_ConnectObject_ErrorMessage")
        ElseIf Err.Number = &H80070005 Then
            WScript.Echo GetLocalizedResource("L_BadCredentials_ErrorMessage")
        Else
            WScript.Echo GetLocalizedResource("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'")

' Try to retrieve version info from FTP service info node in case W3SVC is not installed/present
    If Err.Number = &H80070003 Then
        Err.Clear
        Set ComputerObj = IISNameSpaceObj.get("IIsFtpInfo='MSFTPSVC/Info'")
    End If

If Err.Number Then
        Select Case Err.Number
            Case &H80070005
                WScript.Echo GetLocalizedResource("L_Admin_ErrorMessage")
                InitAuthentication = Err.Number

Case Else
                WScript.Echo GetLocalizedResource("L_OnlyIIS6AndHigherSupported_ErrorMessage")
            WScript.Echo GetLocalizedResource("L_Error_ErrorMessage") & " &H" & Hex(Err.Number) & ": " & Err.Description
              InitAuthentication = Err.Number
        End Select

Exit Function
    End If

iMajorVersion = ComputerObj.MajorIIsVersionNumber
    If Err.Number Or iMajorVersion < 6 Then
        WScript.Echo GetLocalizedResource("L_OnlyIIS6AndHigherSupported_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 GetLocalizedResource("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(GetLocalizedResource("L_AskChangeScriptProcessor_Message"), 0, _
          GetLocalizedResource("L_RegisterCScript_Message"), RegPopupType)

If (Err.Number <> 0) Then
            WScript.Echo GetLocalizedResource("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 GetLocalizedResource("L_WriteReg_ErrorMessage")
                WScript.Quit (Err.Number)
            Else
                WScript.Echo GetLocalizedResource("L_OkWriteReg_Message")
            End If
        Else
            WScript.Echo GetLocalizedResource("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 GetLocalizedResource("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 GetLocalizedResource("L_NotUnique1_Message")
                        WScript.Echo GetLocalizedResource("L_NotUnique2_Message")
                        WScript.Echo
                        WScript.Echo GetLocalizedResource("L_SiteName_Text") & Space(20) & GetLocalizedResource("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 GetLocalizedResource("L_Connecting_Message")

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

WScript.StdOut.WriteLine GetLocalizedResource("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 GetLocalizedResource("L_ConnectObject_ErrorMessage")
      WScript.Echo GetLocalizedResource("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

' Subroutine which implements normal printf functionality
        '********************************************************************
        '* Sub:     vbPrintf
        '*
        '* Purpose: Simulates the Printf function.
        '*
        '* Input:  [in]  strPhrase      the string with '%1 %2 &3 ' in it
        '*         [in]  args           the values to replace '%1 %2 ..etc' with
        '*
        '* Output:  Displays the string on the screen
        '*          (All the '%x' variables in strPhrase is replaced by the 
        '*           corresponding elements in the array)
        '*
        '********************************************************************
        Sub vbPrintf(ByVal strPhrase, ByVal args )

ON ERROR RESUME NEXT
            Err.Clear

'Changed for localization

Dim strMatchPattern         ' the pattern to match - '%[number]'
            Dim intValuesCount          ' to get the count of matching results
            Dim i                       ' used in the loop
            Dim strTemp                 ' to store temporally  the given input string  for formatting

strTemp   = strPhrase

' look out for '%[number]' in the given string
            strMatchPattern = getResource("PATTERN_VBPRINTF") '"\%[number]"

intValuesCount = matchPattern (strMatchPattern, strTemp)

If intValuesCount <> 0 Then
                ' if present then replace '%1 %2 %3' in the string by
                ' corresponding element in the given array

If Not IsArray(args) Then
                    WScript.Echo GetLocalizedResource("L_INVALID_ERRORMESSAGE_TYPE_AS_INPUT")
                    WScript.Quit getResource("EXIT_INVALID_PARAM")
                End If
               
                If intValuesCount <> UBound(args)+1 Then
                    WScript.Echo GetLocalizedResource("L_INVALID_ERRORMESSAGE_ARG_NUMBER_AS_INPUT_ERRORMESSAGE")
                    WScript.Quit getResource("EXIT_INVALID_PARAM")
                End If

For i = 1 to intValuesCount
                    strPhrase = Replace(strPhrase, "%" & Cstr(i), (args(i-1) ), 1, 1, VBBinaryCompare)
                Next

End If

WScript.Echo(strPhrase)

End Sub

' Function which checks whether a given value matches a particular pattern
        '********************************************************************
        '* Function: matchPattern
        '*
        '* Purpose:  To check if the given pattern is existing in the string
        '*
        '* Input:
        '*  [in]     strMatchPattern   the pattern to look out for
        '*  [in]     strPhrase         string in which the pattern needs to be checked
        '*
        '* Output:   Returns number of occurrences if pattern present, 
        '*           Else returns CONST_NO_MATCHES_FOUND
        '*
        '********************************************************************
        Function matchPattern(ByVal strMatchPattern, ByVal strPhrase)

ON ERROR RESUME NEXT
            Err.Clear

Dim objRegEx        ' the regular expression object
            Dim Matches         ' the results that match the given pattern
            Dim intResultsCount ' the count of Matches
            
            intResultsCount = 0  ' initialize the count to 0

'create instance of RegExp object
            Set objRegEx = New RegExp 
            If (NOT IsObject(objRegEx)) Then
                WScript.Echo (GetLocalizedResource("L_ERROR_CHECK_VBSCRIPT_VERSION_ERRORMESSAGE"))
            End If
            'find all matches
            objRegEx.Global = True
            'set case insensitive
            objRegEx.IgnoreCase = True
            'set the pattern
            objRegEx.Pattern = strMatchPattern

Set Matches = objRegEx.Execute(strPhrase)
            intResultsCount = Matches.Count

'test for match
            If intResultsCount > 0 Then
                matchPattern = intResultsCount
            Else
                matchPattern = getResource("CONST_NO_MATCHES_FOUND")
            End If

End Function

]]>
    </script>
  </component>
</package>

Ms-Dos/Windows Unix Write backup

jsp File Browser version 1.2 by www.vonloesch.de