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