Solved

Check Server Hostname Then DELL Warranty By Service Tags

Posted on 2011-03-21
21
1,251 Views
Last Modified: 2012-08-14
Hoping the following two scripts can be combined to produce one output.  The first takes Host Names and returns Services Tags.  The second takes service tags and returns Dell Warranty information.  

Can this be done???

First script: http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23324842.html?sfQueryTermInfo=1+10+30+dell+servic+tag

Const strSourceFile = "c:\computers.txt"
Const strDestFile = "c:\output.txt"
Const ForReading = 1
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSourceFile = objFSO.OpenTextFile(strSourceFile, ForReading)
Set objDestFile = objFSO.CreateTextFile(strDestFile, True)
objDestFile.WriteLine("Computername       Service Tag")
 
Do While Not objSourceFile.AtEndOfStream
        strComputer = objSourceFile.ReadLine
        objDestFile.WriteLine(strComputer & "     " & GetSerial(strComputer))
Loop
objDestFile.Close
 
msgbox "done!"
 
 
Function GetSerial(strComputer)
        Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        Set colSMBIOS = objWMIService.ExecQuery _
        ("Select * from Win32_SystemEnclosure")
        
        GetSerial = ""
        For Each objSMBIOS in colSMBIOS
                GetSerial = objSMBIOS.SerialNumber
                Exit For
        Next
End Function

Open in new window


Second script: http://www.experts-exchange.com/Programming/Languages/Q_23096728.html?sfQueryTermInfo=1+10+30+dell+warranti and works like a charm!

'========================
strInputFile = "DellServiceTags.txt"
strOutputFile = "Results.csv"

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

Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Set objHTTP = CreateObject("Msxml2.XMLHTTP")

strDetails = """Service Tag"",""System Type"",""Ship Date"",""Dell IBU"",""Description"",""Provider"",""Start Date"",""End Date"",""Days Left"""
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
While Not objInputFile.AtEndOfStream
      strServiceTag = objInputFile.ReadLine
      strCurrentTag = ""
      strURL = "http://supportapj.dell.com/support/topics/topic.aspx/ap/shared/support/my_systems_info/en/details?c=in&cs=inbsd1&l=en&s=bsd&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
                              If strCurrentTag = "" Then
                                    strCurrentTag = """" & arrCells(intField) & """"
                              Else
                                    strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
                              End If
                        Next
                  ElseIf LCase(arrCells(0)) = LCase("Description") Then
                        For intField = 5 To UBound(arrCells)
                              strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
                        Next
                  End If
            Else
                  strCurrentTag = """" & strServiceTag & """,""No warranty information found."""
            End If
      Next
      strDetails = strDetails & VbCrLf & strCurrentTag
Wend
objInputFile.Close
Set objInputFile = Nothing

Set objOutputFile = objFSO.CreateTextFile(strOutputFile, True)
objOutputFile.Write strDetails
objOutputFile.Close
Set objOutputFile = Nothing
Set objFSO = Nothing

MsgBox "Done. Please see " & strOutputFile
'========================

Open in new window


Thanks!
0
Comment
Question by:dssbbp
  • 11
  • 8
  • 2
21 Comments
 
LVL 15

Expert Comment

by:David L. Hansen
ID: 35185253
How about this:
http://community.spiceworks.com/how_to/show/197

It uses a third party app but it is freeware.
0
 

Author Comment

by:dssbbp
ID: 35185393
Thanks sl8rz but freeware isn't allowed...  :(
0
 
LVL 15

Expert Comment

by:David L. Hansen
ID: 35185528
They have a purchase option that removes the ads.
0
Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

 
LVL 65

Expert Comment

by:RobSampson
ID: 35185972
Hi, I can't test this at the moment....see if this works.

Regards,

Rob.
Const strSourceFile = "computers.txt"
Const strDestFile = "warrantyinfo.csv"
Const ForReading = 1
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSourceFile = objFSO.OpenTextFile(strSourceFile, ForReading)
Set objDestFile = objFSO.CreateTextFile(strDestFile, True)
objDestFile.WriteLine """Computername"",""Service Tag"",""System Type"",""Ship Date"",""Dell IBU"",""Description"",""Provider"",""Start Date"",""End Date"",""Days Left"""
 
Do While Not objSourceFile.AtEndOfStream
	strComputer = objSourceFile.ReadLine
	If Ping(strComputer) = True Then
		strSerialNumber = GetSerial(strComputer)
		objDestFile.WriteLine """" & strComputer & """,""" & strSerialNumber & """," & GetWarrantyInfo(strSerialNumber)
	Else
		objDestFile.WriteLine """" & strComputer & """,""OFFLINE"""
	End If
Loop
objDestFile.Close
 
MsgBox "done!"
 
Function GetSerial(strComputer)
	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set colSMBIOS = objWMIService.ExecQuery("Select * from Win32_SystemEnclosure")
	GetSerial = ""
	For Each objSMBIOS in colSMBIOS
		GetSerial = objSMBIOS.SerialNumber
		Exit For
	Next
End Function

Function GetWarrantyInfo(strServiceTag)
	arrHeadings = Array("Service Tag:", "Days Left")
	Set objHTTP = CreateObject("Msxml2.XMLHTTP")
	'strDetails = """Service Tag"",""System Type"",""Ship Date"",""Dell IBU"",""Description"",""Provider"",""Start Date"",""End Date"",""Days Left"""
	strCurrentTag = ""
	strURL = "http://supportapj.dell.com/support/topics/topic.aspx/ap/shared/support/my_systems_info/en/details?c=in&cs=inbsd1&l=en&s=bsd&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
					If strCurrentTag = "" Then
						strCurrentTag = """" & arrCells(intField) & """"
					Else
						strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
					End If
				Next
			ElseIf LCase(arrCells(0)) = LCase("Description") Then
				For intField = 5 To UBound(arrCells)
					strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
				Next
			End If
		Else
			strCurrentTag = """" & strServiceTag & """,""No warranty information found."""
		End If
	Next
	'strDetails = strDetails & VbCrLf & strCurrentTag
	strDetails = strCurrentTag
	GetWarrantyInfo = strDetails
End Function

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
 

Author Comment

by:dssbbp
ID: 35193036
Rob,
The script didn't work.  It triggered our HBSS that cscript was trying to:

Create an object at:
"HKLM\SOFTWARE\Network Associates\ePolicy Orchestrator\*"

HIPS will stop any program from writing to this area of the registry to protect its self. When HIPS is on, this same area of the registry will show as empty.

And the second entry at the same time that said it also blocked CScript because it attempted to open c:\programdata\mcafee\common framework\*

Also an area protected by HIPS.  

I have no idea why the code did that... I can't find anything in the code that even looks remotely close???
0
 

Author Comment

by:dssbbp
ID: 35193250
Maybe you could us this code for the second part.  I know it works.......


'========================
strInputFile = "DellServiceTags.txt"
strOutputFile = "Results.csv"

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

Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Set objHTTP = CreateObject("Msxml2.XMLHTTP")

strDetails = """Service Tag"",""System Type"",""Ship Date"",""Dell IBU"",""Description"",""Provider"",""Start Date"",""End Date"",""Days Left"""
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
While Not objInputFile.AtEndOfStream
      strServiceTag = objInputFile.ReadLine
      strCurrentTag = ""
      strURL = "http://supportapj.dell.com/support/topics/topic.aspx/ap/shared/support/my_systems_info/en/details?c=in&cs=inbsd1&l=en&s=bsd&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
                              If strCurrentTag = "" Then
                                    strCurrentTag = """" & arrCells(intField) & """"
                              Else
                                    strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
                              End If
                        Next
                  ElseIf LCase(arrCells(0)) = LCase("Description") Then
                        For intField = 5 To UBound(arrCells)
                              strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
                        Next
                  End If
            Else
                  strCurrentTag = """" & strServiceTag & """,""No warranty information found."""
            End If
      Next
      strDetails = strDetails & VbCrLf & strCurrentTag
Wend
objInputFile.Close
Set objInputFile = Nothing

Set objOutputFile = objFSO.CreateTextFile(strOutputFile, True)
objOutputFile.Write strDetails
objOutputFile.Close
Set objOutputFile = Nothing
Set objFSO = Nothing

MsgBox "Done. Please see " & strOutputFile
'========================

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35196170
Ok, I think I discovered the problem.  Whenever I used the MSXML2.XMLHTTP object, and then put in any objShell.Run command, it spits chips.  There must be some sort of virus signature that uses the same behaviour!  How annoying!

Anyway, this appears to work.

Regards,

Rob.
Const strSourceFile = "computers.txt"
Const strDestFile = "Results.csv"
Const ForReading = 1

Set objHTTP = CreateObject("Msxml2.XMLHTTP")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSourceFile = objFSO.OpenTextFile(strSourceFile, ForReading)
Set objDestFile = objFSO.CreateTextFile(strDestFile, True)
objDestFile.WriteLine """Computer"",""Service Tag"",""System Type"",""Ship Date"",""Dell IBU"",""Description"",""Provider"",""Start Date"",""End Date"",""Days Left"""

Do While Not objSourceFile.AtEndOfStream
	strComputer = objSourceFile.ReadLine
	If Ping(strComputer) = True Then
		strSerial = GetSerial(strComputer)
		objDestFile.Write """" & strComputer & ""","
		objDestFile.WriteLine GetServiceTagWararntyDetails(strServiceTag)
	End If
Loop
objDestFile.Close

MsgBox "done!"

Function GetSerial(strComputer)
        Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        Set colSMBIOS = objWMIService.ExecQuery _
        ("Select * from Win32_SystemEnclosure")
        
        GetSerial = ""
        For Each objSMBIOS in colSMBIOS
                GetSerial = objSMBIOS.SerialNumber
                Exit For
        Next
End Function

Function Ping(sName)
	Set cPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & sName & "'")
	For Each oPingResult In cPingResults
		If oPingResult.StatusCode = 0 Then
			Ping = True
		Else
			Ping = False
		End If
	Next
End Function

Function GetServiceTagWararntyDetails(strServiceTag)
	arrHeadings = Array("Service Tag:", "Days Left")
	strCurrentTag = ""
	strURL = "http://supportapj.dell.com/support/topics/topic.aspx/ap/shared/support/my_systems_info/en/details?c=in&cs=inbsd1&l=en&s=bsd&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
					If strCurrentTag = "" Then
						strCurrentTag = """" & arrCells(intField) & """"
					Else
						strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
					End If
				Next
			ElseIf LCase(arrCells(0)) = LCase("Description") Then
				For intField = 5 To UBound(arrCells)
					strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
				Next
			End If
		Else
			strCurrentTag = """" & strServiceTag & """,""No warranty information found."""
		End If
	Next
    GetServiceTagWararntyDetails = strCurrentTag  
End Function

Open in new window

0
 

Author Comment

by:dssbbp
ID: 35197996
That's better but I did get this:
C:\dellwarranty.vbs (25,9) Microsoft VBScript runtime error: Permission denied: 'GetObject'

And in the .csv file all of the host names were there but in the "System Type" for all computers it has:
No warranty information found.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35204379
OK, try this detect the GetObject error.  That happens when a computer is either offline (which we're testing, so it's not that), or WMI has issues on the remote machine that will now display the error in the CSV.

Regards,

Rob.
Const strSourceFile = "computers.txt"
Const strDestFile = "Results.csv"
Const ForReading = 1

Set objHTTP = CreateObject("Msxml2.XMLHTTP")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSourceFile = objFSO.OpenTextFile(strSourceFile, ForReading)
Set objDestFile = objFSO.CreateTextFile(strDestFile, True)
objDestFile.WriteLine """Computer"",""Service Tag"",""System Type"",""Ship Date"",""Dell IBU"",""Description"",""Provider"",""Start Date"",""End Date"",""Days Left"""

Do While Not objSourceFile.AtEndOfStream
	strComputer = objSourceFile.ReadLine
	If Ping(strComputer) = True Then
		strSerial = GetSerial(strComputer)
		objDestFile.Write """" & strComputer & ""","
		If Left(strSerial, 6) = "Error " Then
			objDestFile.WriteLine """" & strSerial & """"
		Else
			objDestFile.WriteLine GetServiceTagWararntyDetails(strServiceTag)
		End If
	End If
Loop
objDestFile.Close

MsgBox "Done. Please see " & strDestFile

Function GetSerial(strComputer)
        On Error Resume Next
        Err.Clear
        Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        If Err.Number = 0 Then
	        Set colSMBIOS = objWMIService.ExecQuery _
	        ("Select * from Win32_SystemEnclosure")
	        
	        GetSerial = ""
	        For Each objSMBIOS in colSMBIOS
	                GetSerial = objSMBIOS.SerialNumber
	                Exit For
	        Next
	    Else
	    	intErr = Err.Number
	    	strErr = Err.Description
	    	Err.Clear
	    	On Error GoTo 0
	    	GetSerial = "Error " & intErr & ": " & strErr
	    End If
End Function

Function Ping(sName)
	Set cPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & sName & "'")
	For Each oPingResult In cPingResults
		If oPingResult.StatusCode = 0 Then
			Ping = True
		Else
			Ping = False
		End If
	Next
End Function

Function GetServiceTagWararntyDetails(strServiceTag)
	arrHeadings = Array("Service Tag:", "Days Left")
	strCurrentTag = ""
	strURL = "http://supportapj.dell.com/support/topics/topic.aspx/ap/shared/support/my_systems_info/en/details?c=in&cs=inbsd1&l=en&s=bsd&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
					If strCurrentTag = "" Then
						strCurrentTag = """" & arrCells(intField) & """"
					Else
						strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
					End If
				Next
			ElseIf LCase(arrCells(0)) = LCase("Description") Then
				For intField = 5 To UBound(arrCells)
					strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
				Next
			End If
		Else
			strCurrentTag = """" & strServiceTag & """,""No warranty information found."""
		End If
	Next
    GetServiceTagWararntyDetails = strCurrentTag  
End Function

Open in new window

0
 

Author Comment

by:dssbbp
ID: 35206278
Rob,
I got the same results except for two Dell Servers and I got the following error messages on them:

Error -2147217406:
Error 462: The remote server machine does not exist or is unavailable

Both are online and in AD.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35210880
Does your original script 1 pull the service for those correctly?
0
 

Author Comment

by:dssbbp
ID: 35210939
Rob... I'm sorry... It doesn't.  For my blades it's providing the same ST for each of them.  However... this code does pull them correctly but it also pulls the Host Name, ST, Maker, Type.

Const ADS_SCOPE_SUBTREE = 2
On Error Resume Next

' ------ SET OUTPUT FILES ------
OutputFile="Computers_Servicetag.txt"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.CreateTextFile(OutputFile, True)


Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 

objCommand.CommandText = _
    "SELECT ADsPath FROM 'LDAP://ou=servers,ou=enterprise,ou=netcom,ou=hood,ou=installations,dc=nasw,dc=ds,dc=army,dc=mil' WHERE " & _
        "objectCategory='Computer'"  
x=0
Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst
Do Until objRecordSet.EOF
Set objComputer = GetObject(objRecordSet.Fields("ADsPath").Value)
strComputer = Ucase(objComputer.CN)

ReDim Preserve arrADComputers(x)
arrADComputers(x) = strComputer
x=x+1

objRecordSet.MoveNext
Loop

For Each objADComputer in arrADComputers


	If Ping(objADComputer) = True Then


Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & objADComputer & "\root\cimv2")
  Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
  Set colSMBIOS = objWMIService.ExecQuery("SELECT * FROM Win32_BIOS")
  For Each objItem in colItems
  strResult = UCase(objItem.Manufacturer) & "," & UCase(objItem.Model)
  Next
  For Each objSMBIOS in colSMBIOS
  oFile.WriteLine objADComputer & "," & objSMBIOS.SerialNumber & "," & strResult
  Next
  

End If

Next


Function Ping(objADComputer)
sHost = "."
Set cPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//" & _
		sHost & "/root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus " & _
		"WHERE Address = '" + objADComputer + "'")

For Each oPingResult In cPingResults
	If oPingResult.StatusCode = 0 Then
			Ping = True
	Else
			Ping = False
	End If
Next
End Function


wscript.echo "Done"

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35212121
Oh right, so it looks like the only difference between that and the script I provided is that you need to change this line from my code:
              Set colSMBIOS = objWMIService.ExecQuery _
              ("Select * from Win32_SystemEnclosure")

to this
              Set colSMBIOS = objWMIService.ExecQuery _
              ("Select * from Win32_BIOS")

Simple.  Hopefully that works better for you now.

Regards,

Rob.
0
 

Author Comment

by:dssbbp
ID: 35214748

Still no luck... Here's what's in the .csv file:

Computer: Shows the name of the servers
Service Tag: blank
System Type:  No warranty information found.
All of the rest: blank
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35220494
OK, that's odd.  I'll have to test on my environment on Monday.  It is strange though, you can see in the code you posted last that it queries the SerialNumber property of the Win32_BIOS class, and the code I posted queries the SerialNumber propert of the Win32_SystemEnclosure class, so it should have worked with the change from SystemEnclosure to BIOS....

Rob.
0
 

Author Comment

by:dssbbp
ID: 35223937
Thanks Rob!  Have a good weekend.
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 35236809
Oh doh!!

The URL wasn't being formed correctly because the service tag wasn't written into it.  Therefore, it would have been pulling the information for the last service tag you manually saved at that page.

So, to fix that, change this:
                  objDestFile.WriteLine GetServiceTagWararntyDetails(strServiceTag)

to this
                  objDestFile.WriteLine GetServiceTagWararntyDetails(strSerial)

and you should be good to go.

Regards,

Rob.
0
 

Author Comment

by:dssbbp
ID: 35240777
SWEETNESS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Thank you so much!
0
 

Author Closing Comment

by:dssbbp
ID: 35240788
Rob thank you so much for helping others!
0
 

Author Comment

by:dssbbp
ID: 35240792
For anyone else or maybe me later... Here is the complete accepted code:

Const strSourceFile = "computers.txt"
Const strDestFile = "Results.csv"
Const ForReading = 1

Set objHTTP = CreateObject("Msxml2.XMLHTTP")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSourceFile = objFSO.OpenTextFile(strSourceFile, ForReading)
Set objDestFile = objFSO.CreateTextFile(strDestFile, True)
objDestFile.WriteLine """Computer"",""Service Tag"",""System Type"",""Ship Date"",""Dell IBU"",""Description"",""Provider"",""Start Date"",""End Date"",""Days Left"""

Do While Not objSourceFile.AtEndOfStream
	strComputer = objSourceFile.ReadLine
	If Ping(strComputer) = True Then
		strSerial = GetSerial(strComputer)
		objDestFile.Write """" & strComputer & ""","
		If Left(strSerial, 6) = "Error " Then
			objDestFile.WriteLine """" & strSerial & """"
		Else
			objDestFile.WriteLine GetServiceTagWararntyDetails(strSerial)
		End If
	End If
Loop
objDestFile.Close

MsgBox "Done. Please see " & strDestFile

Function GetSerial(strComputer)
        On Error Resume Next
        Err.Clear
        Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        If Err.Number = 0 Then
	        Set colSMBIOS = objWMIService.ExecQuery _
	        ("Select * from Win32_BIOS")
	        
	        GetSerial = ""
	        For Each objSMBIOS in colSMBIOS
	                GetSerial = objSMBIOS.SerialNumber
	                Exit For
	        Next
	    Else
	    	intErr = Err.Number
	    	strErr = Err.Description
	    	Err.Clear
	    	On Error GoTo 0
	    	GetSerial = "Error " & intErr & ": " & strErr
	    End If
End Function

Function Ping(sName)
	Set cPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & sName & "'")
	For Each oPingResult In cPingResults
		If oPingResult.StatusCode = 0 Then
			Ping = True
		Else
			Ping = False
		End If
	Next
End Function

Function GetServiceTagWararntyDetails(strServiceTag)
	arrHeadings = Array("Service Tag:", "Days Left")
	strCurrentTag = ""
	strURL = "http://supportapj.dell.com/support/topics/topic.aspx/ap/shared/support/my_systems_info/en/details?c=in&cs=inbsd1&l=en&s=bsd&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
					If strCurrentTag = "" Then
						strCurrentTag = """" & arrCells(intField) & """"
					Else
						strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
					End If
				Next
			ElseIf LCase(arrCells(0)) = LCase("Description") Then
				For intField = 5 To UBound(arrCells)
					strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
				Next
			End If
		Else
			strCurrentTag = """" & strServiceTag & """,""No warranty information found."""
		End If
	Next
    GetServiceTagWararntyDetails = strCurrentTag  
End Function

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35244548
Great.  Thanks for the grade.  Sorry about the typos....

Regards,

Rob.
0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Navigation is an important part of web design from a usability perspective. But it is often a pain when it comes to a developer’s perspective. By navigation, it often means menuing. This is less theory and more practical of how to get a specific gro…
This article will show, step by step, how to integrate R code into a R Sweave document
This tutorial will introduce the viewer to VisualVM for the Java platform application. This video explains an example program and covers the Overview, Monitor, and Heap Dump tabs.
The goal of the video will be to teach the user the concept of local variables and scope. An example of a locally defined variable will be given as well as an explanation of what scope is in C++. The local variable and concept of scope will be relat…

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question