软件开发培训班 >> 编程开发 >> VbScript


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 "cant find " & webname
    End If

End Sub