[API]
WSAGetLastError
closesocket
recv
RtlMoveMemory
LocalAlloc
LocalFree

[INCLUDE]
Winsock
UIntAddUInt
DoEventsEx_GetTickCount
DoEventsEx_IsTickCountElapsed

[DEFINE]
Private Type Winsock_HTTPReceiverBuffer
  hSocket As Long
  UsedBuffer As Long
  SizeBuffer As Long
  ptrBuffer As Long
  LastData As Long
  KnownHSize As Long
  KnownSize As Long
  KnownNextChunk As Long
  KnownNextData As Long
  ChunkQuTo As Long
  ChunkQuFrom As Long
  ChunkQuLen As Long
  Flags As Long
  TimeOut As Long
  End Type
Private Const Winsock_HTTPReceiverBufferLen As Long = 56&
Private Const Winsock_HTTPReceiverBufferInitSize As Long = 1024& * 1024&
Private Const Winsock_HTTPReceiverMaxHeaderSize As Long = 4096&

Public Enum WinSock_WSRACFlags
  ReceiveSizeOnly = 1&
  End Enum

[CODE]
Public Function Winsock_HTTPReceiver_Create(ByRef hSocket As Long, Optional ByVal Flags As WinSock_WSRACFlags, Optional ByVal TimeOut As Long = 4000&) As Long
  Dim xType1 As Winsock_HTTPReceiverBuffer

  If hSocket > 0& Then
    xType1.ptrBuffer = LocalAlloc(0&, Winsock_HTTPReceiverBufferInitSize)
    If Not xType1.ptrBuffer = 0& Then
      Winsock_HTTPReceiver_Create = LocalAlloc(0&, Winsock_HTTPReceiverBufferLen)
      If Not Winsock_HTTPReceiver_Create = 0& Then
        xType1.Flags = CLng(Flags)
        xType1.LastData = DoEventsEx_GetTickCount
        xType1.SizeBuffer = Winsock_HTTPReceiverBufferInitSize
        xType1.TimeOut = TimeOut
        xType1.hSocket = hSocket
        xType1.KnownSize = -2&
        Call RtlMoveMemory(ByVal Winsock_HTTPReceiver_Create, xType1, Winsock_HTTPReceiverBufferLen)
        hSocket = 0&
        Exit Function
        End If
      Call LocalFree(xType1.ptrBuffer)
      End If
    Call CloseSocket(hSocket)
    hSocket = 0&
    End If
  End Function

' ReturnSize: -2 = unknown / error, -1 = unknown (chunked / not provided by server), -x = future errors?
Public Function Winsock_HTTPReceiver_GetStatus(ByVal hReceiver As Long, Optional ByRef ReturnProgress As Long, Optional ByRef ReturnSize As Long) As Boolean
  Dim xLong1 As Long
  Dim xLong2 As Long
  Dim xLong3 As Long
  Dim xLong4 As Long
  'Dim xByte1 As Byte
  Dim xChar1 As String
  'Dim xChar2 As String
  Dim xSizeCurCheckHead As Long
  Dim xFoundHead As Long
  Dim xType1 As Winsock_HTTPReceiverBuffer
  Const Net_Max_Buffer_Length As Long = 4 * 8192&

  If Not hReceiver = 0& Then
    Call RtlMoveMemory(xType1, ByVal hReceiver, Winsock_HTTPReceiverBufferLen)
    If xType1.hSocket > 0& Then
      If xType1.UsedBuffer + Net_Max_Buffer_Length > xType1.SizeBuffer Then
        xType1.SizeBuffer = xType1.SizeBuffer * 2& + Net_Max_Buffer_Length
        xLong1 = LocalAlloc(0&, xType1.SizeBuffer)
        If xLong1 = 0& Then GoTo Failure
        Call RtlMoveMemory(ByVal xLong1, ByVal xType1.ptrBuffer, xType1.UsedBuffer)
        Call LocalFree(xType1.ptrBuffer)
        xType1.ptrBuffer = xLong1
        End If
  
      xLong1 = xType1.ptrBuffer
      UIntAddUInt xLong1, xType1.UsedBuffer
      xLong1 = recv(xType1.hSocket, ByVal xLong1, Net_Max_Buffer_Length, 0&)
      
      Select Case xLong1
        Case -1&
          xLong1 = WSAGetLastError
          Select Case xLong1
            Case 0&, 10036&, 10035&
              GoTo TimeOutCheck
            Case Else
              GoTo Failure
            End Select
            
        'Case 10036& 'WSAEINPROGRESS
        'Case 10035& 'WSAEWOULDBLOCK
        'Case 0&
        Case 0& ', 10036&, 10035&
          'TimeOut
TimeOutCheck:
          If DoEventsEx_IsTickCountElapsed(xType1.LastData, xType1.TimeOut) Then
            GoTo TimedOut
            End If
        Case Is > 0&
          xType1.UsedBuffer = xType1.UsedBuffer + xLong1
          xType1.LastData = DoEventsEx_GetTickCount
          If xType1.KnownHSize = 0& Then
            xSizeCurCheckHead = xType1.UsedBuffer
            If xSizeCurCheckHead > Winsock_HTTPReceiverMaxHeaderSize Then
              xSizeCurCheckHead = Winsock_HTTPReceiverMaxHeaderSize
              End If
            xChar1 = String(xSizeCurCheckHead, vbNullChar)
            Call RtlMoveMemory(ByVal xChar1, ByVal xType1.ptrBuffer, xSizeCurCheckHead)
            xLong1 = InStr(xChar1, vbCrLf)
            If Not xLong1 = 0& Then
              xLong2 = InStr(xChar1, " ")
              If xLong2 < xLong1 And Not xLong2 = 0& Then
                xLong2 = Val(Trim(Mid(xChar1, xLong2 + 1&, xLong1 - xLong2 - 1&)))
                If Not xLong2 = 200& Then
                  GoTo Failure
                  End If
                End If
              xFoundHead = InStr(xChar1, vbCrLf + vbCrLf)
              If Not xFoundHead = 0& Then
                xChar1 = Left(xChar1, xFoundHead - 1&)
                xLong2 = InStr(1&, xChar1, vbCrLf + "Content-Length: ", vbTextCompare)
                If xLong2 = 0& Then
                  If InStr(1&, xChar1, "Transfer-Encoding: chunked", vbTextCompare) = 0& Then GoTo Failure
                  xType1.KnownSize = -1&
                  xType1.KnownNextChunk = xFoundHead + 3&
                  xType1.KnownNextData = xFoundHead + 3&
                  xType1.KnownHSize = xFoundHead + 3&
                  If (xType1.Flags And WinSock_WSRACFlags.ReceiveSizeOnly) Then GoTo LengthSuccess
                  Else
                  xLong3 = InStr(xLong2 + 1, xChar1, vbCrLf)
                  If xLong3 = 0& Then GoTo Failure
                  xLong2 = Val(Trim(Mid(xChar1, xLong2 + 18, xLong3 - xLong2 - 18&)))
                  xType1.KnownHSize = xFoundHead + 3&
                  xType1.KnownSize = xLong2 + xFoundHead + 3&
                  If (xType1.Flags And WinSock_WSRACFlags.ReceiveSizeOnly) Then GoTo LengthSuccess
                  End If
                'If xType1.KnownHSize = 0& Then GoTo Incomplete
                End If
              If xSizeCurCheckHead = Winsock_HTTPReceiverMaxHeaderSize And xFoundHead = 0& Then GoTo Failure
              End If
            End If
          If Not xType1.KnownHSize = 0& Then
            If xType1.KnownNextChunk = 0& Then
              'Stop
              If xType1.KnownSize = xType1.UsedBuffer Then GoTo Success
              Else
TryNextChunk:
              xLong1 = xType1.UsedBuffer - xType1.KnownNextChunk
              If xLong1 > 2& Then
                If xLong1 > 64& Then xLong1 = 64&
                xChar1 = String(xLong1, vbNullChar)
                xLong2 = xType1.ptrBuffer
                UIntAddUInt xLong2, xType1.KnownNextChunk
                Call RtlMoveMemory(ByVal xChar1, ByVal xLong2, xLong1)
                xLong1 = InStr(xChar1, vbCrLf)
                If Not xLong1 = 0& Then
                  xLong2 = Val("&h" + Left(xChar1, xLong1 - 1&) + "&")
                  If Not xType1.ChunkQuLen = 0& Then
'                    Stop
                    UIntAddUInt xType1.ChunkQuTo, xType1.ptrBuffer
                    UIntAddUInt xType1.ChunkQuFrom, xType1.ptrBuffer
                    Call RtlMoveMemory(ByVal xType1.ChunkQuTo, ByVal xType1.ChunkQuFrom, xType1.ChunkQuLen)
                    End If
                  If xLong2 = 0& Then GoTo Success
                  'xType1.KnownNextChunk = xType1.KnownNextChunk
                  xType1.ChunkQuTo = xType1.KnownNextData
                  xType1.ChunkQuFrom = xType1.KnownNextChunk + xLong1 + 1&
                  xType1.ChunkQuLen = xLong2
                  xType1.KnownNextData = xType1.KnownNextData + xLong2
                  xType1.KnownNextChunk = xType1.KnownNextChunk + xLong2 + xLong1 + 3&
                  GoTo TryNextChunk
                  End If
                End If
              End If
            End If
        Case Else
Failure:
LengthSuccess:
TimedOut:
          Call LocalFree(xType1.ptrBuffer)
          xType1.ptrBuffer = 0&
Success:
          Winsock_HTTPReceiver_GetStatus = True
          Call CloseSocket(xType1.hSocket)
          xType1.hSocket = 0&
        End Select
      Call RtlMoveMemory(ByVal hReceiver, xType1, Winsock_HTTPReceiverBufferLen)
      Else
      Winsock_HTTPReceiver_GetStatus = True
      End If
'Stop
    ReturnProgress = xType1.UsedBuffer
    ReturnSize = xType1.KnownSize
    End If
  End Function

Public Sub Winsock_HTTPReceiver_Destroy(ByRef hReceiver As Long)
  Dim xType1 As Winsock_HTTPReceiverBuffer

  If Not hReceiver = 0& Then
    Call RtlMoveMemory(xType1, ByVal hReceiver, Winsock_HTTPReceiverBufferLen)
    If xType1.hSocket > 0& Then
      Call CloseSocket(xType1.hSocket)
      End If
    If Not xType1.ptrBuffer = 0& Then
      Call LocalFree(xType1.ptrBuffer)
      End If
    Call LocalFree(hReceiver)
    hReceiver = 0&
    End If
  End Sub
