'============================================================================== ' ' 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"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 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)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 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
