'==========================================================================
' NAME: CheckDHCP.vbs 
' COMMENT: Checks DHCP Server for bad and unknown clients
' AUTHOR: Alan Kaplan, VA VISN 6
' alan dot kaplan at va dot gov
' DATE  2/4/2008, v 2.0
' Revision comments at end

Option Explicit
Dim RKPath,strScopeExcludes,strSkipStart, scriptPath
Dim WshShell
Set wshShell = WScript.CreateObject("WScript.Shell")
scriptpath = Left(Wscript.ScriptFullName, InStrRev(Wscript.ScriptFullName, "\")) 'get script path name, ending in \

' ****** OPTIONAL EDITS *********
' NOTE: the single quote is the comment character
' Looking for path to DHCPCMD.EXE 
RKPath = scriptpath		'presume in same folder
'or you can do network share
'RKPATH = "\\servername\ntreskit"	
'or a local path
'RKPath = "c:\Program Files\NTReskit"

'	******* Scopes to exclude from search of not like mine *******
'Enter a list of scopes to exclude from processing, 
'separated by a comma
'Example:
'strScopeExcludes = "192.168.129.0,192.168.210.0"

'******* Additional Prefixes to skip for search of not like mine *******
'Names beginning with exclude list.  Printers, thin clients, etc.
strSkipStart = "WBT,NPI,MAF,LXK"
'******* END OPTION EDITS **********

dim objEx, strRetData, i, iScopes, strServerIP
Dim strCommand, aTemp, aScopes, strDHCPServer
Dim strSearch, message
dim fso,logfile, appendout
Dim aSkipList, strIP
strSearch = Left(WshShell.ExpandEnvironmentStrings("%computername%"),3)
dim quote, bSkipit
quote=chr(34)
Dim strCurScope, sdslogonpath
Dim bSawSyntax, strAll, bPing
bSawSyntax = False

Const ForAppend = 8
set fso = CreateObject("Scripting.FileSystemObject")

getrk

Dim batch
batch = False 

If (Not IsCScript()) Then 		'If not CScript, re-run with cscript...
	WshShell.Run "CScript.exe " & quote & WScript.ScriptFullName & quote, 1, True
    WScript.Quit            	'...and stop running as WScript
End If

If WScript.Arguments.Count = 2 Then  ' two arguments 
	strDHCPServer = WScript.Arguments(0)
	strSearch = WScript.Arguments(1)
	batch = True
	bPing = True
Else
	message = ""	'blank

	If Not(bSawSyntax) Then 'summary of below, don't show 2x
		message = "You can use this script to dump all your DHCP leases or to " &  _
		"check your DHCP server for names that do not meet your " & _
		"naming convention.  It requires DHCPCMD.EXE from the NT 4 or Windows 2000 Resource Kit." & vbcrlf & vbcrlf & _
		"You may edit the script to set excluded scopes and the path to DHCPCMD." & vbcrlf & vbcrlf
	End If 
	
	strAll = MsgBox(message & "Get a list of all leases?",vbYesNoCancel,"All")
	If strAll = vbCancel Then WScript.Quit
	
	message = "Check DHCP leases on what server name or IP?"
	strDHCPServer = InputBox(message,"Server Name or IP",myDhcpServer)
	If strDHCPServer = "" Then WScript.Quit
	strDHCPServer = UCase(strDHCPServer)	
	
	message = "Do you want to ping the leases to log whether the systems are online?  This can " & _
	"add a lot of time, especially if you are exporting all leases."
	bPing = MsgBox(message,vbYesNoCancel,"Ping?")
	If bPing = vbCancel Then WScript.Quit
	
End If	


aScopes = Array(0)

Dim logtime
logtime= cstr(date())
logtime = Replace(logtime,"/","-")

If Not Batch Then 
	If strAll = vbNo Then 
		message = "All computers that follow your naming convention will have " & _
		"what string in their name?"
		strSearch = InputBox(message, "Permitted String",strSearch)
		If strSearch = "" Then WScript.Quit
		
		message = "List of prefixes of leases to skip, separated by a comma. " & _
		"(Below are printers and thin clients, an empty list is okay)"
		strSkipStart = InputBox(message, "Skip List",strSkipStart)
	Else
		strSearch = "`~`%"
		strSkipStart = ""
	End If 
End If 

If Not IsEmpty(strSkipStart) Then
	aSkipList=Split(strSkipStart,",")	'Create an Array
Else
	aSkipList = Array()
End If
	 
If ISIP(strDHCPServer) = False Then
	strServerIP = GetServerIP
Else
	strServerIP = strDHCPServer
End If 

logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\DHCPCheckLog_" & logtime & ".xls" 

If Not batch Then 
	message = "The log file is a tab delmited text file with an " & _
	"XLS extension. Enter a path for log:"
	logfile = InputBox (message,"Log File path",logfile)
End If 

If IsEmpty(logfile) Then WScript.Quit

Dim bheader
bheader = True
If fso.FileExists(logfile) Then bheader = False 
set AppendOut = fso.OpenTextFile(logfile, ForAppend, True)

GetScopes

If strAll = vbNo Then 
	WScript.Echo "Leases not matching " & quote & strSearch & quote  & VbCrLf
End If 

If bheader Then 'Only do header once per Day
	appendout.WriteLine	"Name	IP	Online	MAC	Subnet	LeaseExp	Comment	Scope	ServerName	ServerIP"
End If 

'uncomment if you want 
'EchoAndLog String(11,vbtab) & "Query run at " & Time

For iScopes = 0 To UBound(aScopes)
	strCurScope = aScopes(iScopes)
	
	If InStr(strScopeExcludes,strCurScope) = 0 Then 
		Wscript.echo vbcrlf & "Searching " & strDHCPServer & ", scope: " & strCurScope
		GetClients strCurScope
	Else
		WScript.Echo "Skip excluded scope: " & strCurScope 
	End If 
Next 

'echoAndLog vbcrlf & vbcrlf ' put space at bottom for later runs


Message = "Done.  You sent the log to: " & vbcrlf & logfile

if batch = True then 
	Wscript.echo message
Else
	WshShell.Popup message,10,"Done",vbInformation + vbokonly
End if 

'********** Subs and Functions
Sub GetScopes()
	i = 0
	strCommand = "netsh dhcp server \\" & strDHCPServer & " show scope"
	set objEx = WshShell.Exec(strCommand)
	While Not objEx.StdOut.AtEndOfStream
		strRetData = objEx.StdOut.Readline()
		If (strRetData = "DHCP Server Show Scope failed.") Or (strRetData = "Server may not function properly.")  Then
			appendout.WriteLine String(5,vbtab) & strDHCPServer & vbtab  & strRetdata
			appendout.Close
			WshShell.Popup StrRetdata & " Check service state, your permissions.",10,"Query of " & strDHCPServer & " Failed",vbcritical + vbokonly
			WScript.Quit
		End If 
		
		If Left(strRetData,1) = Space(1) Then
			If IsNum (Mid(strRetdata,2,1)) Then 
				aTemp = split(strRetdata)
				aScopes(i) = aTemp(1)
				ReDim Preserve aScopes(i+1)
				i = i + 1
			End If 
		End If
	Wend
	ReDim Preserve aScopes(i-1)	'kill extra element
End Sub 

Sub GetClients(scope)
	Dim strTest, iGC
	iGC = 0
	strCommand = RKPath & "\dhcpcmd " & strServerIP & " enumclients " & scope & " -v"
	set objEx = WshShell.Exec(strCommand)
	strRetData = objEx.StdOut.ReadAll()

	Dim Tarray, aLines
	tArray = Split(strRetData,"ClientInfo :")

	For iGC = 1 To UBound(tArray)
		aLines = Split(tArray(iGC),VbCrLf)
		Cleanup aLines
	Next

End Sub

Function myDHCPServer()
	Dim objwmiservice, colitems, objitem, wqlQuery
	wqlQuery = "Select * from Win32_NetworkAdapterConfiguration where IPEnabled=True " & _
	"and WINSPrimaryServer !='127.0.0.0' and WINSPrimaryServer != NULL "
	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	Set colItems = objWMIService.ExecQuery(wqlQuery,,48)
	
	For Each objItem in colItems
		MyDHCPServer = objItem.DHCPServer
		Exit For 
	Next

	myDHCPServer = ""
End  Function

Function GetServerIP
	strCommand = "netsh dhcp server \\" & strDHCPServer & " show server"
	set objEx = WshShell.Exec(strCommand)
	While Not objEx.StdOut.AtEndOfStream
		strRetData = objEx.StdOut.Readline()
		If InStr(strRetData,"=") > 0 Then
			aTemp = Split(strRetData,"=")
			GetServerIP = trim(atemp(1))
		End If 
	Wend
End Function 

Function IsIP(strTest)
	IsIP = False
	Dim oRegEx, match, matches
	Set oRegEx = New RegExp
    oRegEx.Pattern = "[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}"
	Set Matches = oRegEx.Execute(strTest)   ' Execute search.
	For Each match In matches 
		If Matches.count = 1 Then
		   ISIP = True
		End If 
	Next 
	set oRegEx = Nothing
End Function

Function IsNum(test)
	On error Resume next
	If Asc(test)> 46 And Asc(test) < 58 Then 
		IsNum = True
	Else
		IsNum = False
	End If 
	On error goto 0
End Function

sub getrk
	Dim message, title, testpath, retval

	testpath=RKPath & "\dhcpcmd.exe"
	if fso.FileExists(testpath) then Exit Sub

	message = "DHCPCMD.EXE was not found.  Do you want to download it?" & vbcrlf & vbcrlf &_          
			"(If you select NO, you will be prompted for a path.)"
	title = "Missing File"	
	retval = MsgBox(message, vbyesnocancel+ vbquestion,title)
	Select Case retval
		Case vbyes
			wshShell.Run("http://www.dynawell.com/reskit/microsoft/win2000/dhcpcmd.zip")
			MsgBox "Unzip into same directory as script, then rerun script.",vbinformation + vbokonly,"Info"
			WScript.Quit 
		Case vbno
			'''get rkpath''''
			message = "(You may edit the script to avoid this prompt)" & _ 
			vbcrlf & "Enter path to DHCPCMD.EXE from the NT 4.0 or Windows 2000 " & _
			"Resource Kit:"           
			title = "Resource Kit Path"
			rkpath = InputBox(message, title, Rkpath)
			' Evaluate the user input.
			
			If rkpath = "" Then    ' Canceled by the user
			    WScript.quit
			End If
			
			testpath=RKPath & "\dhcpcmd.exe"
			if not(fso.FileExists(testpath)) then 
				WshShell.Popup "Could not find DHCPCMD.EXE",10,"Bad Path",vbcritical
			getrk
			End If
		Case Else
		WScript.Quit
	End Select 
End Sub

Function SpaceStrip(text)
	text = Replace(text,vbtab,Space(1))
	While InStr(text,Space(2)) > 0
		text = replace(text,Space(2),Space(1))
	Wend
	SpaceStrip = text
End Function

Sub EchoAndLog (message)
'Echo output and write to log
	Wscript.Echo message
	AppendOut.WriteLine message
End Sub  

Function IsCScript()
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function

Sub Syntax
	Dim retval
	message = "This script allows you dump all your leases or checks your DHCP server for names that do not meet a " & _
	"naming convention.  It requires DHCPCMD.EXE from the NT 4 or Windows 2000 Resource Kit." & _
	"You may edit the script to set excluded scopes and the path to DHCPCMD." & vbcrlf & vbcrlf & _
	"It can be run from the GUI or with limited support of the command line with the following syntax:" & vbcrlf & vbcrlf & _
	WScript.ScriptName & " DHCPServer searchstring" & vbcrlf & vbcrlf & _
	"Example: " & WScript.ScriptName & " 192.168.100.1 IBM" & vbcrlf & vbcrlf &_
	"checks the server at 192.168.100.1 for leases not containing " & _
	"the permitted string " & quote & "IBM" & quote &" with online check." & vbcrlf & vbcrlf & _
	"You can use IP or server name.  Results are logged with date stamps to your desktop."
	retval = MsgBox(message,vbinformation + vbokcancel,"Syntax")
	If retval = vbcancel Then WScript.Quit
	bSawSyntax = True
End Sub

Function PingReply(strcomputer) 
	Dim objScriptExec, strPingResults
	Dim objRE, match, matches

	'RegEx pattern from Bill Stewart
	Set objRE = New RegExp
    objRE.Pattern = " [0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}: "
	
	'Three lines from Steve Cathersalc 
	Set objScriptExec=wshShell.Exec("ping -n 2 -w 1000 " & strComputer)
	Set Matches = objRE.Execute(objScriptExec.StdOut.Readall)   ' Execute search.

	If Matches.count = 1 Then 
	   PingReply = True
	   For Each Match in Matches   ' Iterate Matches collection.
	     strIP = trim(replace(Match.Value,":","")) 'Cleanup
	   Next
	Else
		strIP = ""
		PingReply = False
	End If 
End Function


Sub Cleanup (aTemp)
	bSkipit = False
	dim strData, iC, strLine, strTemp, strStatus, strTest
	Dim strIP, strSubnet, strMac, strName, strComment, strLeaseExp, strServerName	

	For iC = 1 To 10
		strLine = atemp(ic)
		strTemp = Mid(strLine,InStr(strLine,"= ")+2)
		
		If Right(strTemp,1) = "." Then 
			strTemp = Left(strTemp,Len(strTemp)-1)
		End If 
		
		Select Case iC
			Case 1		strIP = strTemp
			Case 2		strSubnet = strTemp
			Case 3		strMac = strTemp
			Case 4		strName = strTemp
			Case 5		strComment = strTemp
			Case 7		strLeaseExp	= strTemp
			Case 8		strServerIP = strTemp
			Case 9		strServerName = strTemp
		End Select
	Next


	 	If InStr(lcase(strName),lcase(strSearch)) > 0 Then bSkipit = True
	 	
 		For i = 0 To UBound(aSkipList)
 			strTest = Left(strName,Len(aSkipList(i)))
 			strTest = UCase(strTest)
 			
 			If Ucase(aSkipList(i)) = strTest Then 
 				bSkipit = True
 				Exit For
 			End If 
 		Next 

		If Not bSkipit Then 
			If bPing = True Then 
				If PingReply(strIP) Then
					strStatus = "Online"
				Else
					strStatus = "Offline"
				End If 
			Else
				strStatus = ""
			End If 
	
			EchoAndLog 	strName & vbTab & strIP & vbTab & strStatus & vbTab & strMac & vbTab & strSubnet & vbTab & strLeaseExp & vbTab & strComment & vbTab &strCurScope& vbTab & strServerName & vbTab & strServerIP
		Else
			WScript.Echo "Skipping " & strName
		End If 
End Sub 



'==========================================================================
' Revision notes
'
' In VISN 6 ... NotMySite_DHCP_Check.vbs
' 9-9 added strScopeExcludes for Ed Kubacki
' 4-26-05 added skip with names beginning with x
' 5-23-05 fixed skip start, added prompt for prefix skips and logfile, 
' improved comments for those of you trying to figure out scripting.
' 5-23-05 This is the general release version of the script
' 6-9-05 fixed handling of leases without "." in name, added online status
' switched output to xls extension.  Changed method of stripping extra spaces
' 6-15 added IP reporting for rogues, also suggested by Ed.
' 6-16 added error reporting for failure to get DHCP scopes.
' 6-17-05 added download of dhcpcmd.exe and additional error handling, Syntax
' 2-1-2008 figured out how to get vebose information, requiring overhaul of
' parsing of output.  Gave option to dump all leases.  Ping made optional in GUI
'==========================================================================