CreateWeb.vbs 代码-巨人网络通讯

主页 > 知识库 > CreateWeb.vbs 代码

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

标签：玉林六安漳州嘉兴延安广安周口台湾

巨人网络通讯声明：本文标题《CreateWeb.vbs 代码》，本文关键词 CreateWeb.vbs,代码,CreateWeb.vbs,；如发现本文内容存在版权问题，烦请提供相关信息告之我们，我们将及时沟通与处理。本站内容系统采集于网络，涉及言论、版权与本站无关。