Consume REST Web Service VB.NET and Compact Framework 3.5

A RESTful service functions in a similar fashion as a webpage does. Unfortunately, from what I can see, the WebClient class is not contained with CF, so you would have to resort to the HttpWebRequest and HttpWebResponse classes. Depending on the complexity of the service, it could be a simple as:

Imports System.Net
Imports System.IO

Module Module1

    Sub Main()
        Dim request As HttpWebRequest = HttpWebRequest.Create("http://host/path/to/RESTful/service")
        Dim response As HttpWebResponse

        request.Method = WebRequestMethods.Http.Get

        response = request.GetResponse()

        Using reader As New StreamReader(response.GetResponseStream())
            Console.WriteLine(reader.ReadToEnd())
        End Using

    End Sub

End Module

Select allOpen in new window

Was hoping to see a step or something in the code that I had missed..    The following code I have working on my laptop without any problems.   When I try to port it over to mobile device I am only able to send 2 records. I no longer get a response and triggers a timeout.  
To me it seems like some resource is not being released quick enough.  Any suggestions?


 Private Function SendREST(ByVal strCmd As String) As String

        '(string localFile, string uploadUrl)
        Dim strAction As String = "POST"
        Dim strUrl As String =  "WebAddress"

        Dim req As HttpWebRequest

        ''HttpWebRequest req = (HttpWebRequest)WebRequest.Create(uploadUrl);
        ''req.Method = "PUT";
        req = WebRequest.Create(strUrl)
        req.Method = "POST"
        req.AllowWriteStreamBuffering = True


        Dim htmlResponse, jsonResponse As String
        Dim client As New REST_Client

        lngStart = Date.Now.TimeOfDay.TotalMilliseconds

        client.MakeRequest(strUrl, strAction, strCmd, htmlResponse, jsonResponse)

        SendREST = jsonResponse
        lngEnd = Date.Now.TimeOfDay.TotalMilliseconds
        client = Nothing

    End Function

 Public Class REST_Client
        Public Sub MakeRequest(ByVal url As String, ByVal httpVerb As String, ByVal requestBody As String, ByRef htmlResponse As String, ByRef jsonResponse As String) ''As String

            Dim reponseAsString As String = ""

            Dim intHld As Integer
            Dim request = DirectCast(WebRequest.Create(url), HttpWebRequest)
            Try

                request.Method = httpVerb


                request.Timeout = intTO
                request.ContentType = "application/json"
                request.SendChunked = True
                ' request.ContentLength = bytearray.length

                SetBody(request, requestBody)


                Dim response = DirectCast(request.GetResponse(), HttpWebResponse)

                ConvertResponseToString(response, htmlResponse, jsonResponse)
            Catch ex As Exception
                If Err.Number <> 5 Then
                    MessageBox.Show(Err.Number.ToString & vbCrLf & Err.Description)
                Else
                    errNo = Err.Number
                    bTimeout = True
                End If
                ''Handle error as desired  

            Finally
                request = Nothing
                requestBody = Nothing
            End Try

        End Sub

        Private Sub SetBody(ByVal request As HttpWebRequest, ByVal requestBody As String)
            Try
                If requestBody.Length > 0 Then

                    Dim requeststream As Stream = request.GetRequestStream()
                    Dim writer As New StreamWriter(requeststream)
                    writer.Write(requestBody)


                    requeststream.Close()
                    requeststream.Dispose()
                    System.GC.Collect()

                    'Using requestStream As Stream = request.GetRequestStream()
                    'Using writer As New StreamWriter(requeststream)
                    ' writer.Write(requestBody)
                    'End Using
                    'requeststream.Close()
                    'requeststream.Dispose()
                    'End Using

                End If

            Catch ex As Exception
                If Err.Number <> 5 Then
                    MessageBox.Show(Err.Number.ToString & vbCrLf & Err.Description)
                Else
                    errNo = Err.Number
                    bTimeout = True
                End If
            End Try
        End Sub

        Private Sub ConvertResponseToString(ByVal response As HttpWebResponse, ByRef htmlResponse As String, ByRef jsonResponse As String) 'As String

            htmlResponse = "Status code: " & CInt(response.StatusCode) & " " & Convert.ToString(response.StatusCode) & " " & vbCr & vbLf
            Try

                For Each key As String In response.Headers.Keys
                    htmlResponse += String.Format("{0}: {1} " & vbCr & vbLf, key, response.Headers(key))
                Next

                jsonResponse = New StreamReader(response.GetResponseStream()).ReadToEnd()
            Catch ex As Exception
                MessageBox.Show(Err.Number.ToString & vbCrLf & Err.Description)

            End Try

        End Sub
    End Class

When I faced this problem, I did a little research, and ended with writing my own class for that. The request is composed simply by concatenation of request elements plus all the tags. Here's the piece that parses the response, see if it helps.

    Private Function ExtractElement(ByVal Source As String, ByVal Node As String) As Object
        Dim L As String, c1 As String = "", c2 As String = ""
        L = Split(Source, """" & Node & """:")(1)
        If L.StartsWith("""") Or L.StartsWith("{") Or L.StartsWith("[") Then
            c1 = Left(L, 1)
            If c1 = """" Then c2 = """"
            If c1 = "{" Then c2 = "}"
            If c1 = "[" Then c2 = "]"
            ExtractElement = Extr(L, c1, c2)
        Else
            ExtractElement = L.Split(",")(0)
        End If
        Exit Function
    End Function

    Private Function Extr(ByVal Str As String, ByVal Sep As String, ByVal ClosingSep As String) As String
        Dim Pos1 As Integer, Pos2 As Integer, cnt As Integer = 0
        For i = 1 To Len(Str)
            If Mid(Str, i, Len(ClosingSep)) = ClosingSep And cnt > 0 Then
                cnt = cnt - 1
                If cnt = 0 Then Pos2 = i
            ElseIf Mid(Str, i, Len(Sep)) = Sep Then
                If cnt = 0 Then Pos1 = i
                cnt = cnt + 1
            End If
            If cnt = 0 Then
                If Pos2 = 0 Then
                    Return ""
                Else
                    Return Mid(Str, Pos1 + Len(Sep), Pos2 - Len(Sep) - 1)
                End If
            End If
        Next i
        Return ""
    End Function

    Private Function ExtractArray(ByVal Source As String, ByVal Node As String) As Object
        Dim L As String, StartTag As String = "[", ClosingTag As String = "]", Cnt As Long = 0, i As Long, j As Long, j1 As Long
        If Not Source.StartsWith(",") Then Source = "," & Source
        L = Split(Source, ",""" & Node & """:")(1)
        ' find closing tag of starttag
        For i = 1 To Len(L)
            If Mid(L, i, 1) = StartTag Then Cnt += 1
            If Mid(L, i, 1) = ClosingTag Then Cnt -= 1
            If Cnt = 0 Then
                L = Mid(L, 2, i - 2)
                Dim r()
                ReDim r(0)
                ' find array members: comma-separated {...},{...},....
                For j = 1 To Len(L)
                    If Mid(L, j, 1) = "{" Then
                        Cnt = Cnt + 1
                        If Cnt = 1 Then j1 = j
                    End If
                    If Mid(L, j, 1) = "}" Then
                        Cnt = Cnt - 1
                        If Cnt = 0 Then
                            If r(UBound(r, 1)) <> "" Then ReDim Preserve r(UBound(r, 1) + 1)
                            r(UBound(r, 1)) = Mid(L, j1 + 1, j - j1 - 1)
                        End If
                    End If
                Next j
                Return r
                Exit Function
            End If
        Next i
        Return Nothing
    End Function

Select allOpen in new window

Answers provided did not fix my problem.   I know it was running out of resources, just assumed it was a problem with the garbage collector.   Tried adding the close in a few places that seemed logical and low and behold we have a solution

I won try