on error resume next
arrHeadings = Array("Service Tag:", "Days Left")

Const intForReading = 1
Set objHTTP = CreateObject("Msxml2.XMLHTTP")
dim strField(400)
strfield(0) = Now
'strDetails = """Service Tag"",""System Type"",""Ship Date"",""Dell IBU"",""Description"",""Provider"",""Start Date"",""End Date"",""Days Left"""
'Get SerialNumber (Service Tag)
Set objSWbemServices = GetObject("winmgmts:\\.\root\cimv2")
  Set colSWbemObjectSet = objSWbemServices.ExecQuery("SELECT * FROM win32_bios")
  For Each objSWbemObject In colSWbemObjectSet
   strServicetag = objSWbemObject.SerialNumber
  Next
      strCurrentTag = ""
      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(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
                  'WScript.Echo Join(arrCells, "|")
                  If LCase(arrCells(0)) = LCase("Service Tag:") Then
                        'strCurrentTag = """" & strServiceTag & """"
                        strCurrentTag = ""
                        For intField = 1 To UBound(arrCells) Step 2
							i = i+1			
							strField(i) = arrCells(intField) 
                        Next
                  ElseIf LCase(arrCells(0)) = LCase("Description") Then
                        For intField = 5 To UBound(arrCells)
                              strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
						i = i+1			
						strField(i) = arrCells(intField) 
                        Next
                  End If
            Else
				  strField(2) = "No warranty information found."
            End If
      Next



Dim wbemCimtypeSint16
Dim wbemCimtypeSint32
Dim wbemCimtypeReal32
Dim wbemCimtypeReal64
Dim wbemCimtypeString
Dim wbemCimtypeBoolean
Dim wbemCimtypeObject
Dim wbemCimtypeSint8
Dim wbemCimtypeUint8
Dim wbemCimtypeUint16
Dim wbemCimtypeUint32
Dim wbemCimtypeSint64
Dim wbemCimtypeUint64
Dim wbemCimtypeDateTime
Dim wbemCimtypeReference
Dim wbemCimtypeChar16

wbemCimtypeSint16 = 2
wbemCimtypeSint32 = 3
wbemCimtypeReal32 = 4
wbemCimtypeReal64 = 5
wbemCimtypeString = 8
wbemCimtypeBoolean = 11
wbemCimtypeObject = 13
wbemCimtypeSint8 = 16
wbemCimtypeUint8 = 17
wbemCimtypeUint16 = 18
wbemCimtypeUint32 = 19
wbemCimtypeSint64 = 20
wbemCimtypeUint64 = 21
wbemCimtypeDateTime = 101
wbemCimtypeReference = 102
wbemCimtypeChar16 = 103
Set oLocation = CreateObject("WbemScripting.SWbemLocator")
'Remove classes
Set oServices = oLocation.ConnectServer(, "root\cimv2")
set oNewObject = oServices.Get("Warranty_Info")
oNewObject.Delete_

Set oServices = oLocation.ConnectServer(, "root\cimv2\SMS")
set oNewObject = oServices.Get("Warranty_Info")
oNewObject.Delete_

'Create data class structure
Set oServices = oLocation.ConnectServer(, "root\cimv2")

Set oDataObject = oServices.Get
oDataObject.Path_.Class = "Warranty_Info"
oDataObject.Properties_.add "DateScriptRan", wbemCimtypeString
oDataObject.Properties_.add "ServiceTag", wbemCimtypeString
oDataObject.Properties_.add "SystemType", wbemCimtypeString
oDataObject.Properties_.add "ShipDate", wbemCimtypeString
oDataObject.Properties_.add "Provider", wbemCimtypeString
oDataObject.Properties_.add "WarrantyExtension", wbemCimtypeString
oDataObject.Properties_.add "DellIBU", wbemCimtypeString
oDataObject.Properties_.add "Description", wbemCimtypeString
oDataObject.Properties_.add "StartDate", wbemCimtypeString
oDataObject.Properties_.add "EndDate", wbemCimtypeString
oDataObject.Properties_.add "DaysLeft", wbemCimtypeUint32
oDataObject.Properties_("Description").Qualifiers_.add "key", True
oDataObject.Put_

'WScript.Echo i & VbCrLf &  strField(i) & VbCrLf &  strField(i-1)
j = (i-5)/5

For k=0 To j-1

	Set oNewObject = oServices.Get("Warranty_Info").SpawnInstance_
	oNewObject.DateScriptRan = strfield(0)
	oNewObject.ServiceTag = strfield(1)
	oNewObject.SystemType = strfield(2)
	oNewObject.ShipDate = strfield(3)
	oNewObject.Provider = strfield(7+(k*6))
	oNewObject.WarrantyExtension = strfield(8+(k*6))
	oNewObject.DellIBU = strfield(4)
	oNewObject.Description = strfield(6+(k*6))
	oNewObject.StartDate = strfield(9+(k*6))
	oNewObject.EndDate = strfield(10+(k*6))
	oNewObject.DaysLeft = strfield(11+(k*6))
	oNewObject.Put_

Next



'Create reporting class structure
Set oServices = oLocation.ConnectServer(, "root\cimv2\SMS")
Set oRptObject = oServices.Get("SMS_Class_Template").SpawnDerivedClass_

'Set Class Name and Qualifiers
oRptObject.Path_.Class = "Warranty_Info"
oRptObject.Qualifiers_.Add "SMS_Report", True
oRptObject.Qualifiers_.Add "SMS_Group_Name", "Warranty Info"
oRptObject.Qualifiers_.Add "SMS_Class_ID", "CUSTOM|Warranty_Info|2.3"

oRptObject.Properties_.Add("DateScriptRan", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("ServiceTag", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("SystemType", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("ShipDate", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("Provider", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("WarrantyExtension", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("DellIBU", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("Description", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("StartDate", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("EndDate", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("DaysLeft", wbemCimtypeUint32).Qualifiers_.Add "SMS_Report", True
oRptObject.Put_

wscript.quit