DarenHan's Blog

# re: IIS app pool can be stopped on its own due to faulty code.

This is a script that will loop thru all the application pools on your IIS 6 server, check the status of them and log the status of them. If a app pool is down it will log the app pool name and the time, restart the app pool and send an email out regarding the down/restarted app pool. You simple need to create a schedule task to run this script as often as you want.

' Variables that need to be defined for the script to work

Const LogDir = "C:\AppPoolLog"

ToAddress = ""

FromAddress = ""

showAppPools 'Runs showAppPools Sub

' This will get the list of all app pools on the server

Sub showAppPools

Dim obj,apool

set obj = GetObject("IIS://localhost/W3SVC/apppools")

for each apool in obj

apppoolStatus apool.name

Next

set obj = nothing

End Sub

' This will get the status of the app pool

Sub apppoolStatus(apppool)

Dim obj

set obj = GetObject("IIS://localhost/W3SVC/apppools/" & apppool)

Select Case obj.apppoolstate

Case 0

writetoLog apppool,"0" 'Do not know what this status is

Case 1

writetoLog apppool,"1" 'Do not know what this status is

Case 2

writetoLog apppool,"Up"

Case 3

writetoLog apppool,"3" 'Do not know what this status is

Case 4

writetoLog apppool,"DOWN"

startapppool apppool

emailSendCDOSYS apppool

writetoLog apppool,"Restarted"

End Select

set obj = nothing

End Sub

' This will write information to a log file

Sub writetoLog(apppool,response)

Dim fso

lday = datepart("d",date)

lmonth = datepart("m",date)

lyear = datepart("yyyy",date)

logdate = lmonth & lday & lyear

set fso = CreateObject ("Scripting.FileSystemObject")

Set objFSOwriteline = FSO.OpenTextFile(LogDir & "\" & logdate & ".log", 8,True)

objFSOwriteline.WriteLine(response & "," & apppool & "," & now())

objFSOwriteline.close

Set objFSOwriteline = nothing

set fso = nothing

End Sub

' This starts the down app pool

Sub startapppool(apppool)

Dim obj

set obj = GetObject("IIS://localhost/W3SVC/apppools/" & apppool)

obj.start

set obj = nothing

End Sub

' This send a email regarding the down/restarted app pool

Sub emailSendCDOSYS(apppool)

Dim Mailer

Set Mailer=CreateObject("CDO.Message")

Message = "===============================================" & VbCrLf

Message = Message & "Application Pool: " & apppool & " has been restarted" & VbCrLf

Message = Message & "Date/Time: "& now() &"" & VbCrLf

Message = Message & "===============================================" & VbCrLf

Subject = "Application Pool: " & apppool & " has been restarted"

Mailer.TextBody = Message

Mailer.Subject = Subject

Mailer.To = ToAddress

Mailer.From = FromAddress

Mailer.Send

set Mailer = Nothing

End Sub

Source: http://forums.webhostautomation.com/archive/index.php?t-11141.html