CreateWeb.vbs 代码

"==============================================================================
"
"  The .NET PetShop Blueprint Application WebSite Setup
"
"  File: CreateWeb.vbs
"  Date: November 10, 2001
"
"  Creates a new vdir for this project. Set vName to name of folder on disk
"  that holds the files.
"
"==============================================================================
"
" Copyright （C） 2001 Microsoft Corporation
"
"==============================================================================
Option Explicit

dim vPath
dim scriptPath
dim vName

vName="PetShop" " name of web to create

" *****************************************************************************
"
" 1. Create the IIS Virtual Directory
"
" *****************************************************************************
" get current path to folder and add web name to it
scriptPath = left（Wscript.ScriptFullName,len（Wscript.ScriptFullName ） -len（Wscript.ScriptName））
vPath = scriptPath & "Web"

"call to create vDir
CreateVDir（vPath）

" ----------------------------------------------------------------------------
"
" Helper Functions
"
" -----------------------------------------------------------------------------

"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
" Creates a single Virtual Directory （code taken from mkwebdir.vbs and
" changed for single vDir creation）.
"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Sub CreateVDir（vPath）

    Dim vRoot,vDir,webSite
    On Error Resume Next

    " get the local host default web
    set webSite = findWeb（"localhost", "Default Web Site"）
    if IsObject（webSite）=False then
        Display "Unable to locate the Default Web Site"
        exit sub
    else
        "display webSite.name
    end if

    " get the root
    set vRoot = webSite.GetObject（"IIsWebVirtualDir", "Root"）
    If （Err <> 0） Then
        Display "Unable to access root for " & webSite.ADsPath
        Exit sub
    else
        "display vRoot.name
    End IF

    " delete existing web if needed
    vRoot.Delete "IIsWebVirtualDir",vName
    vRoot.SetInfo
    Err=0 " reset error

    " create the new web
    Set vDir = vRoot.Create（"IIsWebVirtualDir",vName）
    If （Err <> 0） Then
        Display "Unable to create " & vRoot.ADsPath & "/" & vName & "."
        exit sub
    else
        "display vdir.name
    end if

    " set properties on the new web
    vDir.AccessRead = true
    vDir.Path = vPath
    vDir.Accessflags = 529
        VDir.AppCreate False
    If （Err <> 0） Then
        Display "Unable to bind path " & vPath & " to " & vRoot.Name & "/" & vName & ". Path may be invalid."
        exit sub
    end If

    " commit changes
    vDir.SetInfo
    If （Err <> 0） Then
        Display "Unable to save changes for " & vRoot.Name & "/" & vName & "."
        exit sub
    end if

    " report all ok
    WScript.Echo Now & " " & vName & " virtual directory " & vRoot.Name & "/" & vname & " created successfully."
End Sub

"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
" Finds the specified web.
"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Function findWeb（computer, webname）
    On Error Resume Next

    Dim websvc, site
    dim webinfo
    Dim aBinding, binding

    set websvc = GetObject（"IIS://"&computer&"/W3svc"）
    if （Err <> 0） then
        exit function
    end if
    " First try to open the webname.
    set site = websvc.GetObject（"IIsWebServer", webname）
    if （Err = 0） and （not isNull（site）） then
        if （site.class = "IIsWebServer"） then
            " Here we found a site that is a web server.
            set findWeb = site
            exit function
        end if
    end if
    err.clear
    for each site in websvc
        if site.class = "IIsWebServer" then
            "
            " First, check to see if the ServerComment
            " matches
            "
            If site.ServerComment = webname Then
                set findWeb = site
                exit function
            End If
            aBinding=site.ServerBindings
            if （IsArray（aBinding）） then
                if aBinding（0） = "" then
                    binding = Null
                else
                    binding = getBinding（aBinding（0））
                end if
            else
                if aBinding = "" then
                    binding = Null
                else
                    binding = getBinding（aBinding）
                end if
            end if
            if IsArray（binding） then
                if （binding（2） = webname） or （binding（0） = webname） then
                    set findWeb = site
                    exit function
                End If
            end if
        end if
    next
End Function

"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
" Gets binding info.
"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
function getBinding（bindstr）

    Dim one, two, ia, ip, hn

    one=Instr（bindstr,":"）
    two=Instr（（one+1）,bindstr,":"）

    ia=Mid（bindstr,1,（one-1））
    ip=Mid（bindstr,（one+1）,（（two-one）-1））
    hn=Mid（bindstr,（two+1））

    getBinding=Array（ia,ip,hn）
end function

"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
" Displays error message.
"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Sub Display（Msg）
    WScript.Echo Now & ". Error Code: " & Hex（Err） & " - " & Msg
End Sub

"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
" Display progress/trace message.
"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Sub Trace（Msg）
    WScript.Echo Now & " : " & Msg
End Sub

"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
" Remove the web.
"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Sub DeleteWeb（WebServer, WebName）
    " delete the exsiting web （ignore error if missing）
    On Error Resume Next
    Dim vDir
    display "deleting " & WebName

    WebServer.Delete "IISWebVirtualDir",WebName
    WebServer.SetInfo
    If Err=0 Then
        DISPLAY "WEB " & WebName & " deleted."
    else
        display "can"t find " & webname
    End If

End Sub