Solved

Check Server Hostname Then DELL Warranty By Service Tags

Posted on 2011-03-21
21
1,235 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
 
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
How does a lexer and parser works 2 79
while loop over for loop 7 79
debug as  junit test 4 64
recursion example 16 70
Windows Script Host (WSH) has been part of Windows since Windows NT4. Windows Script Host provides architecture for building dynamic scripts that consist of a core object model, scripting hosts, and scripting engines. The key components of Window…
Having just graduated from college and entered the workforce, I don’t find myself always using the tools and programs I grew accustomed to over the past four years. However, there is one program I continually find myself reverting back to…R.   So …
The goal of the video will be to teach the user the difference and consequence of passing data by value vs passing data by reference in C++. An example of passing data by value as well as an example of passing data by reference will be be given. Bot…
The viewer will learn how to use the return statement in functions in C++. The video will also teach the user how to pass data to a function and have the function return data back for further processing.

762 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now