'Lilo 編寫
'[email protected]
On Error Resume Next
Dim oArgs, ArgNum, ArgComputer, ArgWebSites, ArgVirtualDirs, ArgDirNames(), ArgDirPaths(), DirIndex, ArgComputers

Set oArgs = WScript.Arguments
ArgComputers = Array("LocalHost")

ArgNum = 0
While ArgNum < oArgs.Count

    If (ArgNum + 1) >= oArgs.Count Then
        Call DisplayUsage
    End If    
    Select Case LCase(oArgs(ArgNum))
        Case "-w":
            ArgNum = ArgNum + 1
            ArgWebSites = oArgs(ArgNum)
        Case "-v":
            ArgNum = ArgNum + 1
            ArgVirtualDirs = Split(oArgs(ArgNum), ",", -1)
        Case "-?"
            Call DisplayUsage
    End Select    
    ArgNum = ArgNum + 1
Wend
ArgNum = 0
DirIndex = 0
MaxWeb = CLng(ListAllWeb(0))
If Not IsNumeric(ArgWebSites) Or MaxWeb = 0 Then Call DisplayUsage
ReDim ArgDirNames((UBound(ArgVirtualDirs)+1) / 2)
ReDim ArgDirPaths((UBound(ArgVirtualDirs)+1) / 2)

if isArray(ArgVirtualDirs) then
    While ArgNum <= UBound(ArgVirtualDirs)
        ArgDirNames(DirIndex) = ArgVirtualDirs(ArgNum)
        If (ArgNum + 1) > UBound(ArgVirtualDirs) Then
            WScript.Echo "Error understanding virtual directories"
            Call DisplayUsage
        End If    
        ArgNum = ArgNum + 1
        ArgDirPaths(DirIndex) = ArgVirtualDirs(ArgNum)
        ArgNum = ArgNum + 1
        DirIndex = DirIndex + 1
    Wend
end if 

If (ArgWebSites = "") Or (IsArray(ArgDirNames) = False or IsArray(ArgDirPaths) = False) Then
    Call DisplayUsage
Else
    Dim compIndex
    for compIndex = 0 to UBound(ArgComputers)
        Call ASTCreateVirtualWebDir(ArgComputers(compIndex),ArgWebSites,ArgDirNames,ArgDirPaths)
    next
End If

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

Sub Trace(Msg)
    WScript.Echo Now & " : " & Msg    
End Sub

Sub DisplayUsage()
    WScript.Echo String(75,"*") & vbCrLf & "Usage: MDir <-w WebSite Index>" & vbCrLf & "            <-v Name1,Path1,Name2,Path2,...>" & vbCrLf & "Example : MDir -w 1 -v ""Root/Disk-C"",""C:/"",""Root/Disk-D"",""D:/""" & vbCrLf & String(75,"*") & vbCrLf & ListAllWeb(1)
    WScript.Quit
End Sub

Sub ASTCreateVirtualWebDir(ComputerName,WebSiteName,DirNames,DirPaths)
    Dim Computer, webSite, WebSiteID, vRoot, vDir, DirNum
    On Error Resume Next
    Set webSite = GetObject("IIS://Localhost/W3SVC/" & WebSiteName)
    if IsObject(webSite) then
        set vRoot = webSite.GetObject("IIsWebVirtualDir", "Root")
        Trace "Accessing Root For " & webSite.ADsPath
        If (Err <> 0) Then
            Display "Unable To Access Root for " & webSite.ADsPath
        Else
            DirNum = 0
            If (IsArray(DirNames) = True) And (IsArray(DirPaths) = True) And (UBound(DirNames) = UBound(DirPaths)) Then
                While DirNum < UBound(DirNames)
                    Set vDir = vRoot.Create("IIsWebVirtualDir",DirNames(DirNum))
                    If (Err <> 0) Then
                        Display "Unable To Create " & vRoot.ADsPath & "/" & DirNames(DirNum) &"."
                    Else
                        vDir.EnableDirBrowsing      = True
                        vDir.DirBrowseShowDate      = False
                        vDir.DirBrowseShowTime      = False
                        vDir.DirBrowseShowSize      = False
                        vDir.DirBrowseShowExtension = False
                        vDir.DirBrowseShowLongDate  = True
                        vDir.DirBrowseFlags         = -1073741762
                        vDir.AccessRead             = True
                        vDir.AccessWrite            = False
                        vDir.AccessExecute          = False
                        vDir.AccessScript           = False
                        vDir.AccessSource           = False
                        vDir.AccessNoRemoteRead     = False
                        vDir.AccessNoRemoteWrite    = False
                        vDir.AccessNoRemoteExecute  = False
                        vDir.AccessNoRemoteScript   = False
                        vDir.AppIsolated            = 1
                        vDir.AccessFlags            = 1
                        vDir.ContentIndexed         = False
                        vDir.CreateProcessasUser    = False
                        vDir.DontLog                = True
'                        vDir.DefaultDoc             = ""
                        vDir.EnableDefaultDoc       = False
                        vDir.AppFriendlyName        = ""
                        vDir.AppCreate2 3
                        vDir.Path = DirPaths(DirNum)
                        If (Err <> 0) Then
                            Display "Unable To Bind Path " & DirPaths(DirNum) & " to " & vRootName & "/" & DirNames(DirNum) & ". Path may be invalid."
                        Else
                            'Save the changes
                            vDir.SetInfo
                            If (Err <> 0) Then
                                Display "Unable To Save Configuration For " & vRootName & "/" & DirNames(DirNum) &"."
                            Else
                                Trace "Web Virtual Directory " & vRootName & "/" & DirNames(DirNum) & " created successfully."
                            End If
                        End If
                    End If
                    Err = 0
                    DirNum = DirNum + 1
                Wend
            End If
        End If
    else
        Display "Unable To Find "& WebSiteName &" on "& ComputerName
    End if
    Trace "Done."
End Sub

Function ListAllWeb(n)
    Set ObjService=GetObject("IIS://LocalHost/W3SVC")
    If n = 1 Then ListAllWeb = "" Else ListAllWeb = 0
    For Each obj3w In objservice
        If IsNumeric(obj3w.Name) Then
            sServerName=Obj3w.ServerComment
            If n = 1 Then
                ListAllWeb = ListAllWeb & obj3w.Name & String(15-Len(obj3w.Name)," ") & obj3w.ServerComment & vbCrLf
            Else
                ListAllWeb = ListAllWeb + 1
            End If
        End If
    Next
    if n = 1 Then ListAllWeb = "Index" & String(10," ") & "ServerComment" & vbCrLf & String(75,"_") & vbCrLf & ListAllWeb
    Set ObjService=Nothing
End Function