Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1282
  • Last Modified:

Check Server Hostname Then DELL Warranty By Service Tags

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
dssbbp
Asked:
dssbbp
  • 11
  • 8
  • 2
1 Solution
 
David L. HansenProgrammer AnalystCommented:
How about this:
http://community.spiceworks.com/how_to/show/197

It uses a third party app but it is freeware.
0
 
dssbbpAuthor Commented:
Thanks sl8rz but freeware isn't allowed...  :(
0
 
David L. HansenProgrammer AnalystCommented:
They have a purchase option that removes the ads.
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
RobSampsonCommented:
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
 
dssbbpAuthor Commented:
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
 
dssbbpAuthor Commented:
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
 
RobSampsonCommented:
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
 
dssbbpAuthor Commented:
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
 
RobSampsonCommented:
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
 
dssbbpAuthor Commented:
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
 
RobSampsonCommented:
Does your original script 1 pull the service for those correctly?
0
 
dssbbpAuthor Commented:
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
 
RobSampsonCommented:
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
 
dssbbpAuthor Commented:

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
 
RobSampsonCommented:
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
 
dssbbpAuthor Commented:
Thanks Rob!  Have a good weekend.
0
 
RobSampsonCommented:
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
 
dssbbpAuthor Commented:
SWEETNESS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Thank you so much!
0
 
dssbbpAuthor Commented:
Rob thank you so much for helping others!
0
 
dssbbpAuthor Commented:
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
 
RobSampsonCommented:
Great.  Thanks for the grade.  Sorry about the typos....

Regards,

Rob.
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

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.

  • 11
  • 8
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now