Reference

In vbscript regular expression, you can use "SubMatches" collection to get the string you want to use. Before I found this, I had to get "Matches(0).Value" and replace unnecessary strings to empty string.

WScript.Echo FSO.FolderExists("C:\temp\")
Set Matches = regex.Execute(configLine)
WScript.Echo Matches(0).SubMatches(1)

The script parses website xml and does necessary actions. So, it uses regular expression heavily to parse the xml and get the right information. It has the following 5 operations

  • Get Site identifier from metabase xml file
  • Delete the site using identifier
  • Create all virtual directories if not exist
  • Install application pools and web site. This imports the xml.
  • Install SSL Certificate

This is the code
[sourcecode language="vb"]
Dim fso, iisSiteId, webConfigPath
Set fso = CreateObject("Scripting.FileSystemObject")
webConfigPath = "..\IISSettings\Website.config"

iisSiteId = GetIisSiteIdentifier() ' Read site identifier from xml file
If iisSiteId > 0 Then
DeleteWebsite iisSiteId ' Delete the existing web site
End If

CreateVirtualDirectories(webConfigPath) ' Create virtual directories

Call InstallAppPoolsWebSite ' Install application pools and web site
InstallSSLCertificate iisSiteId ' Install certificate

Sub CreateVirtualDirectories(path)
'On Error Resume Next

Dim fl, strm, strLine, regex, Matches, fldPath
Set fl = FSO.GetFile(path)
Set strm = fl.OpenAsTextStream(1, -2)
Set regex = New RegExp
regex.Pattern = "(^\s*Path="")(.+)(""\s*$)"

WScript.Echo "Creating virtual directories ..."
Do Until strm.AtEndOfStream
strLine = strm.ReadLine
If regex.Test(strLine) = True Then
Set Matches = regex.Execute(strLine)
fldPath = Matches(0).SubMatches(1)
If fso.FolderExists(fldPath) = False Then
WScript.Echo fldPath
CreateFolderRecursive(fldPath)
End If
End If
Loop
End Sub

Function CreateFolderRecursive(path)
CreateFolderRecursive = False
If Not fso.FolderExists(path) Then
If CreateFolderRecursive(fso.GetParentFolderName(path)) Then
CreateFolderRecursive = True
Call fso.CreateFolder(path)
End If
Else
CreateFolderRecursive = True
End If
End Function

Sub InstallAppPoolsWebSite()
'If DefaultAppPoolPresent = False Then
'If DefaultAppPoolPresent("DefaultAppPool") = False Then
' Import fso.GetFile("..\IISSettings\DefaultAppPool.config")
'End If
WScript.Echo "Installing Application Pools and Website"

Dim flder, fls, fl
Set flder = fso.GetFolder("..\IISSettings\")
Set fls = flder.Files
For Each fl in fls
If InStr(fl.name, ".config") > 0 Then
Import fso.GetFile(fl.Path)
End If
Next
End Sub

Sub InstallSSLCertificate (siteIdentifier)
WScript.Echo "Installing SSL Certificate... to W3SVC/" & iisSiteId

Dim iisCertObj
Set iisCertObj = CreateObject("IIS.CertObj")
iisCertObj.InstanceName = "W3SVC/" & siteIdentifier
iisCertObj.Import "..\IISSettings\site_cert.pfx", "1234567", true, true
End Sub

''''''''''''''''''''''''''''''''''''''''''
' Find site identifier from settings xml '
''''''''''''''''''''''''''''''''''''''''''
Function GetIisSiteIdentifier()
Dim SiteIdRegex, Matches
Set SiteIdRegex = New RegExp
SiteIdRegex.Pattern = "(""\/LM\/W3SVC\/)([0-9]+)("")"

Dim fl, strm, strXml
Set fl = fso.GetFile("..\IISSettings\Website.config")
Set strm = fl.OpenAsTextStream(1, -2)
Do
strXml = strm.ReadLine
Loop Until SiteIdRegex.Test(strXml) = True

Set Matches = SiteIdRegex.Execute(strXml)
GetIisSiteIdentifier = Matches(0).SubMatches(1)
End Function

''''''''''''''''''''''''''''''''
' Impoart App pool and website '
''''''''''''''''''''''''''''''''
Sub Import(objFile)
Const IMPORT_EXPORT_MERGE = 4
Dim strPassword, IIsComputer, filePath, strXML
Set IIsComputer = GetObject("winmgmts:{impersonationLevel=impersonate,authenticationLevel=pktPrivacy}!//localhost/root/MicrosoftIISv2:IIsComputer='LM'")
strPassword = ""
filePath = objFile.Path

Set stream = objFile.OpenAsTextStream(1, -2)

Do
strXML = stream.ReadLine
Loop Until InStr(strXML, "<> 0 Or InStr(strXML, "<> 0

intFirst = InStr(1, strXML, """")
strSourceMetabasePath = Mid(strXML, intFirst + 1, InStr(intFirst + 1, strXML, """") - intFirst - 1)
strDestinationMetabasePath = strSourceMetabasePath
WScript.Echo "Meta: " & strSourceMetabasePath
intFlags = IMPORT_EXPORT_MERGE
WScript.Echo "Importing: " & filePath & " " & strSourceMetabasePath
IIsComputer.Import strPassword, filePath, strSourceMetabasePath, strDestinationMetabasePath, intFlags

Start strSourceMetabasePath
End Sub

Sub Start(strWebServer)
On Error Resume Next
Set IIsWebServer = GetObject("winmgmts:{impersonationLevel=impersonate,authenticationLevel=pktPrivacy}!//localhost/root/MicrosoftIISv2:IIsWebServer='" & Mid(strWebServer, 5) & "'")
IIsWebServer.Start
End Sub

''''''''''''''''''''''''''''''''''''''''''''''
' Check if DefaultApplicationPool is present '
''''''''''''''''''''''''''''''''''''''''''''''
'Function DefaultAppPoolPresent
Function DefaultAppPoolPresent(poolName)
Dim appPools, appPool
Set appPools = GetObject("IIS://localhost/W3SVC/AppPools")

DefaultAppPoolPresent = False
for each appPool in appPools
if (appPool.Name = poolName) Then
DefaultAppPoolPresent = True
End If
next
End Function

''''''''''''''''''''''''''''''''
' Delete the existing website '
''''''''''''''''''''''''''''''''
Sub DeleteWebsite(identifier)
On Error Resume Next
Dim website
Set website = Nothing
Set website = GetObject("IIS://LocalHost/W3SVC/" & identifier)

If website Is Nothing Then
WScript.Echo "Cannot find the existing website: " & identifier
Else
Set websiteParent = GetObject(website.Parent)
WScript.Echo "Deleting: " & website.Class & " " & website.Name
websiteParent.Delete website.Class, website.Name
End If
End Sub
[/sourcecode]


Andrew Chaa

another day, another PR