Disk Space Warning

The development department came up with a solution to a problem that we've been having. It's very intermittant but sometimes temporary cache builds up on our webserver. This can cause problems with disk space which in turn, on 2 occasions, caused one of the backups to fail.

We wanted a warning when the disk space gets too low, as it may not be down to the cache, but not one on the server as that'd require someone to be logged in. After some research into performance alerts we decided that they didn't really work as well as we wanted. So we had a chat with our dev team and they came up with a solution in the form of a windows service. This service emails our tech team when the disk space drops under 3GB and continulously each time it drops again.

We have decided to release this code:

Imports System.Net
Imports System.Net.Mail
Imports System.Threading

Public Class Service1

Public url = "C:\"
Public sent = False
Public lastCalc

Private Declare Function GetDiskFreeSpaceEx _
Lib "kernel32" _
Alias "GetDiskFreeSpaceExA" _
(ByVal lpDirectoryName As String, _
ByRef lpFreeBytesAvailableToCaller As Long, _
ByRef lpTotalNumberOfBytes As Long, _
ByRef lpTotalNumberOfFreeBytes As Long) As Long

Protected Overrides Sub OnStart(ByVal args() As String)
Dim wt As System.Threading.Thread
Dim ts As System.Threading.ThreadStart
ts = AddressOf Tick
wt = New System.Threading.Thread(ts)
wt.Start()
End Sub


Public Function GetFreeSpace(ByVal Drive As String) As Long
'returns free space in MB, formatted to two decimal places

Dim lBytesTotal, lFreeBytes, lFreeBytesAvailable As Long

Dim iAns As Long

iAns = GetDiskFreeSpaceEx(Drive, lFreeBytesAvailable, _
lBytesTotal, lFreeBytes)
If ians > 0 Then

Return BytesToMegabytes(lFreeBytes)
Else
Throw New Exception("Invalid or unreadable drive")
End If


End Function

Public Function BytesToMegabytes(ByVal Bytes As Double) As Double
'This function gives an estimate to two decimal places.

Dim dblAns As Double
dblAns = (Bytes / 1024) / 1024
BytesToMegabytes = Format(dblAns, "###,###,##0.00")

End Function

Public Sub SendEmail(ByVal Emails, ByVal FromList)

Try
Dim arrEmails, strBody
Dim keyword As String
Dim MyMailMessage As New MailMessage()

Emails += ";"

strBody = "Server Disk space running low! Please Check"

strBody = strBody & "

-

"

MyMailMessage.From = New MailAddress("you@yourdomain.com")
MyMailMessage.Subject = "Server"
MyMailMessage.IsBodyHtml = True

Dim serverHost, serverUser, serverPass

serverHost = "mail.yourdomain.com"
serverUser = "username"
serverPass = "password"

Dim oldBody = strBody
Dim smtp As New SmtpClient()
If inStr(Emails, ";") > 0 Then
arrEmails = Split(Emails, ";")

For Each keyword In arrEmails
MyMailMessage.To.Clear()
If keyword <> "" Then
strBody = oldBody

MyMailMessage.Body = strBody
MyMailMessage.To.Add(keyword)
smtp.Host = serverHost
smtp.Credentials = New System.Net.NetworkCredential(serverUser, serverPass)
smtp.Send(MyMailMessage)
End If
Next
End If
Catch ex As Exception
WriteLine(ex.ToString())
End Try

End Sub

Protected Overrides Sub OnStop()
' Add code here to perform any tear-down necessary to stop your service.
End Sub

Private Sub WriteLine(ByVal line As String)
Dim sWriter As IO.StreamWriter = New IO.StreamWriter(url + "logs\" + DateTime.Now.Day.ToString("00") + DateTime.Now.Month.ToString("00") + DateTime.Now.Year.ToString("00") + ".log", True)
sWriter.WriteLine(line)
Console.WriteLine(line)
sWriter.Flush()
sWriter.Close()
End Sub

Public Sub Tick()
Do While True

If GetFreeSpace("C:\") < 3000 Then
If sent = False Then
SendEmail("info@appiam.com", "No")
WriteLine("Email Sent - Free Space on C: " & GetFreeSpace("C:\") & "MB")
sent = True
End If
End If

If lastCalc > GetFreeSpace("C:\") Then
sent = False
End If

lastCalc = GetFreeSpace("C:\")
Loop
End Sub
End Class

We hope this helps someone

IT Support