CreateWeb.vbs 代码

165 阅读 0 评论 109 点赞

我是靠谱客的博主端庄爆米花，最近开发中收集的这篇文章主要介绍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