Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Scripting IIS / ADSI with VBScript help needed!

Status
Not open for further replies.

mst3k

IS-IT--Management
Apr 29, 2002
41
US
1st: when it comes to vbscript on a scale of 1 to 10, I am about 1.5 :)

I use these scripts to add websites and virtual ftp sites to IIS. With a batch file (that I actually wrote :) and it works fine, but there are a few things that I'd like to have someone help me streamline:

- allow 'scripts' on the website
- allow 'write' on the virtual ftp
- set the user account to not expire (not too concerned about that)
- suppress the 'accessing ftp' dialog popup
- suppress the 'done' dialog popup

(apologies for the length of this, as the scripts tend to get freaking huge)

*************
batch file
*************

@echo off
echo Company Name = %1
echo .
echo Site Name = %2
echo .
echo username = %3
echo .
echo password = %4
echo .
echo Are these all Correct?
echo .
echo If incorrect, press Ctrl-C NOW
pause
md d:\md d:\c:\winnt\makewebsite.vbs -r d:\ -h -i x.x.x.x -t %2
c:\winnt\mkftpdir -c x.x.x.x -f ""virtuals"" -v ""%3"",""d:\net user %3 %4 /add
echo y| cacls d:\ /T /G system:F administrators:F everyone:R %3:F

****************
MakeWebsite.vbs
****************

'------------------------------------------------------------------------------------------------
'
' This is a simple script to create a new virtual web server.
'
' Usage: MakeWebSite <--RootDirectory|-r ROOT DIRECTORY>
' <--Comment|-t SERVER COMMENT>
' [--computer|-c COMPUTER1[,COMPUTER2...]]
' [--HostName|-h HOST NAME[,HOSTNAME2...]]
' [--port|-o PORT NUM]
' [--IPAddress|-i IP ADDRESS]
' [--SiteNumber|-n SITENUMBER]
' [--DontStart]
' [--verbose|-v]
' [--URL Redirectionpath]
' [--URLExact]
' [--URLChildOnly]
' [--URLPermanent]
' [--help|-?]
'
' IP ADDRESS The IP Address 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 is set up find the server.
' PORT NUM The port to which the server should bind
' ROOT DIRECTORY Full path to the root directory for the new server.
' SERVER COMMENT The server comment -- this is the name that appers in the MMC.
' SITENUMBER The Site Number is the number in the path that the web server
' will be created at. i.e. w3svc/3
'
' Example 1: MakeWebSite.vbs -r D:\Roots\Company11 --DontStart -t &quot;My Company Site&quot;
' Example 2: MakeWebSite.vbs -r C:\Inetpub\ -t Test -o 8080
'
'
' Modified by chris crowe - to support multiple host headers and URL Redirection
'------------------------------------------------------------------------------------------------


' 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

' Chris Crowe - iisfaq.com
Dim ArgURL, ArgURLExact, ArgURLChildOnly, ArgURLPermanent

ArgIPAddress = &quot;&quot;
ArgHostName = &quot;&quot;
ArgPort = 80
ArgStart = True
ArgComputers = Array(1)
ArgComputers(0) = &quot;LocalHost&quot;
ArgSiteNumber = 0
verbose = false

' Chris Crowe - iisfaq.com
ArgURL = &quot;&quot;
ArgURLChildonly = false
ArgURLExact = false
ArgURLPermanent = false

Set oArgs = WScript.Arguments
ArgNum = 0

While ArgNum < oArgs.Count

Select Case LCase(oArgs(ArgNum))
Case &quot;--port&quot;,&quot;-o&quot;:
ArgNum = ArgNum + 1
ArgPort = oArgs(ArgNum)
Case &quot;--ipaddress&quot;,&quot;-i&quot;:
ArgNum = ArgNum + 1
ArgIPAddress = oArgs(ArgNum)
Case &quot;--rootdirectory&quot;,&quot;-r&quot;:
ArgNum = ArgNum + 1
ArgRootDirectory = oArgs(ArgNum)
Case &quot;--comment&quot;,&quot;-t&quot;:
ArgNum = ArgNum + 1
ArgServerComment = oArgs(ArgNum)
Case &quot;--hostname&quot;,&quot;-h&quot;:
ArgNum = ArgNum + 1
ArgHostName = oArgs(ArgNum)
Case &quot;--computer&quot;,&quot;-c&quot;:
ArgNum = ArgNum + 1
ArgComputers = Split(oArgs(ArgNum), &quot;,&quot;, -1)
Case &quot;--sitenumber&quot;,&quot;-n&quot;:
ArgNum = ArgNum + 1
ArgSiteNumber = CLng(oArgs(ArgNum))

' Chris Crowe - iisfaq.com
Case &quot;--url&quot;,&quot;-u&quot;:
ArgNum = ArgNum + 1
ArgURL = oArgs(ArgNum)
Case &quot;--urlexact&quot;
ArgURLEXACT = true
Case &quot;--urlchildonly&quot;
ArgURLChildOnly = true
Case &quot;--urlpermanent&quot;
ArgURLPERMANENT = true


Case &quot;--dontstart&quot;:
ArgStart = False
Case &quot;--help&quot;,&quot;-?&quot;:
Call DisplayUsage
Case &quot;--verbose&quot;, &quot;-v&quot;:
verbose = true
Case Else:
WScript.Echo &quot;Unknown argument &quot;& oArgs(ArgNum)
Call DisplayUsage
End Select

ArgNum = ArgNum + 1
Wend

' Chris Crowe - iisfaq.com
If (ArgRootDirectory = &quot;&quot;) Then
WScript.Echo &quot;Missing Root Directory (Required even with URL redirection path)&quot;
WScript.Echo &quot;&quot;
Call DisplayUsage
WScript.Quit(1)
End If

' Check if the root directory exists
'Set FSO = WScript.CreateObject(&quot;Scripting.fileSystemObject&quot;)
' if (FSO.FolderExists(ArgRootDirectory) = False) then
' WScript.echo &quot;The specified root directory does not exist : &quot; & ArgRootDirectory
' WScript.Quit(2)
' end if
'Set FSO = Nothing

If (ArgServerComment = &quot;&quot;) Then
WScript.Echo &quot;Missing Server Comment&quot;
WScript.Echo &quot;&quot;
Call DisplayUsage
WScript.Quit(1)
End If
' end - chris Crowe - iisfaq.com

' chris Crowe - iisfaq.com
Call ASTCreateWebSite(ArgIPAddress, ArgRootDirectory, ArgURL, ArgURLEXACT, ArgURLCHILDONLY, ArgURLPERMANENT, ArgServerComment, ArgHostName, ArgPort, ArgComputers, ArgStart)

' chris Crowe - iisfaq.com
Sub ASTCreateWebSite(IPAddress, RootDirectory, URL, ArgURLEXACT, ArgURLCHILDONLY, ArgURLPERMANENT, ServerComment, HostName, PortNum, Computers, Start)
Dim w3svc, WebServer, NewWebServer, NewDir, Bindings, BindingString, NewBindings, ComputerIndex, Index, SiteObj, bDone
Dim comp, BindingIndex, HostNameINdex, HostNames

'Chris Crowe - Dim URLOPTIONS


On Error Resume Next

hostNames = Split(HostName,&quot;,&quot;)
For ComputerIndex = 0 To UBound(Computers)
comp = Computers(ComputerIndex)
If ComputerIndex <> UBound(Computers) Then
Trace &quot;Creating web site on &quot; & comp & &quot;.&quot;
End If

' Grab the web service object
Err.Clear
Set w3svc = GetObject(&quot;IIS://&quot; & comp & &quot;/w3svc&quot;)
If Err.Number <> 0 Then
Display &quot;Unable to open: &quot;&&quot;IIS://&quot; & comp & &quot;/w3svc&quot;
End If

Trace &quot;Making sure this web server doesn't conflict with another...&quot;
For Each WebServer in w3svc
If WebServer.Class = &quot;IIsWebServer&quot; Then
Bindings = WebServer.ServerBindings

For HostNameINdex = 0 To UBound(HostNames)
for BindingIndex = 0 to Ubound(Bindings)
BindingString = IpAddress & &quot;:&quot; & PortNum & &quot;:&quot; & HostNames(HostNameINdex)
If (BindingString = bindings(BindingIndex)) Then
Trace &quot;The server bindings you specified are duplicated in another virtual web server.&quot;
Trace &quot;The Web Server name is [&quot; & WebServer.ServerComment & &quot;], Instance ID [&quot; & WebServer.name & &quot;]&quot;
Trace &quot;The Conflicting Bindings are at index [&quot; & bindingIndex & &quot;], [&quot; & bindings(BindingIndex) & &quot;]&quot;
WScript.Quit (1)
End If
next
next
End If
Next

Index = 1
bDone = False
Trace &quot;Creating new web server...&quot;

' If the user specified a SiteNumber, then use that. Otherwise,
' test successive numbers under w3svc until an unoccupied slot is found
If ArgSiteNumber <> 0 Then
Set NewWebServer = w3svc.Create(&quot;IIsWebServer&quot;, ArgSiteNumber)
NewWebServer.SetInfo
If (Err.Number <> 0) Then
WScript.Echo &quot;Couldn't create a web site with the specified number: &quot; & ArgSiteNumber
WScript.Quit (1)
Else
Err.Clear
' Verify that the newly created site can be retrieved
Set SiteObj = GetObject(&quot;IIS://&quot;&comp&&quot;/w3svc/&quot; & ArgSiteNumber)
If (Err.Number = 0) Then
bDone = True
Trace &quot;Web server created. Path is - &quot;&&quot;IIS://&quot;&comp&&quot;/w3svc/&quot; & ArgSiteNumber
Else
WScript.Echo &quot;Couldn't create a web site with the specified number: &quot; & ArgSiteNumber
WScript.Quit (1)
End If
End If
Else
While (Not bDone)
Err.Clear
Set SiteObj = GetObject(&quot;IIS://&quot;&comp&&quot;/w3svc/&quot; & Index)

If (Err.Number = 0) Then
' A web server is already defined at this position so increment
Index = Index + 1
Else
Err.Clear
Set NewWebServer = w3svc.Create(&quot;IIsWebServer&quot;, 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 the newly created site can be retrieved
Set SiteObj = GetObject(&quot;IIS://&quot;&comp&&quot;/w3svc/&quot; & Index)
If (Err.Number = 0) Then
bDone = True
Trace &quot;Web server created. Path is - &quot;&&quot;IIS://&quot;&comp&&quot;/w3svc/&quot; & Index
Else
Index = Index + 1
End If
End If
End If

' sanity check
If (Index > 10000) Then
Trace &quot;Seem to be unable to create new web server. Server number is &quot;&Index&&quot;.&quot;
WScript.Quit (1)
End If
Wend
End If

redim NewBindings (ubound(HostNames))

For HostNameINdex = 0 To UBound(HostNames)
BindingString = IpAddress & &quot;:&quot; & PortNum & &quot;:&quot; & HostNames(HostNameINdex)
Trace &quot;Binding = &quot; & BindingString
NewBindings(HostNameINdex) = BindingString
next

NewWebServer.ServerBindings = NewBindings
NewWebServer.ServerComment = ServerComment
NewWebServer.SetInfo

' Now create the root directory object.
Trace &quot;Setting the home directory...&quot;
Set NewDir = NewWebServer.Create(&quot;IIsWebVirtualDir&quot;, &quot;ROOT&quot;)
NewDir.Path = RootDirectory
NewDir.AccessRead = true


' Modified by Chris crowe - January 2002
if (URL <> &quot;&quot;) then
trace &quot;Redirection to a URL: &quot; & URL
URLOPTIONS= &quot;&quot;

if (ArgURLEXACT = true) then
URLOPTIONS = &quot;, EXACT_DESTINATION&quot;
end if
if (ArgURLCHILDONLY = true) then
if (URLOPTIONS > &quot;&quot;) then
URLOPTIONS = URLOPTIONS & &quot;, CHILD_ONLY&quot;
else
URLOPTIONS = &quot;, CHILD_ONLY&quot;
end if
end if
if (ArgURLPERMANENT = true) then
if (URLOPTIONS > &quot;&quot;) then
URLOPTIONS = URLOPTIONS & &quot;, PERMANENT&quot;
else
URLOPTIONS = &quot;, PERMANENT&quot;
end if
end if
trace &quot;Redirection Flags : &quot; & URLOPTIONS
newDir.httpredirect= URL & URLOPTIONS
end if
' Modified by Chris crowe - January 2002




Err.Clear
NewDir.SetInfo
NewDir.AppCreate (True)

If (Err.Number = 0) Then
Trace &quot;Home directory set.&quot;
Else
Display &quot;Error setting home directory.&quot;
End If

Trace &quot;Web site created!&quot;

If Start = True Then
Trace &quot;Attempting to start new web server...&quot;
Err.Clear
Set NewWebServer = GetObject(&quot;IIS://&quot; & comp & &quot;/w3svc/&quot; & Index)
NewWebServer.Start
If Err.Number <> 0 Then
Display &quot;Error starting web server!&quot;
Err.Clear
Else
Trace &quot;Web server started succesfully!&quot;
End If
End If
Next
End Sub


' Display the usage message
Sub DisplayUsage
WScript.Echo &quot;Usage: MakeWebSite <--RootDirectory|-r ROOT DIRECTORY>&quot;
WScript.Echo &quot; <--Comment|-t SERVER COMMENT>&quot;
WScript.Echo &quot; [--computer|-c COMPUTER1[,COMPUTER2...]]&quot;
WScript.Echo &quot; [--port|-o PORT NUM]&quot;
WScript.Echo &quot; [--IPAddress|-i IP ADDRESS]&quot;
WScript.Echo &quot; [--HostName|-h HOST NAME[,HOSTNAME2...]]&quot;
WScript.Echo &quot; [--SiteNumber|-n SITENUMBER]&quot;
WScript.Echo &quot; [--URL RedirectionPath]&quot;
WScript.Echo &quot; [--URLExact]&quot;
WScript.Echo &quot; [--URLChildOnly]&quot;
WScript.Echo &quot; [--URLPermanent]&quot;
WScript.Echo &quot; [--DontStart]&quot;
WScript.Echo &quot; [--verbose|-v]&quot;
WScript.Echo &quot; [--help|-?]&quot;
WScript.Echo &quot;&quot;
WScript.Echo &quot;WARNING: Only use Host Name if DNS is set up find the server.&quot;
WScript.Echo &quot;&quot;
WScript.Echo &quot;Example 1: MakeWebSite.vbs -r D:\Roots\Company11 --DontStart -t &quot;&quot;My Company Site&quot;&quot;&quot;
WScript.Echo &quot;Example 2: MakeWebSite.vbs -r D:\Roots\Company11 -h &quot;&quot; --DontStart -t &quot;&quot;My Company Site&quot;&quot;&quot;
WScript.Echo &quot;Example 3: MakeWebSite.vbs -r D:\Roots\Company11 -i 192.168.0.1 -t &quot;&quot;My Company Site&quot;&quot; --URL --URLExact --URLPermanent&quot;
WScript.Echo &quot;&quot;
WScript.Echo &quot;Note: URLRedirection requires a HTTP:// prefix and a root directory also!&quot;
WScript.Echo &quot;&quot;

WScript.Quit (1)
End Sub

Sub Display(Msg)
WScript.Echo Now & &quot;. Error Code: &quot; & Hex(Err) & &quot; - &quot; & Msg
End Sub

Sub Trace(Msg)
if verbose = true then
WScript.Echo Now & &quot; : &quot; & Msg
end if
End Sub


*******************
makeftp.vbs
*******************

'------------------------------------------------------------
'
' This is a simple script to create a new virtual FTP directory.
'
' Call this script with &quot;-?&quot; for usage instructions
'
'------------------------------------------------------------

' Force explicit declaration of all variables.
Option Explicit

On Error Resume Next

Dim oArgs, ArgNum

Dim ArgComputer, ArgFtpSites, ArgVirtualDirs, ArgDirNames(), ArgDirPaths(), DirIndex
Dim ArgComputers

Set oArgs = WScript.Arguments
ArgComputers = Array(&quot;LocalHost&quot;)

ArgNum = 0
While ArgNum < oArgs.Count

If (ArgNum + 1) >= oArgs.Count Then
Call DisplayUsage
End If

Select Case LCase(oArgs(ArgNum))
Case &quot;--computer&quot;, &quot;-c&quot;:
ArgNum = ArgNum + 1
ArgComputers = Split(oArgs(ArgNum), &quot;,&quot;, -1)
Case &quot;--ftpsite&quot;, &quot;-f&quot;:
ArgNum = ArgNum + 1
ArgFtpSites = oArgs(ArgNum)
Case &quot;--virtualdir&quot;, &quot;-v&quot;:
ArgNum = ArgNum + 1
ArgVirtualDirs = Split(oArgs(ArgNum), &quot;,&quot;, -1)
Case &quot;--help&quot;, &quot;-?&quot;
Call DisplayUsage
End Select

ArgNum = ArgNum + 1
Wend

ArgNum = 0
DirIndex = 0

ReDim ArgDirNames((UBound(ArgVirtualDirs) + 1) \ 2)
ReDim ArgDirPaths((UBound(ArgVirtualDirs) + 1) \ 2)

If IsArray(ArgVirtualDirs) Then
While ArgNum <= UBound(ArgVirtualDirs)
ArgDirNames(DirIndex) = ArgVirtualDirs(ArgNum)
If (ArgNum + 1) > UBound(ArgVirtualDirs) Then
WScript.Echo &quot;Error understanding virtual directories&quot;
Call DisplayUsage
End If
ArgNum = ArgNum + 1
ArgDirPaths(DirIndex) = ArgVirtualDirs(ArgNum)
ArgNum = ArgNum + 1
DirIndex = DirIndex + 1
Wend
End If

If (ArgFtpSites = &quot;&quot;) Or (IsArray(ArgDirNames) = False Or IsArray(ArgDirPaths) = False) Then
Call DisplayUsage
Else
Dim compIndex
For compIndex = 0 To UBound(ArgComputers)
Call ASTCreateVirtualFtpDir(ArgComputers(compIndex), ArgFtpSites, ArgDirNames, ArgDirPaths)
Next
End If

'------------------------------------------------------------

Sub Display(Msg)
WScript.Echo Now & &quot;. Error Code: &quot; & Hex(Err) & &quot; - &quot; & Msg
End Sub

Sub Trace(Msg)
WScript.Echo Now & &quot; : &quot; & Msg
End Sub

Sub DisplayUsage()
WScript.Echo &quot;Usage: mkftpdir [--computer|-c COMPUTER1,COMPUTER2]&quot;
WScript.Echo &quot; <--ftpsite|-f FTPSITE1>&quot;
WScript.Echo &quot; <--virtualdir|-v NAME1,PATH1,NAME2,PATH2,...>&quot;
WScript.Echo &quot; [--help|-?]&quot;

WScript.Echo &quot;&quot;
WScript.Echo &quot;Note, FTPSITE is the Ftp Site on which the directory will be created.&quot;
WScript.Echo &quot;The name can be specified as one of the following, in the priority specified:&quot;
WScript.Echo &quot; Server Number (i.e. 1, 2, 10, etc.)&quot;
WScript.Echo &quot; Server Description (i.e &quot;&quot;My Server&quot;&quot;)&quot;
WScript.Echo &quot; Server Host name (i.e. &quot;&quot;ftp.domain.com&quot;&quot;)&quot;
WScript.Echo &quot; IP Address (i.e., 127.0.0.1)&quot;
WScript.Echo &quot;&quot;
WScript.Echo &quot;&quot;
WScript.Echo &quot;Example : mkftpdir -c MyComputer -f &quot;&quot;Default Ftp Site&quot;&quot;&quot;
WScript.Echo &quot; -v &quot;&quot;dir1&quot;&quot;,&quot;&quot;c:\inetpub\ftproot\dir1&quot;&quot;,&quot;&quot;dir2&quot;&quot;,&quot;&quot;c:\inetpub\ftproot\dir2&quot;&quot;&quot;

WScript.Quit
End Sub

'------------------------------------------------------------

Sub ASTCreateVirtualFtpDir(ComputerName, FtpSiteName, DirNames, DirPaths)
Dim computer, ftpSite, FtpSiteID, vRoot, vDir, DirNum
On Error Resume Next

Set ftpSite = findFtp(ComputerName, FtpSiteName)
If IsObject(ftpSite) Then
Set vRoot = ftpSite.GetObject(&quot;IIsFtpVirtualDir&quot;, &quot;Root&quot;)
Trace &quot;Accessing root for &quot; & ftpSite.ADsPath
If (Err <> 0) Then
Display &quot;Unable to access root for &quot; & ftpSite.ADsPath
Else
DirNum = 0
If (IsArray(DirNames) = True) And (IsArray(DirPaths) = True) And (UBound(DirNames) = UBound(DirPaths)) Then
While DirNum < UBound(DirNames)
'Create the new virtual directory
Set vDir = vRoot.Create(&quot;IIsFtpVirtualDir&quot;, DirNames(DirNum))
If (Err <> 0) Then
Display &quot;Unable to create &quot; & vRoot.ADsPath & &quot;/&quot; & DirNames(DirNum) & &quot;.&quot;
Else
'Set the new virtual directory path
vDir.AccessRead = True
vDir.Path = DirPaths(DirNum)
If (Err <> 0) Then
Display &quot;Unable to bind path &quot; & DirPaths(DirNum) & &quot; to &quot; & vRootName & &quot;/&quot; & DirNames(DirNum) & &quot;. Path may be invalid.&quot;
Else
'Save the changes
vDir.SetInfo
If (Err <> 0) Then
Display &quot;Unable to save configuration for &quot; & vRootName & &quot;/&quot; & DirNames(DirNum) & &quot;.&quot;
Else
Trace &quot;Ftp virtual directory &quot; & vRootName & &quot;/&quot; & DirNames(DirNum) & &quot; created successfully.&quot;
End If
End If
End If
Err = 0
DirNum = DirNum + 1
Wend
End If
End If
Else
Display &quot;Unable to find &quot; & FtpSiteName & &quot; on &quot; & ComputerName
End If
Trace &quot;Done.&quot;
End Sub

Function getBinding(bindstr)

Dim one, two, ia, ip, hn

one = InStr(bindstr, &quot;:&quot;)
two = InStr((one + 1), bindstr, &quot;:&quot;)

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

Function findFtp(computer, ftpname)
On Error Resume Next

Dim ftpsvc, site
Dim ftpinfo
Dim aBinding, binding

Set ftpsvc = GetObject(&quot;IIS://&quot; & computer & &quot;/MsFtpSvc&quot;)
If (Err <> 0) Then
Exit Function
End If
' First try to open the ftpname.
Set site = ftpsvc.GetObject(&quot;IIsFtpServer&quot;, ftpname)
If (Err = 0) And (Not IsNull(site)) Then
If (site.Class = &quot;IIsFtpServer&quot;) Then
' Here we found a site that is a ftp server.
Set findFtp = site
Exit Function
End If
End If
Err.Clear
For Each site In ftpsvc
If site.Class = &quot;IIsFtpServer&quot; Then
' First, check to see if the ServerComment matches
If site.ServerComment = ftpname Then
Set findFtp = site
Exit Function
End If
aBinding = site.ServerBindings
If (IsArray(aBinding)) Then
If aBinding(0) = &quot;&quot; Then
binding = Null
Else
binding = getBinding(aBinding(0))
End If
Else
If aBinding = &quot;&quot; Then
binding = Null
Else
binding = getBinding(aBinding)
End If
End If
If IsArray(binding) Then
If (binding(2) = ftpname) Or (binding(0) = ftpname) Then
Set findFtp = site
Exit Function
End If
End If
End If
Next
End Function



Sorry again for the length of this, but if anyone has some insight, please let me know!

Thanks very much
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top