Improved Mkw3site.vbs (Create a virtual directory) _vbs

'---------------------------------------------------------------------------------------------------
' Create virtual directory power by JARON, Jiangdu Information Network, 1999-2002.
' If you need to set permissions, modify the code for 40-56. * * Rewritten according to Microsoft Corp. 's AdminScripts
'
' Usage: mkw3site <--rootdirectory|-r ROOT directory>
' <--comment|-t SERVER comment>
' [--computer|-c computer1[,computer2 ...]]
' [--hostname|-h HOST NAME]
' [--port|-o Port NUM]
' [--ipaddress|-i IP address]
' [--sitenumber|-n Sitenumber]
' [--dontstart]
' [--verbose|-v]
' [--help|-?]
'
' IP address ' IP addresses to assign to the new server. Optional.
' Host name ' the host name of the Web site for HOST headers.
' Warning:only use Host Name if DNS was set up to find the server.
' Port NUM ' port to which the server should bind
' root directory full path to ' the ' new server '.
' Server COMMENT the server COMMENT--This is the name of the appers in the MMC.
' Sitenumberthe Site number is the # in the ' path ' the Web server
' 'll be created at. i.e. W3SVC/3
'
' Example 1:mkw3site-r D:\Roots\Company11--dontstart-t "my company Site"
' Example 2:mkw3site-r C:\Inetpub\wwwroot-t test-o 8080
'------------------------------------------------------------------------------------------------


' Force Explicit declaration of all variables
Option Explicit

On Error Resume Next

Dim argipaddress, Argrootdirectory, Argservercomment, Argskeletaldir, Arghostname, Argport
Dim Argcomputers, Argstart
Dim Argsitenumber
Dim Oargs, Argnum
Dim verbose
' Set writable, script execution permissions
Dim Prop (15,2)
Dim Propnum
Prop (propnum,0) = "AccessRead"
Prop (propnum,1) = True ' readable set to true, unreadable to False
Propnum = propnum + 1
Prop (propnum, 0) = "AccessWrite"
Prop (Propnum, 1) = True ' can be written to true, not writable set to False
Propnum = propnum + 1
Prop (propnum, 0) = "AccessScript"
Prop (Propnum, 1) = True ' can run script file set to True, non-running script file set to False
Propnum = propnum + 1
Prop (propnum, 0) = "AccessExecute"
Prop (Propnum, 1) = False ' run executable file set to True, not run execution file set to False
Propnum = propnum + 1
Prop (propnum, 0) = "enabledirbrowsing"
Prop (Propnum, 1) = True ' allows listing directories to be set to true, not allowing listing of directories to False
Propnum = propnum + 1

Argipaddress = ""
Arghostname = ""
Argport = 80
Argstart = True
Argcomputers = Array (1)
Argcomputers (0) = "LocalHost"
Argsitenumber = 0
Verbose = False

Set Oargs = wscript.arguments
Argnum = 0

While Argnum < Oargs.count

Select Case LCase (Oargs (argnum))
Case "--port", "O":
Argnum = argnum + 1
Argport = Oargs (argnum)
Case "--ipaddress", "I":
Argnum = argnum + 1
argipaddress = Oargs (argnum)
Case "--rootdirectory", "R":
Argnum = argnum + 1
Argrootdirectory = Oargs (argnum)
Case "--comment", "-T":
Argnum = argnum + 1
Argservercomment = Oargs (argnum)
Case "--hostname", "H":
Argnum = argnum + 1
Arghostname = Oargs (argnum)
Case "--computer", "-C":
Argnum = argnum + 1
Argcomputers = Split (Oargs (Argnum), ",",-1)
Case "--sitenumber", "-N":
Argnum = argnum + 1
Argsitenumber = CLng (Oargs (argnum))
Case "--dontstart":
Argstart = False
Case "--help", "-?":
Call Displayusage
Case "--verbose", "-V":
Verbose = True
Case Else:
WScript.Echo "Unknown Argument" & Oargs (Argnum)
Call Displayusage
End Select

Argnum = argnum + 1
Wend

If (argrootdirectory = "") Or (argservercomment = "") Then
if (argrootdirectory = "") Then
WScript.Echo "Missing Root Directory"
Else
WScript.Echo "Missing Server Comment"
End If
Call Displayusage
Wscript.Quit (1)
End If

Call Astcreatewebsite (argipaddress, Argrootdirectory, Argservercomment, Arghostname, Argport, ArgComputers, ArgStart)

Sub Astcreatewebsite (IPAddress, RootDirectory, ServerComment, HostName, Portnum, Computers, Start)
Dim w3svc, WebServer, Newwebserver, Newdir, bindings, bindingstring, Newbindings, Computerindex, Index, Siteobj, BDone
Dim Comp
On Error Resume Next
For computerindex = 0 to UBound (Computers)
comp = Computers (Computerindex)
If computerindex <> UBound (Computers) Then
Trace "Creating Web Site on" & Comp & "."
End If

' Grab the Web service object
Err.Clear
Set w3svc = GetObject ("iis://" & Comp & "/w3svc")
If err.number <> 0 Then
Display "Unable to open:" & "iis://" & Comp & "/w3svc"
End If
bindingstring = IPAddress & ":" & Portnum & ":" & HostName
Trace "Making sure this Web server doesn ' t conflict with another ..."
For each WebServer in W3SVC
If Webserver.class = "IIsWebServer" Then
Bindings = Webserver.serverbindings
If bindingstring = Bindings (0) Then
Trace "The server bindings your specified are duplicated in another virtual Web server."
Wscript.Quit (1)
End If
End If
Next

Index = 1
Bdone = False
Trace "Creating new Web Server ..."

' If the user specified a sitenumber, then use that. Otherwise,
' Test successive numbers under W3SVC until a unoccupied slot is found
If argsitenumber <> 0 Then
Set newwebserver = w3svc. Create ("IIsWebServer", Argsitenumber)
Newwebserver.setinfo
If (err.number <> 0) Then
WScript.Echo "Couldn ' t create a Web site with the specified number:" & Argsitenumber
Wscript.Quit (1)
Else
Err.Clear
' Verify that's newly created site can be retrieved
Set siteobj = GetObject ("iis://" &comp& "/w3svc/" & Argsitenumber)
If (err.number = 0) Then
Bdone = True
Trace Web server created. Path is-"&" iis://&comp& "/w3svc/" & Argsitenumber
Else
WScript.Echo "Couldn ' t create a Web site with the specified number:" & Argsitenumber
Wscript.Quit (1)
End If
End If
Else
while (not bdone)
Err.Clear
Set siteobj = GetObject ("iis://" &comp& "/w3svc/" & Index)

If (err.number = 0) Then
' A Web server is already defined at-position so increment
index = index + 1
Else
Err.Clear
Set newwebserver = w3svc. Create ("IIsWebServer", Index)
Newwebserver.setinfo
If (err.number <> 0) Then
' If call to Create failed then try the next number
index = index + 1
Else
Err.Clear
' Verify that's newly created site can be retrieved
Set siteobj = GetObject ("iis://" &comp& "/w3svc/" & Index)
If (err.number = 0) Then
Bdone = True
Trace Web server created. Path is-"&" iis://"&comp&"/w3svc/"& Index
Else
index = index + 1
End If
End If
End If

' Sanity check
If (Index > 10000) Then
Trace "Seem to is unable to create new Web server." The Server number is "&Index&".
Wscript.Quit (1)
End If
Wend
End If
newbindings = Array (0)
Newbindings (0) = bindingstring
Newwebserver.serverbindings = newbindings
Newwebserver.servercomment = ServerComment
Newwebserver.setinfo

' Now create the ' root directory object.
Trace "Setting The home directory ..."
Set newdir = newwebserver.create ("IIsWebVirtualDir", "ROOT")
Newdir.path = RootDirectory
Newdir.accessread = True
Err.Clear
Newdir.setinfo
Newdir.appcreate (True)

If (err.number = 0) Then
Trace "Home directory set."
Else
Display "Error setting home directory."
End If

Trace "Web site created!"

If Start = True Then
Trace "Attempting to start new Web server ..."
Err.Clear
Set newwebserver = GetObject ("iis://" & Comp & "/w3svc/" & Index)
Newwebserver.start
If err.number <> 0 Then
Display "Error starting web server!"
Err.Clear
Else
Trace "Web Server started succesfully!"
End If
End If
Next
Call Astsetperms (comp, index,argrootdirectory, prop, Propnum)
End Sub

Sub astsetperms (comp, argsitenumber,argrootdirectory, Proplist, Propcount)
' On Error Resume Next
Dim Oadmin
Dim FullPath
FullPath = "iis://" &comp& "/w3svc/" & Argsitenumber & "/root"
Trace "Opening path" & FullPath
Set oadmin = GetObject (FullPath)
If err.number <> 0 Then
Display Error_nonode
Wscript.Quit (1)
End If

Dim Name, Val
If Propcount > 0 Then
Dim I

For i = 0 to PropCount-1
Name = Proplist (i,0)
val = proplist (i,1)
If verbose = True Then
Trace "Setting" &fullPath& "/" &name& "=" & Val
End If
Oadmin.put name, (Val)
If Err <> 0 Then
Display "Unable to set" &name
End If
Next
Oadmin.setinfo
If Err <> 0 Then
Display "Cannot save update information."
End If
End If
End Sub

' Display the usage message
Sub Displayusage
Wscript.Quit (1)
End Sub

Sub Display (MSG)
WScript.Echo Now & ". Error Code: "& Hex (ERR) &"-"& MSG
End Sub

Sub Trace (MSG)
If verbose = True Then
WScript.Echo Now & ":" & MSG
End If
End Sub