'Lilo 编写
'Lilo@Bugkidz.org
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