1233 lines
39 KiB
Plaintext
1233 lines
39 KiB
Plaintext
|
<?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">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">Error trying to get WMI SWbemService object</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_AskChangeScriptProcessor_Message">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")
|
||
|
|
Else
|
||
|
|
WScript.Echo getResource("L_ConnectObject_ErrorMessage")
|
||
|
|
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
|
||
|
|
WScript.Echo getResource("L_OnlyIIS6Supported_ErrorMessage")
|
||
|
|
InitAuthentication = Err.Number
|
||
|
|
Exit Function
|
||
|
|
End If
|
||
|
|
|
||
|
|
iMajorVersion = ComputerObj.MD_SERVER_VERSION_MAJOR
|
||
|
|
If Err.Number Or iMajorVersion <> 6 Then
|
||
|
|
WScript.Echo getResource("L_OnlyIIS6Supported_ErrorMessage")
|
||
|
|
InitAuthentication = 1
|
||
|
|
Exit Function
|
||
|
|
End If
|
||
|
|
|
||
|
|
' Set DefaultNamespaceObj = LocatorObj.ConnectServer(strServer, "root\default", strUser, strPassword)
|
||
|
|
' If Err.Number Then
|
||
|
|
' WScript.Echo getResource("L_ConnectObject_ErrorMessage")
|
||
|
|
' WScript.Echo getResource("L_Error_ErrorMessage") & " &H" & Hex(Err.Number) & ": " & Err.Description
|
||
|
|
' InitAuthentication = Err.Number
|
||
|
|
' Exit Function
|
||
|
|
' End If
|
||
|
|
'
|
||
|
|
' Set RegistryObj = DefaultNamespaceObj.get("StdRegProv")
|
||
|
|
' iResult = RegistryObj.GetMultiStringValue(, getResource("ProductInfoRegKey"), _
|
||
|
|
' getResource("ProductInfoRegValue"), _
|
||
|
|
' aResult)
|
||
|
|
' If iResult <> 0 Or Err Then
|
||
|
|
' WScript.Echo getResource("L_RegProc_ErrorMessage")
|
||
|
|
' If iResult Then
|
||
|
|
' InitAuthentication = iResult
|
||
|
|
' Else
|
||
|
|
' InitAuthentication = Err.Number
|
||
|
|
' End If
|
||
|
|
' Exit Function
|
||
|
|
' Else
|
||
|
|
' If UBound(aResult) < 0 Then
|
||
|
|
' ' Target machine is PRO
|
||
|
|
' WScript.Echo getResource("L_OnlyIIS6Supported_ErrorMessage")
|
||
|
|
' InitAuthentication = &H80070032
|
||
|
|
' Exit Function
|
||
|
|
' ElseIf aResult(0) = "Personal" Then
|
||
|
|
' ' Target machine is PER
|
||
|
|
' WScript.Echo getResource("L_OnlyIIS6Supported_ErrorMessage")
|
||
|
|
' InitAuthentication = &H80070032
|
||
|
|
' Exit Function
|
||
|
|
' Else
|
||
|
|
' ' Target machine is SRV or above
|
||
|
|
' End If
|
||
|
|
' End If
|
||
|
|
|
||
|
|
' If we get here, everything went fine.
|
||
|
|
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
|
||
|
|
' WScript.Echo "ERROR: Switch /" & oOption.Name & " expects " & _
|
||
|
|
' oOption.RequiredArgs & " arguments. Got only " & UBound(aValues)
|
||
|
|
' WScript.Quit(0)
|
||
|
|
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
|
||
|
|
|
||
|
|
' Wscript.Echo "ERROR: Switch /" & oOption.Name & " requires " & _
|
||
|
|
' oOption.RequiredArgs & " argument(s)"
|
||
|
|
' WScript.Quit(-1)
|
||
|
|
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
|
||
|
|
|
||
|
|
' Wscript.Echo "ERROR: Switch /" & oOption.Name & " requires " & _
|
||
|
|
' oOption.RequiredArgs & " argument(s)"
|
||
|
|
' WScript.Quit(-1)
|
||
|
|
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
|
||
|
|
|
||
|
|
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)
|
||
|
|
|
||
|
|
bFoundDuplicate = False
|
||
|
|
i = 0
|
||
|
|
For Each Server in Servers
|
||
|
|
If Err Then
|
||
|
|
Exit For
|
||
|
|
End If
|
||
|
|
|
||
|
|
' 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 "================================================================="
|
||
|
|
WScript.Echo Server.ServerComment & Space(29 - Len(Server.ServerComment)) & aResult(j)
|
||
|
|
bFoundDuplicate = True
|
||
|
|
End If
|
||
|
|
|
||
|
|
WScript.Echo Server.ServerComment & Space(29 - Len(Server.ServerComment)) & Server.Name
|
||
|
|
Exit For
|
||
|
|
End If
|
||
|
|
Next
|
||
|
|
End If
|
||
|
|
|
||
|
|
aComments(i) = Server.ServerComment
|
||
|
|
aResult(i) = Server.Name
|
||
|
|
i = i + 1
|
||
|
|
ReDim Preserve aComments(i)
|
||
|
|
ReDim Preserve aResult(i)
|
||
|
|
Next
|
||
|
|
|
||
|
|
ReDim Preserve aComments(i - 1)
|
||
|
|
ReDim Preserve aResult(i - 1)
|
||
|
|
|
||
|
|
If bFoundDuplicate Then
|
||
|
|
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 & ":"
|
||
|
|
NetObj.MapNetworkDrive strDrive, strRemotePath, False, strUser, strPassword
|
||
|
|
|
||
|
|
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)
|
||
|
|
' If (Err.Number <> 0) Then
|
||
|
|
' 'WScript.Echo getResource("L_ConnectObject_ErrorMessage")
|
||
|
|
' 'WScript.Echo getResource("L_Error_ErrorMessage") & " &H" & Hex(Err.Number) & ": " & Err.Description
|
||
|
|
' WMIConnect = Err.Number
|
||
|
|
' 'WScript.Quit(Err.Number)
|
||
|
|
' Else
|
||
|
|
' WMIConnect = 0
|
||
|
|
' End If
|
||
|
|
|
||
|
|
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, strFSPath, 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)
|
||
|
|
|
||
|
|
' Grab root directory for *SVC/n/ROOT
|
||
|
|
Set VDirObj = ProviderObj.Get("IIsWebVirtualDirSetting='" & strVDirPath & "'")
|
||
|
|
strFSPath = VDirObj.Path
|
||
|
|
Set VDirObj = Nothing
|
||
|
|
|
||
|
|
aPath = Split(strNewPath, "/", -1)
|
||
|
|
For i = LBound(aPath) to UBound(aPath)
|
||
|
|
strFSPath = strFSPath & "\" & aPath(i)
|
||
|
|
Next
|
||
|
|
|
||
|
|
' First, make sure the file system path exists
|
||
|
|
If Not FSObj.FolderExists(strFSPath) Then
|
||
|
|
' FS Path not found
|
||
|
|
Err.Raise &H80070003 ' The system cannot find the path specified
|
||
|
|
Exit Sub
|
||
|
|
End If
|
||
|
|
|
||
|
|
' FS Path exists. 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
|
||
|
|
|
||
|
|
' Parent folder should exist
|
||
|
|
If Not FSObj.FolderExists(FSObj.GetParentFolderName(strPathName)) Then
|
||
|
|
Err.Raise &H80070003 ' Could not find PATH specified
|
||
|
|
End If
|
||
|
|
|
||
|
|
NormalizeFilePath = strPathName
|
||
|
|
End Function
|
||
|
|
]]>
|
||
|
|
</script>
|
||
|
|
</component>
|
||
|
|
</package>
|