欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

CreateWeb.vbs 代码

程序员文章站 2022-07-04 20:28:31
'============================================================================== ' '&nb...
'==============================================================================
'
'  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