View RSS Feed

Duke5A

VB Script to snoop DHCP logs

Rate this Entry
by , 1st February 2013 at 04:39 PM (12351 Views)
A forum post got me to thinking about a script to parse DHCP logs to notify someone when a particular MAC checks in with the server. You can run this script as a reoccurring task on the DHCP server and when it finds a match for the desired MAC it will send an email regarding the activity. This script will also keep a log of its own to prevent multiple email messages for the same log entry it finds. I've run this in a production environment with an internally hosted Exchange server and it works. You may need to debug a little depending on your environment.

The On Error Resume Next line in the email function is to prevent the script from hanging if there is an error with the mail server. If that were to happen without it there instances of wscript.exe would keep spawning and never exit each time the scheduled task would fire.

Code:
Call Main

Sub Main
	'MAC to find
	strFindMAC = "xxxxxxxxxxxx"

	Set objFSO = CreateObject("Scripting.FileSystemObject")

	Const ForReading = 1
	Const ForWriting = 1
	
	'Determine log name based on day of week
	strLogPath = "c:\windows\system32\dhcp\"
	strWeekDay = weekdayname(weekday(date))
	strFullLogPath = strLogPath & "DhcpSrvLog-" & Left(strWeekday,3) & ".log"
	
	'Check to see if log exists
	If objFSO.FileExists(strFullLogPath) Then
		'Do Nothing
	Else
		WScript.Quit
	End If

	'Open DHCP log file for reading
	Set objDHCPLogFile = objFSO.OpenTextFile(strFullLogPath, ForReading)
		
	'Copy file contents into string
	strDHCPLogFile = objDHCPLogFile.ReadAll
	objDHCPLogFile.Close
	
	'Break into individual lines
	arrLines = Split(strDHCPLogFile,vbCrLf)
	
	'Loop through the array and build another array of lines that contain the MAC
	For Each strLine in arrLines
		If InStr(strLine, strFindMAC) Then
			intCount = intCount + 1
			ReDim Preserve arrFound(intCount)
			arrFound(intCount) = strLine
		End If
	Next
	
	'If no matches are found then abort the script
	If intCount = 0 Then
		WScript.Quit
	End If
	
	'Get the last line of matching MAC log entries
	strLastLine = arrFound(intCount)
	
	'Split the log entry on commas and dump to array
	arrLastLine = Split(strLastLine, Chr(44))
	
	'Format message
	strDate = arrLastLine(1)
	strTime = arrLastLine(2)
	strAction = arrLastLine(3)
	strIPAddress = arrLastLine(4)
	strHostName = arrLastLine(5)
	
	strMessage = "MAC address " & strFindMAC & " has checked into the DHCP server on " & strDate & " at " & strTime & "." & Chr(13) _
				 & strIPAddress & " was " & strAction & "ed" & " to hostname " & strHostName & "."
	

	'This next block of code will read/write a log for the script itself.  This will prevent the script from sending multiple
	'emails for the same DHCP log entry.
	
	'Check to see if script log exists
	If objFSO.FileExists("DHCPScriptLog.txt") Then
			'Read log and get the time
			Set objScriptLogFile = objFSO.OpenTextFile("DHCPScriptLog.txt", ForReading)
			strLastTime = objScriptLogFile.ReadAll
			objScriptLogFile.Close
			
			'If the last time matches the time pulled from the DHCP log then quit the script
			If strLastTime = strTime Then
				WScript.Quit
			End If
	End If
		
	'Write the log file
	Set objScriptLogFile = objFSO.CreateTextFile("DHCPScriptLog.txt", ForWriting)
	objScriptLogFile.Write strTime
	objScriptLogFile.Close
	
	'Call the email function to send the message
	Email(strMessage)

End Sub

Function Email(strMessage)

	On Error Resume Next

	Set objMessage = CreateObject("CDO.Message")
	objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
	objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.domain.com"
	objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
	objMessage.Configuration.Fields.Update

	objMessage.Subject = "DHCP Log Script"
	objMessage.From = "DHCPScript@domain.com"
	objMessage.To = "you@domain.com"
	objMessage.TextBody = strMessage
	
	objMessage.Send

End Function

Updated 26th February 2014 at 06:55 PM by Duke5A

Categories
VB Script

Comments

  1. TheScarfedOne's Avatar
    Great bit of work this, thanks

Trackbacks

Total Trackbacks 0
Trackback URL: