'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