IIS WarmUp Part II

IIS WarmUp Part II

IIS WarmUp Part II

I explained in my earlier post the importance of “warming up” your sites in IIS, especially using the latest .Net frameworks.

Here is a major update to the code posted in that post.

This one will allow you to “warm up” every site in IIS on your server. All you have to do is set the version of IIS to 7 or 6 depending on your install, and then run the program. You could also set the allApplications flag to false and put in the selected sites to “warm up”. Please understand, because of the access needed to warm up all of your sites, this program needs to run under an Administrator account. (it accesses IIS’s metabase files)

So, without too much blab, and without any further ado… here’s the code, and the installer will be at the bottom of the post.

Settings.xml

<Settings>
  <Config>
    <!-- Set your IIS version, and whether or no you want to "warm up" all sites -->
    <IIS version="7" allApplications="True">
      <!-- This is a list of sites to warm up, only comes into play if you have the allApplications flag set to false -->
      <Site url="http://www.o7thwebdesign.com" page="/" />
      <Site url="http://www.facchinifacchinipa.com" page="/" />
      <Site url="http://skor.in" page="/" />
      <Site url="http://o7t.in" page="/" />
    </IIS>
  </Config>
</Settings>

AuditManager.vb

Public Class AuditManager

    'The type of audit to write out
    Public Enum AuditType
        Exception
        General
    End Enum

    'Write the audit to the log file
    Public Shared Sub Write(ByVal _Type As AuditType?, ByVal _Description As String, Optional ByVal _Location As String = Nothing, Optional ByVal _Except As Exception = Nothing)
        Dim _Stack As System.Diagnostics.StackTrace
        If _Except IsNot Nothing Then
            _Stack = New System.Diagnostics.StackTrace(_Except, True)
        Else
            _Stack = Nothing
        End If
        Using _F As New IO.StreamWriter(Common.GetPath() & FormatDateTime(Date.Now, DateFormat.ShortDate).Replace("/", String.Empty) & ".LOG", True)
            Dim tmpString As New Text.StringBuilder
            tmpString.Append("-------------------------------------------------" & vbCrLf)
            tmpString.Append("WHEN:" & vbCrLf)
            tmpString.Append(Date.Now & vbCrLf)
            If _Type.HasValue Then
                tmpString.Append("-------------------------------------------------" & vbCrLf)
                tmpString.Append("TYPE:" & vbCrLf)
                tmpString.Append([Enum].GetName(GetType(AuditType), _Type) & vbCrLf)
            End If
            If _Location IsNot Nothing Then
                tmpString.Append("-------------------------------------------------" & vbCrLf)
                tmpString.Append("LOCATION:" & vbCrLf)
                tmpString.Append(_Location & vbCrLf)
            End If
            tmpString.Append("-------------------------------------------------" & vbCrLf)
            If _Stack IsNot Nothing Then
                tmpString.Append("STACKTRACE:" & vbCrLf)
                tmpString.Append(_Stack.ToString() & vbCrLf)
                tmpString.Append("-------------------------------------------------" & vbCrLf)
                tmpString.Append("STACK FRAMES:" & vbCrLf)
                For Each frame In _Stack.GetFrames()
                    tmpString.Append(" - FILE:" & frame.GetFileName() & vbCrLf)
                    tmpString.Append(" - METHOD:" & frame.GetMethod().Name & vbCrLf)
                    tmpString.Append(" - LINE:" & frame.GetFileLineNumber() & vbCrLf)
                    tmpString.Append(" - COLUMN:" & frame.GetFileColumnNumber() & vbCrLf)
                Next
            End If
            If _Except IsNot Nothing Then
                tmpString.Append("-------------------------------------------------" & vbCrLf)
                tmpString.Append("SOURCE:" & vbCrLf)
                tmpString.Append(_Except.Source & vbCrLf)
                tmpString.Append("-------------------------------------------------" & vbCrLf)
                tmpString.Append("MESSAGE:" & vbCrLf)
                tmpString.Append(_Except.Message & vbCrLf)
                tmpString.Append("-------------------------------------------------" & vbCrLf)
                tmpString.Append("DATA:" & vbCrLf)
                tmpString.Append(_Except.Data.ToString() & vbCrLf)
            End If
            tmpString.Append("-------------------------------------------------" & vbCrLf)
            tmpString.Append("NOTES:" & vbCrLf)
            tmpString.Append(_Description & vbCrLf)
            tmpString.Append("-------------------------------------------------" & vbCrLf)
            _F.Write(tmpString.ToString())
            _F.Close()
        End Using
    End Sub

End Class

Common.vb

Public Class Common

    'The applications path
    Public Shared Function GetPath() As String
        Return System.AppDomain.CurrentDomain.BaseDirectory()
    End Function

    'Check to see if a value is Null, if so, set it to equal a default value
    Public Shared Function IsNull(Of T)(ByVal Value As T, ByVal _Default As T) As T
        If Not (IsDBNull(Value)) OrElse Value IsNot Nothing OrElse Not (Value.ToString.Length > 0) Then
            Return DirectCast(Value, T)
        Else
            Return DirectCast(_Default, T)
        End If
    End Function

End Class

CustomCache.vb

Imports System.Runtime.Caching

''' <summary>
''' Our Provider
''' </summary>
''' <remarks></remarks>
Public Interface ICacheProvider
    Function GetItem(Of T)(ByVal key As String) As T
    Sub SetItem(ByVal data As Object, ByVal key As String)
    Sub Remove(ByVal key As String)
    Sub Clear()
End Interface

''' <summary>
''' Our Custom Caching Object
''' </summary>
''' <remarks></remarks>
Public Class CustomCache
    Implements ICacheProvider

    ''' <summary>
    ''' The Cache Object
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private ReadOnly Property Cache() As ObjectCache
        Get
            Return MemoryCache.Default
        End Get
    End Property

    ''' <summary>
    ''' Set the cache Item
    ''' </summary>
    ''' <param name="key"></param>
    ''' <param name="data"></param>
    ''' <remarks></remarks>
    Public Sub SetCacheItem(ByVal data As Object, ByVal key As String) Implements ICacheProvider.SetItem
        Dim policy As New CacheItemPolicy()
        policy.AbsoluteExpiration = DateTime.Now.AddHours(24)
        Cache.Add(New CacheItem(key, data), policy)
    End Sub

    ''' <summary>
    ''' Get the Cache Item
    ''' </summary>
    ''' <typeparam name="T"></typeparam>
    ''' <param name="key"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function GetCacheItem(Of T)(ByVal key As String) As T Implements ICacheProvider.GetItem
        Return DirectCast(Cache(key), T)
    End Function

    ''' <summary>
    ''' Remove the Item from Cache
    ''' </summary>
    ''' <param name="key"></param>
    ''' <remarks></remarks>
    Public Sub RemoveItem(ByVal key As String) Implements ICacheProvider.Remove
        Cache.Remove(key)
    End Sub

    ''' <summary>
    ''' Remove All items from Cache
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub ClearCache() Implements ICacheProvider.Clear
        For Each item In Cache
            Cache.Remove(item.Key)
        Next
    End Sub

End Class

Settings.vb

Public Class Settings

    Private Shared Cache As New CustomCache

    'Grab our settings file
    Private Shared ReadOnly Property SettingDoc As XDocument
        Get
            Dim _C As XDocument = Cache.GetCacheItem(Of XDocument)("Settings")
            If _C IsNot Nothing Then
                Return _C
            Else
                Return XDocument.Load(Common.GetPath() & "Settings.xml")
            End If
        End Get
    End Property

    'Get and set all our settings
    Public Shared Function GetSettings() As List(Of Typing.Settings.Settings)
        Dim _Qry As New List(Of Typing.Settings.Settings)
        _Qry = (From n In SettingDoc...<IIS>.AsParallel()
                Select New Typing.Settings.Settings() With {
                    .IisVersion = Common.IsNull(Of Integer)(n.@version, 0),
                    .PrimeAll = Common.IsNull(Of Boolean)(n.@allApplications, True),
                    .Sites = Common.IsNull(Of List(Of Typing.Settings.Sites))((From s In n.<Site>.AsParallel()
                                                                     Select New Typing.Settings.Sites() With {
                                                                         .Url = s.@url,
                                                                         .Page = s.@page
                                                                     }).ToList(), Nothing)
                }).ToList()
        If _Qry IsNot Nothing Then
            Return _Qry
        Else
            Return Nothing
        End If
        _Qry.Clear()
    End Function

End Class

Typing.vb

'Strongly Type all our values
Public Class Typing

    Partial Public Class Settings

        Partial Public Class Settings
            Public Property IisVersion As Integer
            Public Property PrimeAll As Boolean
            Public Property Sites As List(Of Sites)
        End Class

        Partial Public Class Sites
            Public Property Url As String
            Public Property Page As String
        End Class

    End Class

    Partial Public Class MetaBase
        Public Property Protocol As String
        Public Property Binding As String
    End Class

End Class

WarmUpService.vb

Imports System.Threading.Tasks
Imports System.Security.Principal

Module WarmUpService

    'Check and make sure we have Admin Privelages
    Private ReadOnly Property HasAdminPrivelages()
        Get
            Dim _Id = WindowsIdentity.GetCurrent()
            Dim _Prin = New WindowsPrincipal(_Id)
            Return _Prin.IsInRole(WindowsBuiltInRole.Administrator)
        End Get
    End Property

    'Fire It Up!
    Public Sub Main()
        If HasAdminPrivelages() Then
            AuditManager.Write(AuditManager.AuditType.General, "Fireing Up...")
            DoTheWarmUp()
            AuditManager.Write(AuditManager.AuditType.General, "All Set...")
        Else
            MsgBox("You need to be an administrator in order to run this.")
        End If
    End Sub

    Private Sub DoTheWarmUp()
        Try
            Dim _Set As List(Of Typing.Settings.Settings) = Settings.GetSettings()
            If _Set IsNot Nothing Then
                If _Set(0).PrimeAll Then
                    Select Case _Set(0).IisVersion
                        Case 6 ' IIS 6
                            Dim _PT As New Iis6Primer()
                            _PT.PrimeThem()
                        Case 7 ' IIS 7 & IIS 7.5
                            Dim _PT As New Iis7Primer()
                            _PT.PrimeThem()
                        Case Else
                            AuditManager.Write(AuditManager.AuditType.Exception, "There was an issue! Unsupported IIS version.", "DoTheWarmUp")
                    End Select
                Else
                    Dim _Sites As List(Of Typing.Settings.Sites) = _Set.Item(0).Sites
                    If _Sites IsNot Nothing Then
                        Parallel.ForEach(_Sites, Sub(Item)
                                                     Primer.GrabEm(Item.Url & Item.Page)
                                                 End Sub)
                        _Sites.Clear()
                    End If
                    _Set.Clear()
                End If
            Else
                AuditManager.Write(AuditManager.AuditType.Exception, "There was an issue! There are no settings.", "DoTheWarmUp")
            End If
        Catch ex As Exception
            AuditManager.Write(AuditManager.AuditType.Exception, "There was an issue!", "DoTheWarmUp", ex)
        End Try
    End Sub

End Module

Primer.vb

Imports System.Net
Imports System.Reflection

Public Class Primer

    Public Shared Sub GrabEm(ByVal _SitePath As String)
        Try
            SetAllowUnsafeHeaderParsing20()
            Using _WC As New WebClient()
                _WC.Headers.Add("user-agent", "Mozilla/5.0 (Windows; U; Windows NT 6.1; en-US; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13")
                _WC.DownloadData(_SitePath)
            End Using
            AuditManager.Write(AuditManager.AuditType.General, "Site: " & _SitePath & " Is Now Primed!")
        Catch ex As Exception
            AuditManager.Write(AuditManager.AuditType.Exception, "Issue with the site: " & _SitePath & ".", "GrabEm", ex)
        End Try
    End Sub

    Private Shared Sub SetAllowUnsafeHeaderParsing20()
        Dim a As New System.Net.Configuration.SettingsSection
        Dim aNetAssembly As System.Reflection.Assembly = Assembly.GetAssembly(a.GetType)
        Dim aSettingsType As Type = aNetAssembly.GetType("System.Net.Configuration.SettingsSectionInternal")
        Dim args As Object() = Nothing
        Dim anInstance As Object = aSettingsType.InvokeMember("Section", BindingFlags.Static Or BindingFlags.GetProperty Or BindingFlags.NonPublic, Nothing, Nothing, args)
        Dim aUseUnsafeHeaderParsing As FieldInfo = aSettingsType.GetField("useUnsafeHeaderParsing", BindingFlags.NonPublic Or BindingFlags.Instance)
        aUseUnsafeHeaderParsing.SetValue(anInstance, True)
    End Sub

End Class

Iis6Primer.vb

Imports <xmlns="urn:microsoft-catalog:XML_Metabase_V64_0">
Imports System.Threading.Tasks

Public Class Iis6Primer

    Private _Xml As XDocument
    Dim _Qry As New List(Of Typing.MetaBase)

    Public Sub New()
        Dim _MetaBasePath As String = Environment.GetFolderPath(Environment.SpecialFolder.System) & "inetsrv"
        _MetaBasePath += "metabase.xml"
        _Xml = XDocument.Load(_MetaBasePath, LoadOptions.PreserveWhitespace)
        _Qry = (From n In _Xml...<IIsWebServer>
                Where (n.@ServerBindings IsNot Nothing)
                    Select New Typing.MetaBase() With {
                        .Binding = Common.IsNull(Of String)(n.@ServerBindings, String.Empty)
                    }).ToList()
    End Sub

    Public Sub PrimeThem()
        Dim _Binding, _Url, _T
        Parallel.ForEach(_Qry, Sub(Item)
                                   _Binding = Item.Binding
                                   If _Binding.Contains(" ") Then
                                       _Binding = _Binding.Replace("    ", "|")
                                       _T = _Binding.Split("|")
                                       For Each i In _T
                                           _Url = i.Split(":")
                                           If _Url(1).Contains("80") Then
                                               Primer.GrabEm("http://" & _Url(_Url.GetUpperBound(0)))
                                           End If
                                       Next
                                   Else
                                       _Url = _Binding.Split(":")
                                       If _Url(1).Contains("80") Then
                                           Primer.GrabEm("http://" & _Url(_Url.GetUpperBound(0)))
                                       End If
                                   End If
                               End Sub)
        _Qry.Clear()
    End Sub

End Class

Iis7Primer.vb

Imports System.Threading.Tasks

Public Class Iis7Primer

    Private _Xml As XDocument
    Dim _Qry As New List(Of Typing.MetaBase)

    Public Sub New()
        Dim _MetaBasePath As String = Environment.GetFolderPath(Environment.SpecialFolder.System) & "inetsrv"
        _MetaBasePath += "configapplicationHost.config"
        _Xml = XDocument.Load(_MetaBasePath, LoadOptions.PreserveWhitespace)
        _Qry = (From n In _Xml...<binding>.AsParallel()
                    Select New Typing.MetaBase() With {
                        .Binding = Common.IsNull(Of String)(n.@bindingInformation, String.Empty),
                        .Protocol = Common.IsNull(Of String)(n.@protocol, String.Empty)
                    }).ToList()
    End Sub

    Public Sub PrimeThem()
        Dim _Prot, _Binding, _Url
        Parallel.ForEach(_Qry, Sub(i)
                                   _Prot = i.Protocol
                                   If _Prot = "http" Then
                                       _Binding = i.Binding
                                       _Url = _Binding.Split(":")
                                       Primer.GrabEm("http://" & _Url(_Url.GetUpperBound(0)))
                                   End If
                               End Sub)
        _Qry.Clear()
    End Sub

End Class

Download The Installer: IIS6 & IIS7 WarmUp Service Installer

Categories


Let Us Help

Get You Online

Contact Us Today

Important Cookie Information
Our website uses cookies. By continuing to browse the site you are agreeing to our use of cookies. For more details about cookies and their use, please see our Cookie Policy.