Install website in IIS using vbscript


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

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
            End If
        End If
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
        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(, ".config") > 0 Then
            Import fso.GetFile(fl.Path)
        End If
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)
        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)

       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
    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) & "'")
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
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
        Set websiteParent = GetObject(website.Parent)
        WScript.Echo "Deleting: " & website.Class & " " & website.Name
        websiteParent.Delete website.Class, website.Name
    End If
End Sub