Createweb.vbs Code _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 the 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 (the 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" 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 is 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

' 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
' I 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 are found a site 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
'
' A, check to ' 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