用VBS创建IIS虚拟站点实例

‘’ ---------------------------------------------------------------------------
‘’ Creates or deletes the virtual directory
‘’
‘’ Valid command line switches: -i -u -q
‘’   -i  Install virtual directory
‘’   -u  Remove virtual directory
‘’   -q  Run in quiet mode
‘’
‘’ ---------------------------------------------------------------------------
‘’ See

Option Explicit

Dim vPath,vName, vWshShell, vObjArgs, vInstall, vRemove, vQuiet, i

vName = "channel7"

‘’ get current path to folder
vPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\", 15) - 1)
vPath = vPath & "\owbase"

‘’Set WshShell = WScript.CreateObject("WScript.Shell")
‘’vPath = WshShell.RegRead("HKLM\Software\channel7") & "\owbase"

vQuiet = False
vInstall = False
vRemove = False

Set vObjArgs = WScript.Arguments

For i = 0 To vObjArgs.Count - 1
    If InStr(LCase(vObjArgs(i)), "i") <> 0 Then
        vInstall = True
    Elseif InStr(LCase(vObjArgs(i)), "u") <> 0 Then
        vRemove = True
    End If
    If InStr(LCase(vObjArgs(i)), "q") <> 0 Then
        vQuiet = True
    End If
Next

If vRemove Then
    DeleteVDir vName
Elseif vInstall Then
    CreateVDir vName, vPath
End If

Sub CreateVDir(pName, pPath)
    Dim vRoot, vBaseDir, vWebSite, ipSecurityObj, ipList

    On Error Resume Next

    ‘’ get the local host default web
    Set vWebSite = GetObject("IIS://localhost/w3svc/1")
    If Not IsObject(vWebSite) Then
        Display "Unable to locate the Default Web Site. IIS must be installed and running."
        Exit Sub
    Else
        ‘’Display vWebSite.name
    End if

    ‘’ get the root
    Set vRoot = vWebSite.GetObject("IIsWebVirtualDir", "Root")
    If (Err <> 0) Then
        Display "Unable to aclearcase/" target="_blank" >ccess root for " & vWebSite.ADsPath
        Exit Sub
    Else
        ‘’Display vRoot.name
    End If

    ‘’ find or create the ow vroot.
    ‘’ The physical path to is set to the ...<install-dir>\owbase folder
    Err.Number = 0 ‘’Clear Error
    Set vBaseDir = GetObject(vRoot.ADsPath & "/" + pName)
    If Err.Number <> 0 Then
        Err.Number = 0
        Set vBaseDir = vRoot.Create("IIsWebVirtualDir", pName)
        vBaseDir.AccessRead = True
        vBaseDir.AccessFlags = 513  ‘’ = 0x200 + 0x01 = MD_ACCESS_SCRIPT + MD_ACCESS_READ
        vBaseDir.AppCreate False
        vBaseDir.AspAllowSessionState = False
        vBaseDir.SetInfo ‘’ This section restricts access to everyone except localhost (127.0.0.1).
        ‘’Set ipSecurityObj = vBaseDir.IpSecurity
        ‘’ipSecurityObj.GrantByDefault = False
        ‘’ipList = ipSecurityObj.IPGrant
        ‘’ReDim ipList(UBound(ipList) + 1)
        ‘’ipList(UBound(ipList)) = "127.0.0.1"
        ‘’ipSecurityObj.IPGrant = ipList
        ‘’vBaseDir.IpSecurity = ipSecurityObj
        ‘’vBaseDir.SetInfo

        vBaseDir.Path = pPath
        vBaseDir.AppFriendlyName = "channel7"
        vBaseDir.SetInfo

        If (Err <> 0) Then
            Display "Unable to create " & vRoot.ADsPath & "/" & pName
            Exit Sub
        Else
            Err = 0
            ‘’Display vBaseDir.name
        End If
    End If

End Sub

Sub DeleteVDir(pName)
    Dim vRoot, vBaseDir, vWebSite, ipSecurityObj, ipList
    On Error Resume Next

    ‘’ get the local host default web
    Set vWebSite = GetObject("IIS://localhost/w3svc/1")
    If Not IsObject(vWebSite) Then
        Display "Unable to locate the Default Web Site. IIS must be installed and running."
        Exit Sub
    Else
        ‘’Display vWebSite.name
    End If

    ‘’ get the root
    Set vRoot = vWebSite.GetObject("IIsWebVirtualDir", "Root")
    If (Err <> 0) Then
        Display "Unable to access root for " & vWebSite.ADsPath
        Exit sub
    Else
        ‘’display vRoot.name
    End If

    Err.Number = 0 ‘’Clear Error
    Set vBaseDir = GetObject(vRoot.ADsPath)

    vBaseDir.Delete "IIsWebVirtualDir", pName
    vBaseDir.SetInfo

    If Not vQuiet Then
        WScript.Echo "Virtual directory " & vBaseDir.Name & "/" & pName & " deleted successfully."
    End If
End Sub

Sub Display(pMsg)
    If Not vQuiet Then
        WScript.Echo Now & ". Error Code: " & Hex(Err) & " - " & pMsg
    End If
End Sub

原文转自：http://www.ltesting.net