Dell Warranty

[Andrewjames]

Hi, hope someone can help

I have the following working function to retrieve the Dell "Ship Date" from the dell Website, which can be found here

This works fine when the Warranty info is formatted with one line stating
"Next Business Day"

however returns a null when the Warranty info has more than one line, for example

"Next Business Day"
"Dell Business Support / ProSupport"

Two example links

One Line

Two Lines

[/URL]

Function GetWarranty(ByVal strCurrentTag)
        Dim objHTTP, strPageText, strURL, strHeading
        Dim intSummaryPos, intSummaryTableStart, intSummaryTableEnd, strInfoTable, arrCells, intCell, intOpenTag, intClosetag
        'Dim strNewCell, strCurrentTag, i, intField
        Dim strNewCell, i, intField, strShipDate
        Dim arrHeadings() = {"Service Tag:", "Days Left"}
 
        objHTTP = CreateObject("Msxml2.XMLHTTP")
        Dim strField(400)
        strField(0) = Now
        strPageText = ""
        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=" & strCurrentTag & "&~tab=1"
        'strURL = "http://support.dell.com/support/topics/global.aspx/support/my_systems_info/details?c=us&l=en&s=k12&servicetag=" & strCurrentTag
        objHTTP.open("GET", strURL, False)
        objHTTP.send()
        strPageText = objHTTP.responseText
        'MsgBox(arrHeadings.Length)
 
        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), "<")
 
                    End While
                Next
 
                If LCase(arrCells(0)) = LCase("Service Tag:") Then
                    strCurrentTag = ""
 
                    i = 0
 
                    For intField = 1 To UBound(arrCells) Step 2
                        i = i + 1
                        strField(i) = arrCells(intField)
                    Next
 
                ElseIf LCase(arrCells(0)) = LCase("Description") Then
                    i = 0
 
                    For intField = 5 To UBound(arrCells)
                        strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
                        i = i + 1
                        strField(i) = arrCells(intField)
                    Next
                End If
 
            Else
 
                strShipDate = "No Info"
                Return strShipDate
 
                End
 
            End If
        Next
 
        strShipDate = strField(8)
 
        Return (strShipDate)
 
    End Function

[ForumAccount]

Try this (tested and worked for both links):

Imports System.Text.RegularExpressions
Imports System.Net

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, _
                              ByVal e As System.EventArgs) _
                              Handles Button1.Click
        MessageBox.Show("Ship Date: " & DellSite.GetShipDate("9rr7g4j"))
        MessageBox.Show("Ship Date: " & DellSite.GetShipDate("bh11y1j"))
    End Sub

End Class

Public Class DellSite

    '//fields
    Protected Shared ReadOnly ShipDatePattern As Regex
    Protected Shared ReadOnly BaseServiceUrl As String

    '//constructors
    Shared Sub New()
        DellSite.ShipDatePattern = New Regex("\>ship\s+date\:\<\/td\>\<[^>]*>(?<shipDate>\d*\/\d*\/\d*)\<", _
                                     RegexOptions.Compiled Or RegexOptions.IgnoreCase)
        DellSite.BaseServiceUrl = "http://support.dell.com/support/topics/global.aspx/support/my_systems_info/details?c=us&l=en&s=k12&servicetag="
    End Sub

    Private Sub New()
    End Sub

    '//methods
    ''' <summary>
    ''' Gets the ship date of the specified service tag.
    ''' </summary>
    ''' <param name="serviceTag">The service tag to get.</param>
    Public Shared Function GetShipDate(ByVal serviceTag As String) As String
        Using client = New WebClient()
            Dim source = client.DownloadString(String.Format("{0}{1}", _
                                               DellSite.BaseServiceUrl, serviceTag))
            If Not String.IsNullOrEmpty(source) Then
                Dim match = DellSite.ShipDatePattern.Match(source)
                If match.Success Then
                    Return match.Groups("shipDate").Value
                End If
            End If
        End Using
        Return String.Empty
    End Function

End Class

[Andrewjames]

Thanks ForumAccount

Using Webclient seems to have sorted it and looks much neater

i did have to have the following 2 lines but thats only because i sit behind a proxy server

client.Proxy = System.Net.WebRequest.DefaultWebProxy
client.Proxy.Credentials = stem.Net.CredentialCache.DefaultCredentials

thanks again