' DellWarrantyInfo.vbs
' Description: Screen-scrape Dell warranty information based on a list of Service Tag numbers.
' Based on SMS Inventory script here: http://myitforum.com/cs2/blogs/skissinger/archive/2010/01/13/dell-warranty-information-script-small-update.aspx

' Input: Computers.txt, ASCII file with one Service Tag per line
' Output DellInventory.xlsx - Excel 2007 spreadsheet containing warranty information.

' DISCLAIMER: Use this script at your own risk. 

Dim objXL, objFSO,objShell, strCurrentDir, objTextFile, strTextFile, strData, arrLines, LineCount

arrHeadings = Array("Service Tag:", "Days Left")

CONST ForReading = 1

Set objHTTP = CreateObject("Msxml2.XMLHTTP")
Dim strField(400)
strfield(0) = Now

strTextFile = "computers.txt"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set strCurrentDir = objFSO.GetFolder(".")

' Check if Computers.txt exists
If Not objFSO.FileExists(strCurrentDir & "\Computers.txt") Then
   MsgBox "Cannot find Computers.txt. Exiting."
   WScript.Quit
Else
   Set objTextFile = objFSO.OpenTextFile(strCurrentDir & "\Computers.txt")
End If 

'Open the text file - strData now contains the whole file
strData = objFSO.OpenTextFile(strTextFile,ForReading).ReadAll

'Split by lines, put into an array
arrLines = Split(strData,vbCrLf)

'Use UBound to count the lines
LineCount = UBound(arrLines) + 1

'Cleanup
'Set objFSO = Nothing

Function DisplayProgress(stage)
Set objExplorer = Nothing
set objExplorer = createobject("internetexplorer.application")
objExplorer.navigate2 "about:blank" : objExplorer.width = 640 : objExplorer.height = 160 : objExplorer.toolbar = false : objExplorer.menubar = false : objExplorer.statusbar = false : objExplorer.visible = True
objExplorer.document.write "<font color=blue>"
objExplorer.document.write "<MARQUEE WIDTH=100% BEHAVIOR=ALTERNATE>" & Message & "</MARQUEE><br>"
    objExplorer.document.title = "Processing " & intCount & " of " & LineCount
    objExplorer.document.write "<center>Processing " & intCount & " of " & LineCount & "<br>Service Tag: " & strServiceTag & "</center><br><font color=red>"
For n = 1 to 195
    objExplorer.document.write "|"
    wscript.sleep 10
Next
stage = intCount
objExplorer.quit
DisplayProgress = stage
End Function

' ///////////////////
' /// Main Module ///
' ///////////////////


' Create Excel spreadsheet for output
Set objXL = WScript.CreateObject("Excel.Application")
objXL.Visible = False
objXL.DisplayAlerts = False
' Create Spreadsheet
Set objWb = objXL.WorkBooks.Add 
    
' Add Heading information
objXL.ActiveSheet.Cells(1,1).Value="Service Tag"
objXL.ActiveSheet.Cells(1,2).Value="System Type"
objXL.ActiveSheet.Cells(1,3).Value="Ship Date"
objXL.ActiveSheet.Cells(1,4).Value="Dell IBU"
objXL.ActiveSheet.Cells(1,5).Value="Description"
objXL.ActiveSheet.Cells(1,6).Value="Provider"
objXL.ActiveSheet.Cells(1,7).Value="Start Date"
objXL.ActiveSheet.Cells(1,8).Value="End Date"
objXL.ActiveSheet.Cells(1,9).Value="Days Left"

' Put cursor at A2
objXL.ActiveSheet.range("A2").Activate

intCount = 0
'Set objTextFile = objFSO.OpenTextFile(strCurrentDir & "\Computers.txt")
Do Until objTextFile.AtEndOfStream
	strServiceTag = objTextFile.ReadLine
	'wscript.echo "Processing: " & intCount + 1 & " of " & LineCount & vbcrlf & vbcrlf & "Service Tag: " & strServiceTag
	Call GetWarrantyInfo
	intCount = intCount + 1 'Running total of computers
	Call DisplayProgress(stage)
	objXL.ActiveSheet.range("A" & intCount + 2).Activate
Loop
objTextFile.Close

' Autofit spreadsheet data
Set xlRange = objXL.ActiveSheet.Range("A1:I" & intCount).CurrentRegion
xlRange.EntireColumn.AutoFit()

' Put cursor at A2
objXL.ActiveSheet.range("A2").Activate

' Save Spreadsheet
objXL.ActiveWorkbook.SaveAs strCurrentDir & "\DellInventoryReport.xlsx"
objXL.Application.Quit

WScript.Echo "Script complete."

' ///////////////////////
' /// GetWarrantyInfo ///
' ///////////////////////

Sub GetWarrantyInfo
'Get SerialNumber (Service Tag)
      strURL = "http://support.dell.com/support/topics/global.aspx/support/my_systems_info/details?c=us&l=en&s=gen&ServiceTag=" & strServiceTag & "&~tab=1"      
      objHTTP.open "GET", strURL, False
      objHTTP.send
      strPageText = objHTTP.responseText
      For Each strHeading In arrHeadings
            intSummaryPos = InStr(LCase(strPageText), LCase(strHeading))
            If intSummaryPos > 0 Then
                  intSummaryTableStart = InStrRev(LCase(strPageText), "<table", intSummaryPos)
                  intSummaryTableEnd = InStr(intSummaryPos, LCase(strPageText), "</table>") + 8
                  strInfoTable = Mid(strPageText, intSummaryTableStart, intSummaryTableEnd - intSummaryTableStart)
                  strInfoTable = Replace(Replace(Replace(strInfoTable, VbCrLf, ""), vbCr, ""), vbLf, "")
                  arrCells = Split(strInfoTable, "</td>")
'                  arrCells = Split(LCase(strInfoTable), "</td>")
                  For intCell = LBound(arrCells) To UBound(arrCells)
                        arrCells(intCell) = Trim(arrCells(intCell))
                        intOpenTag = InStr(arrCells(intCell), "<")
                        While intOpenTag > 0
                              intCloseTag = InStr(intOpenTag, arrCells(intCell), ">") + 1
                              strNewCell = ""
                              If intOpenTag > 1 Then strNewCell = strNewCell & Trim(Left(arrCells(intCell), intOpenTag - 1))
                              If intCloseTag < Len(arrCells(intCell)) Then strNewCell = strNewCell & Trim(Mid(arrCells(intCell), intCloseTag))
                              arrCells(intCell) = Replace(Trim(strNewCell), " &nbsp;&nbsp;&nbsp;&nbsp;Change Service Tag","")
                              intOpenTag = InStr(arrCells(intCell), "<")
                              
                        Wend
                  Next
                  If LCase(arrCells(0)) = LCase("Service Tag:") Then
		  ' Parse Service tag, Ship Date
			' Service tag
 			objXL.ActiveCell.Value = arrCells(1)
			' System Type
 			objXL.ActiveCell.Offset(0,1).Value = arrCells(3)
			' Ship Date
 			objXL.ActiveCell.Offset(0,2).Value = arrCells(5)
			' Dell IBU
 			objXL.ActiveCell.Offset(0,3).Value = arrCells(7)

                  ElseIf LCase(arrCells(0)) = LCase("Description") Then
                  'WScript.Echo Join(arrCells, "|")
		  intRows = (intCell \ 5) - 1
		  ' Write specific support information (i.e. 4-hour on-site, etc)
		  ' First row of array will be "headings" info, so ignore
			For i = 1 to intRows
			' Description
 			objXL.ActiveCell.Offset(0,4).Value = arrCells((i * 5))
			' Provider
 			objXL.ActiveCell.Offset(0,5).Value = arrCells((i * 5) + 1)
			' Start Date
 			objXL.ActiveCell.Offset(0,6).Value = arrCells((i * 5) + 2)
			' End Date
 			objXL.ActiveCell.Offset(0,7).Value = arrCells((i * 5) + 3)
			' Days Left
 			objXL.ActiveCell.Offset(0,8).Value = arrCells((i * 5) + 4)
 			' Skip to next row
			objXL.ActiveCell.Offset(1,0).Activate
		        Next
                  End If
            End If
      Next
End Sub

'//////////////
'/ End Script /
'//////////////