You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1189 lines
38 KiB
1189 lines
38 KiB
<?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>
|