Option Explicit
'Author:  Dave Newbern, dave@newbern.org
'Contributor:  Toshiba support added by Seth Shoemaker, sshoemaker@westshorefree.org

Const ConnectionString = "Driver={SQLite3 ODBC Driver};Database=C:\Program Files\Spiceworks\db\spiceworks_prod.db"  
Const DellURL = "http://support.dell.com/support/topics/global.aspx/support/my_systems_info/details?c=us&l=en&s=gen&logout=&ServiceTag=<SERIAL_NUMBER>"
Const HPURL = "http://www13.itrc.hp.com/service/ewarranty/warrantyResults.do?serialNumber1=<SERIAL_NUMBER>&productNumber=<PRODUCT_NUMBER>&country=US"
Const ToshibaURL = "http://www.csd.toshiba.com/cgi-bin/tais/support/jsp/globalEntitlement.jsp?txtSerialNum=<SERIAL_NUMBER>"
Const SMTPServer = "172.16.132.3"
Const AdminEmail = "dave.newbern@vizada.com"
Const CheckAll = False		'Check all system always.  Make False to only check the new ones.

Dim html, c_warranty
Dim httpObjectName 
Dim WinDir
Dim OSType
Dim AnomalyReport
Dim AppPath: AppPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
Dim wshShell: Set WshShell = CreateObject("WScript.Shell") 

'Enumerate a few system variables
OSType = WshShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PROCESSOR_ARCHITECTURE")
WinDir = WshShell.ExpandEnvironmentStrings("%windir%") 



wscript.echo "Windows Root   " & vbTab & WinDir
wscript.echo "Processor Type " & vbTab & OSType
wscript.echo "Script Engine  " & vbTab & wscript.fullname


'Ensure we're calling with cscript.exe.  
Dim relaunch: relaunch = False
If lCase(Right(WScript.Fullname, 11)) <> "cscript.exe" Then WshShell.Run Windir & "\system32\CSCRIPT.EXE /nologo " & WScript.ScriptFullName


httpObjectName = GetHTTPObject
wscript.echo "HTTP Object    " & vbTab & httpObjectName 


'Ensure the required custom fields exist in the database
CreateField "devices","c_warranty","date"
CreateField "devices","c_warrantytype","varchar(50)"
CreateField "devices","c_product_number","varchar(20)"



'Check script arguments
Dim oArgs:  Set oArgs=wscript.Arguments 
If wscript.Arguments.Count <> 0 Then 
	'Assume it is a dell service tag
	wscript.echo "     Service Tag  :" & oArgs(0)
	
	Dim httprequest
	httpRequest = replace(DellURL,"<SERIAL_NUMBER>",oArgs(0))		
	html = getURL (httpRequest,"","")

	If instr(lcase(html), "system summary") Then
		html=mid(html,instr(html,"<a name=""grid_0"">")) 
		html=left(html,instr(html,"<!-- content_end-->")-1) 
	    Else
	    	html=""
	End If

	If html <> "" Then
		wscript.echo "     Ship Date    :" & reformatDate(getDellShipDate(html))
		wscript.echo "     Support Date :" & reformatDate(getDellSupportDate(html))
		wscript.echo "     Support Type :" & getDellSupportType(html)
	End If
	wscript.quit
End If





CheckDeviceWarranties



'If len(AnomalyReport) > 5 Then SendEmail AdminEmail , "Spicewords Service Date Anomaly Report", AnomalyReport



wscript.quit







Sub CheckDeviceWarranties()
	Dim DB, RS
	Dim SQL 
	Dim httpRequest
	Dim serial_number, product_number
	Dim supportDate, shipDate, supportType 

	Set DB = CreateObject("ADODB.Connection") 
	DB.ConnectionString = ConnectionString    
	DB.Open   
	
	Set RS = CreateObject("ADODB.Recordset")    
	RS.open "SELECT * FROM devices WHERE type like 'computer' and (operating_system like 'Win%' OR operating_system like 'Vista%')", DB, 3,3   
	
	While Not rs.eof


		If lcase(rs("manufacturer")) = "dell" Then
			If Not isDate(rs("c_warranty")) Or CheckAll = True Then		'Only check systems that have not been checked before.
				serial_number = clean(rs("serial_number"))
				wscript.echo "System Name/Tag  :" & rs("name") & vbTab & serial_number
				
				If len(serial_number) > 4 And len(serial_number) < 8 Then 
					httpRequest = replace(DellURL,"<SERIAL_NUMBER>",serial_number)		
					html = getURL (httpRequest,"","")

					If instr(lcase(html), "system summary") Then
						html=mid(html,instr(html,"<a name=""grid_0"">")) 
						html=left(html,instr(html,"<!-- content_end-->")-1) 
					    Else
					    	html=""
					End If

					If html <> "" Then
						supportDate = ""
						shipDate = ""
						supportType = ""

						supportDate = reformatDate(getDellSupportDate(html))
						shipDate = reformatDate(getDellShipDate(html))
						supportType = getDellSupportType(html)

						wscript.echo "     Ship Date    :" & shipDate 
						wscript.echo "     Support Date :" & supportDate 
						wscript.echo "     Support Type :" & supporttype 
			
						'if we don't have complete information the don't record anything.. get it all the next time.
						If shipdate = "" Or supportDate = "" Or supportType = "" Then 
						  Else
							DB.Execute ("UPDATE devices SET c_warranty='" & supportdate & "' WHERE ID=" & rs("id"))
							'Try to respect manually entered purchase dates
							If Not isdate(rs("c_purchase_date")) Then DB.Execute ("UPDATE devices SET c_purchase_date='" & shipdate & "' WHERE ID=" & rs("id"))
							If clean(rs("c_warrantytype")) = "" Then DB.Execute ("UPDATE devices Set c_warrantytype='" & supportType & "' WHERE ID=" & rs("id"))
						End If
					End If
				  Else
					wscript.echo "     * Service tag :" & serial_number & " is invalid."
					AnomalyReport = AnomalyReport & "Service tag (" & serial_number & ") on Dell system (" & rs("name") & ") is invalid." & vbCrlf
				End If
			End If
		End if
	
	
		If lcase(rs("manufacturer")) = "hewlett-packard" Then
			wscript.echo "HP found: " & rs("name")	
			If Not isDate(rs("c_warranty")) Or CheckAll = True Then		'Only check systems that have not been checked before.
				serial_number = clean(rs("serial_number"))
				product_number = clean(rs("c_product_number"))

				wscript.echo "System Name/Tag  :" & rs("name") & vbTab & serial_number & vbTab & product_number
				
				If len(serial_number) > 9 And len(serial_number) < 11 And mid(product_number,7,1) = "-" Then
					httpRequest = replace(HPURL,"<SERIAL_NUMBER>",serial_number)		
					httpRequest = replace(httpRequest,"<PRODUCT_NUMBER>",product_number)		
					html = getURL (httpRequest,"","")

					If instr(lcase(html), "result 1 of 1") Then
						html=mid(html,instr(html,"result 1 of 1")) 
						html=left(html,instr(html,"<!-- End Content Area -->")-1) 
					    Else
					    	html=""
					End If

					If html <> "" Then
						supportDate = ""
						shipDate = ""
						supportType = ""

						supportDate = reformatDate(getHPSupportDate(html))
'						shipDate = reformatDate(getDellShipDate(html))
'						supportType = getHPSupportType(html)

						wscript.echo "     Ship Date    :" & shipDate 
						wscript.echo "     Support Date :" & supportDate 
						wscript.echo "     Support Type :" & supporttype 
			
						DB.Execute ("UPDATE devices SET c_warranty='" & supportdate & "' WHERE ID=" & rs("id"))
						'Try to respect manually entered purchase dates
						If Not isdate(rs("c_purchase_date")) Then DB.Execute ("UPDATE devices SET c_purchase_date='" & shipdate & "' WHERE ID=" & rs("id"))
						If clean(rs("c_warrantytype")) = "" Then DB.Execute ("UPDATE devices Set c_warrantytype='" & supportType & "' WHERE ID=" & rs("id"))
					End If
				  Else
					wscript.echo "     * Service tag :" & serial_number & " is invalid."
					AnomalyReport = AnomalyReport & "Service tag (" & serial_number & ") on HP system (" & rs("name") & ") is invalid." & vbCrlf
				End If
			End If
		End If


		If lcase(rs("manufacturer")) = "toshiba" Then
			wscript.echo "Toshiba found: " & rs("name")	
			If Not isDate(rs("c_warranty")) Or CheckAll = True Then		'Only check systems that have not been checked before.
				serial_number = clean(rs("serial_number"))

				wscript.echo "System Name/Tag  :" & rs("name") & vbTab & serial_number 
				
				If len(serial_number) > 8 And len(serial_number) < 11 Then
					httpRequest = replace(ToshibaURL,"<SERIAL_NUMBER>",serial_number)		
					html = getURL (httpRequest,"","")

					If instr(lcase(html), "product information") Then
						html=mid(html,instr(html,"Product Information")) 
						html=left(html,instr(html,"<!--SERVICE PROGRAM -->")-1) 
					    Else
					    	html=""
					End If

					If html <> "" Then
						supportDate = ""
						shipDate = ""
						supportType = ""
						
						supportDate = reformatDate(getToshibaSupportDate(html))
						shipDate = reformatDate(getToshibaShipDate(html))
						supportType = getToshibaSupportType(html)
						
						wscript.echo "     Ship Date    :" & shipDate 
						wscript.echo "     Support Date :" & supportDate 
						wscript.echo "     Support Type :" & supporttype 
			
						DB.Execute ("UPDATE devices SET c_warranty='" & supportdate & "' WHERE ID=" & rs("id"))
						'Try to respect manually entered purchase dates
						If Not isdate(rs("c_purchase_date")) Then DB.Execute ("UPDATE devices SET c_purchase_date='" & shipdate & "' WHERE ID=" & rs("id"))
						If clean(rs("c_warrantytype")) = "" Then DB.Execute ("UPDATE devices Set c_warrantytype='" & supportType & "' WHERE ID=" & rs("id"))
					End If
				  Else
					wscript.echo "     * Service tag :" & serial_number & " is invalid."
					AnomalyReport = AnomalyReport & "Service tag (" & serial_number & ") on Toshiba system (" & rs("name") & ") is invalid." & vbCrlf
				End If
			End If
		End If


	
		rs.movenext
	Wend
	
	Set RS = Nothing   
	Set DB = Nothing   
End Sub	
	
	






Function reFormatDate(dateIn)
	'The date needs to be in YYYY-MM-DD to be written using this funky ODBC driver.  We have it in MM/DD/YYYY.  :
	'This only works because CDATE assumes MM/DD/YYYY due to the US regional settings.

	If clean(dateIn) = "" Then
		reFormatDate = ""
	  Else
		Dim newdate:  newDate = cdate(dateIn)
		reFormatDate = year(newdate) & "-" & right("0" & month(newDate),2)  & "-" & right("0" & day(newDate),2)  
	End If
End Function




Function clean(str)
	'Clean effectively strips off Nulls, making it easier to compare results from a database
	On Error Resume Next
	clean = trim(str & " ")
	On Error goto 0
End Function







'''''''''  DELL Functions

Function getDellSupportDate(html)
	'Support Date is the LAST DATE found
	
	Dim DateRegEx,DatesFound, DateFound, bigDate  
	Set DateRegEx = New RegExp
	DateRegEx.IgnoreCase = True
	DateRegEx.Global = True
	DateRegEx.Pattern = "1?\d\/\d+\/\d{4}"
	Set DatesFound = DateRegEx.Execute (html)
	
	bigdate = dateadd("yyyy",-30, now)


	If DatesFound.Count = 0 Then 
		getDellSupportDate = ""
	  Else
		For Each datefound In DatesFound
			If datediff("d",cdate(bigDate),cdate(datefound)) > 0 Then
			bigDate = datefound
			End If
		Next

	  	getDellSupportDate = bigDate
	End If
End Function

Function getDellShipDate(html)
	'Support Date is the LAST DATE found
	
	Dim DateRegEx,DatesFound, DateFound  
	Set DateRegEx = New RegExp
	DateRegEx.IgnoreCase = True
	DateRegEx.Global = True
	DateRegEx.Pattern = "1?\d\/\d+\/\d{4}"
	Set DatesFound = DateRegEx.Execute (html)

	If DatesFound.Count = 0 Then 
		getDellShipDate = ""
	  Else
	  	getDellShipDate = DatesFound.item(-0)
	End If
End Function

Function getDellSupportType(html)	
	If instr(html,"contract_table") = 0 Then
		getDellSupportType = ""
		Exit Function
	End If

	If instr(html, "There are no service contracts or warranties associated with this system") Then
		getDellSupportType = "None"
		Exit Function
	End If

	Dim tmp
	tmp= html
	tmp=mid(tmp,instr(tmp,"contract_table"))
	
	If instr(tmp,"contract_evenrow") Then
		tmp=mid(tmp,instr(tmp,"contract_evenrow"))
	Else
		tmp=mid(tmp,instr(tmp,"contract_oddrow"))
	End If

	tmp=mid(tmp,instr(tmp,">")+1)
	tmp=mid(tmp,instr(tmp,">")+1)
	tmp=left(tmp,instr(tmp,"</a>")-1)
	
	getDellSupportType = tmp
End Function






''' Toshiba functions

Function getToshibaSupportDate(html)
	'Support Date is the LAST DATE found
	
	Dim DateRegEx,DatesFound, DateFound, bigDate  
	Set DateRegEx = New RegExp
	DateRegEx.IgnoreCase = True
	DateRegEx.Global = True
	DateRegEx.Pattern = "[a-zA-Z]{3} \d{1,2}, \d{4}"
	Set DatesFound = DateRegEx.Execute (html)
	
	bigdate = dateadd("yyyy",-30, now)


	If DatesFound.Count = 0 Then 
		getToshibaSupportDate = ""
	  Else
		For Each datefound In DatesFound
			If datediff("d",cdate(bigDate),cdate(datefound)) > 0 Then
			bigDate = datefound
			End If
		Next

	  	getToshibaSupportDate = bigDate
	End If
End Function

Function getToshibaShipDate(html)
	Dim DateRegEx,DatesFound, DateFound  
	Set DateRegEx = New RegExp
	DateRegEx.IgnoreCase = True
	DateRegEx.Global = True
	DateRegEx.Pattern = "[a-zA-Z]{3} \d{1,2}, \d{4}"
	Set DatesFound = DateRegEx.Execute (html)

	If DatesFound.Count = 0 Then 
		getToshibaShipDate = ""
	  Else
	  	getToshibaShipDate = DatesFound.item(-0)
	End If
End Function

Function getToshibaSupportType(html)	
	If instr(html,"Warranty") = 0 Then
		getToshibaSupportType = ""
		Exit Function
	End If

	Dim tmp
	tmp= html
	tmp=mid(tmp,instr(tmp,"Warranty:"))
	tmp=mid(tmp,instr(tmp,"class=""item-list4"">"))

	tmp=mid(tmp,instr(tmp,">")+1)
	tmp=left(tmp,instr(tmp,"</td>")-1)
	
	getToshibaSupportType = tmp
End Function



''  HP Functions

Function getHPSupportDate(html)
	'Support Date is the LAST DATE found
	
	Dim DateRegEx,DatesFound, DateFound, bigDate  
	Set DateRegEx = New RegExp
	DateRegEx.IgnoreCase = True
	DateRegEx.Global = True
	DateRegEx.Pattern = "\d{1,2} [a-zA-Z]{1,3} \d{4}"
	Set DatesFound = DateRegEx.Execute (html)
	
	bigdate = dateadd("yyyy",-30, now)


	If DatesFound.Count = 0 Then 
		getHPSupportDate = ""
	  Else
		For Each datefound In DatesFound
			If datediff("d",cdate(bigDate),cdate(datefound)) > 0 Then
			bigDate = datefound
			End If
		Next

	  	getHPSupportDate = bigDate
	End If
End Function

Function getHPSupportType(html)	
	If instr(html,"warranty type") = 0 Then
		getHPSupportType = ""
		Exit Function
	End If

	Dim tmp
	tmp= html
	tmp=mid(tmp,instr(tmp,"warranty type"))
	tmp=mid(tmp,instr(tmp,"colspan=""2"">"))

	
	tmp=mid(tmp,instr(tmp,">")+1)
	tmp=mid(tmp,instr(tmp,">")+1)
	tmp=left(tmp,instr(tmp,"</a>")-1)
	
	getHPSupportType = tmp
End Function














Function GetHTTPObject()
	Dim http, httpObjectName
	httpObjectName = ""

	
	On Error Resume Next
	  Set http = CreateObject("MSXML2.XMLHTTP")
	If err.number = 0 Then 
		httpObjectName = "MSXML2.XMLHTTP"
		err.clear
	End If
	On Error goto 0

	If httpObjectName = "" Then
		On Error Resume Next
		  Set http = CreateObject("MSXML2.ServerXMLHTTP")
		If err.number = 0 Then 
			httpObjectName = "MSXML2.ServerXMLHTTP"
			err.clear
		End If
		On Error goto 0
	End if

	If httpObjectName = "" Then
		On Error Resume Next
		  	Set http = CreateObject("WinHttp.WinHttprequest.5")
		If err.number = 0 Then 
			httpObjectName = "WinHttp.WinHttprequest.5"
			err.clear
		End If
		On Error goto 0
	End if
	Set http = Nothing

	getHTTPObject = httpObjectName 
End Function


Function getURL(URL, FormData, Boundary)
	Dim http
	Set http = CreateObject(httpObjectName)
	
	http.Open "POST", URL, False
	http.setRequestHeader "Content-Type", "multipart/form-data; boundary=" + Boundary
	http.send FormData
	getURL = http.responseText
End Function



Function CreateField(tableName, columnName, columnType)
	Dim DB, RS
	Dim SQL 
	
	Set DB = CreateObject("ADODB.Connection") 
	DB.ConnectionString = ConnectionString    
	DB.Open   
	
	Set RS = CreateObject("ADODB.Recordset")    
	On Error Resume Next
	RS.open "SELECT " & columnName & " FROM " & tableName, DB, 3,3   

	If err.number <> 0 Then
		wscript.echo "Creating column " & tablename & "." & columnName
		err.clear
		DB.Execute ("ALTER TABLE " & tablename & " ADD COLUMN " & columnName & " " & columnType)
	End If
	On Error goto 0	
	
	Set RS = Nothing   
	Set DB = Nothing   
End Function



Sub SendEmail(emailAddress, Subject, message)
	'requires ossmtp.dll to be registered with the system 
	Dim oSMTPSession
	On Error Resume Next
	Set oSMTPSession = CreateObject("OSSMTP.SMTPSession") 

	If Err.Number = 429 Then
		'Install the OSSMTP object
		Dim FSO
		Set FSO = CreateObject("Scripting.FileSystemObject")
		FSO.copyfile AppPath & "OSSMTP.dll", WinDir & "\System32\OSSMTP.dll"

		Set WshShell = WScript.CreateObject("WScript.Shell")
		WshShell.run "regsvr32.exe /s " & WinDir & "\System32\OSSMTP.dll", 0, True

		'Recreate the session
		Set oSMTPSession = CreateObject("OSSMTP.SMTPSession") 
	End If
	On Error goto 0


	oSMTPSession.MailFrom = emailAddress
	oSMTPSession.SendTo = emailAddress
	oSMTPSession.Server = SMTPServer
	oSMTPSession.Port = 25 
	oSMTPSession.MessageSubject = Subject
	oSMTPSession.MessageText = message
	oSMTPSession.SendEmail 
	Set oSMTPSession = Nothing 
End Sub