ReceiveHTTPMemory simple and crossplattform

[ts-soft]

Code: Select all

EnableExplicit

;====================== ReceiveHTTPMemory ============================
;  Author:                Thomas Schulz (ts-soft)
;  Date:                  January 13, 2011
;  Target OS:             All
;  Target Compiler:       Requires PureBasic 4.xx
;=====================================================================

Procedure.i ReceiveHTTPMemory(URL.s, BufferSize = 4096, Timeout = 5000, Port = 80)
  Protected Connection, Time, Time2, Event, Size = 1, Size2, SizeAll, pos
  Protected.s Server
  Protected *Mem, *Buffer, *Mem2
  
  If LCase(Left(URL, 7)) <> "http://" : URL = "http://" + URL : EndIf
  Server = GetURLPart(URL, #PB_URL_Site)
  If Server = "" : ProcedureReturn #False : EndIf
  Connection = OpenNetworkConnection(Server, Port, #PB_Network_TCP)
  If Not Connection : ProcedureReturn #False : EndIf
  If BufferSize <= 0 : BufferSize = 4096 : EndIf
  *Buffer = AllocateMemory(BufferSize)
  If Not *Buffer : ProcedureReturn #False : EndIf

  SendNetworkString(Connection, "GET " + URL + " HTTP/1.0" + #CRLF$ + #CRLF$)
  Time = ElapsedMilliseconds()
  Repeat
    Event = NetworkClientEvent(Connection)
    If Event = #PB_NetworkEvent_Data
      Repeat
        Size = ReceiveNetworkData(Connection, *Buffer, BufferSize)
        If Size > 0
          Time = ElapsedMilliseconds()
          SizeAll + Size
          *Mem = ReAllocateMemory(*Mem, SizeAll)
          If *Mem
            CopyMemory(*Buffer, *Mem + (SizeAll - Size), Size)
          Else
            CloseNetworkConnection(Connection)
            FreeMemory(*Buffer)
            ProcedureReturn #False
          EndIf
        EndIf
      Until Size <= 0
    EndIf
    Time2 = ElapsedMilliseconds() - Time
  Until Time2 > Timeout Or Size <= 0
  CloseNetworkConnection(Connection)
  FreeMemory(*Buffer)
  If Time2 > Timeout
    If *Mem : FreeMemory(*Mem) : EndIf
    ProcedureReturn #False
  EndIf
  pos = FindString(PeekS(*mem, -1, #PB_UTF8), #CRLF$ + #CRLF$, 1) - 1
  pos = Len(#CRLF$ + #CRLF$) + pos
  Size2 = MemorySize(*Mem) - pos
  *Mem2 = AllocateMemory(Size2)
  If *Mem2
    CopyMemory(*Mem + pos, *Mem2, Size2)
    FreeMemory(*Mem)
    ProcedureReturn *Mem2
  EndIf
  FreeMemory(*Mem)
  ProcedureReturn #False
EndProcedure

; example windows only
InitNetwork()
Define *mem
*mem = ReceiveHTTPMemory("http://www.realsource.de/images/favicon.ico")
If *mem
  If CatchImage(0, *mem)
    FreeMemory(*mem)
    OpenWindow(0, #PB_Ignore, #PB_Ignore, 640, 480, "test", #PB_Window_SystemMenu)
    SendMessage_(WindowID(0), #WM_SETICON, 0, ImageID(0))
    Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
  EndIf
EndIf

greetings - Thomas

// edit
small bugfix

// edit2
some more changes to make it more bulletproof

// edit 3
The case of url no more changed

// edit 4
small update to support PB5.10

[infratec]

Hi Thomas,

thank you very much.
I did nearly the same thing but only for getting special websites and not so generic.

2 Points:

1. According the RFC it is CRLF and not LFCR don't know why it works correct.
2. I prefer when I have the target memory 'external' (*memory and size as parameter)
Because than I can also free it if it is not used anymore.

But your version is more userfriendly

Bernd

[TomS]

1. According the RFC it is CRLF and not LFCR don't know why it works correct.

I think, it works because it's not a windows server.
Afaik it's LF on Unix, CR on Mac and CR LF on Windows. So this might fail on a windows server (Apache for windows probably accounted for that and works with LF alone, too).
It does not fail on Unix and Mac, because they ignore the char, that's not the control char on their OS.
It's like opening a unix text file on windows. No Linefeeds whatsover. The other way round it works, because unix ignores the CR and creates a new line upon LF.

[ts-soft]

you are welcome

@infratec
to point 1: it's by me
to point2: you can free the memory, see example

@Toms
the favicon comes from realsource.de. this is a windows Server (Windows-Server 2003 x64)

[TomS]

Yeah, I said it might^^
They're designing their servers like they're designing their browser. They just accept anything that makes kinda sense, regardless of w3c's or other gloabally agreed upon rules.

[Marlin]

1. According the RFC it is CRLF and not LFCR don't know why it works correct.

I think, it works because it's not a windows server.
Afaik it's LF on Unix, CR on Mac and CR LF on Windows. So this might fail on a windows server

No, I believe, it worked (if so) because the server was programmed in a way that could
tolerate such a deviation.

Request-Line = Method SP Request-URI SP HTTP-Version CRLF

It's supposed to be CRLF,
otherwise clients would need to know what OS the server is running before sending requests.

[ts-soft]

a crossplattform example:

Code: Select all

If InitSound() = 0
  MessageRequester("Error", "Can't initialize sound playback !", 0) 
  End
EndIf

If InitNetwork() = 0
  MessageRequester("Error", "Can't initialize network !", 0) 
  End
EndIf

Define *Mem = ReceiveHTTPMemory("http://realsource.de/tmp/popc0rn.xm")
If *Mem
  If CatchModule(0, *Mem, MemorySize(*Mem))
    PlayModule(0)
    MessageRequester("popc0rn.xm", "Press okay to stop!")
  EndIf
  FreeMemory(*Mem)
EndIf

[netmaestro]

Nice work! Quite useful, thanks for sharing it.

[C64]

The code should allow for "https://" URLs too.

[DoubleDutch]

I think that https may be slightly more compicated.

[ultralazor]

I use CRLF both with IIS and Apache on Linux.

BTW this can all be done by making your own headers; which is extremely easy for HTTP, and using raw net send. I made my own generic POST in very little code and even encrypt the variables.

Code: Select all

Procedure.s http_post(action$)
  cid = OpenNetworkConnection(server_address$,80,#PB_Network_TCP)
  If cid
    hdr$ = "POST /game/ HTTP/1.1"+Chr(13)+Chr(10)
    hdr$ + "Accept: */*"+Chr(13)+Chr(10)
    hdr$ + "Host: "+server_address$+Chr(13)+Chr(10)
    hdr$ + "User-Agent: Beta/1.0"+Chr(13)+Chr(10)
    hdr$ + "Content-Length: "+Str(Len(action$))+Chr(13)+Chr(10)
    hdr$ + "Content-Type: application/x-www-form-urlencoded"+Chr(13)+Chr(10)
    hdr$ + Chr(13)+Chr(10)
    While SendNetworkData(cid,@hdr$,Len(hdr$)) = -1
      Delay(100)
      counter+1
      If counter = 4
        counter = 0
        Break
      EndIf
    Wend
    While SendNetworkData(cid,@action$,Len(action$)) = -1
      Delay(100)
      counter+1
      If counter = 4
        counter = 0
        Break
      EndIf
    Wend
    buffer$ = Space(14000)
    Repeat
      Delay(700) ; may need to be set higher for long response times
      If NetworkClientEvent(cid) = #PB_NetworkEvent_Data
        ReceiveNetworkData(cid,@buffer$,Len(buffer$))
        packet$ + buffer$
      Else
        exit+1
      EndIf
    Until exit=4
    ;this strips the header and spare buffer:
    packet$ = Right(packet$,Len(packet$)-(FindString(packet$,Chr(13)+Chr(10)+Chr(13),1)+3))
    packet$ = Trim(packet$," ")
    CloseNetworkConnection(cid)
    ProcedureReturn packet$
  Else
    ;unable to connect
    ProcedureReturn "0"
  EndIf

[Kwai chang caine]

@TsSoft
Thanks a lot for sharing, especially the second with music

You are really great...even my cats dancing on popcorn

[C64]

I think that https may be slightly more compicated.

So we can't get a page like this to memory: https://vr.shapeservices.com
Or PayPal, or any other given home page that starts with "https://" ?

[beo6]

Hi everyone.

I just added a possibility to send Cookies and Post data with the function from ts-soft.
I know it is just a small addition and even then it is not completely from me.

Code: Select all

  Procedure.i ReceiveHTTPMemory(URL.s, _Data$, _Cookie$, BufferSize = 4096, Timeout = 5000)
    Protected Connection, Time, Time2, Event, Size, Size2, SizeAll, pos
    Protected.s Server
    Protected String$
    Protected *Mem, *Buffer, *Mem2
    Size = 1
  
    If LCase(Left(URL, 7)) <> "http://" : URL = "http://" + URL : EndIf
    Server = GetURLPart(URL, #PB_URL_Site)
    If Not Server : ProcedureReturn #False : EndIf
    Connection = OpenNetworkConnection(Server, 80, #PB_Network_TCP)
    If Not Connection : ProcedureReturn #False : EndIf
    If BufferSize <= 0 : BufferSize = 4096 : EndIf
    *Buffer = AllocateMemory(BufferSize)
    If Not *Buffer : ProcedureReturn #False : EndIf
    
    
    ;Build header
      
    If _Data$ <> ""
      String$ + "POST " + URL + " HTTP/1.1" + #CRLF$
      String$ + "Content-Length: " + Str(Len(_Data$)) + #CRLF$
    Else
      String$ + "GET " + URL + " HTTP/1.1" + #CRLF$
    EndIf
  
    String$ + "Host: " + Server + #CRLF$
    If _Cookie$ <> ""
      String$ + "Cookie: " + _Cookie$ + #CRLF$
    EndIf
    String$ + "Content-Type: application/x-www-form-urlencoded" + #CRLF$
    String$ + "Connection: close" + #CRLF$
    String$ + #CRLF$
    ; header is finished
    
    String$ + _Data$ + #CRLF$
    
  
    ;SendNetworkString(Connection, "GET " + URL + " HTTP/1.0" + #LFCR$ + #LFCR$)
    SendNetworkString(Connection, String$)
    Time = ElapsedMilliseconds()
    Repeat
      Event = NetworkClientEvent(Connection)
      If Event = #PB_NetworkEvent_Data
        Repeat
          Size = ReceiveNetworkData(Connection, *Buffer, BufferSize)
          If Size > 0
            Time = ElapsedMilliseconds()
            SizeAll + Size
            *Mem = ReAllocateMemory(*Mem, SizeAll)
            If *Mem
              CopyMemory(*Buffer, *Mem + (SizeAll - Size), Size)
            Else
              CloseNetworkConnection(Connection)
              FreeMemory(*Buffer)
              ProcedureReturn #False
            EndIf
          EndIf
        Until Size <= 0
      EndIf
      Time2 = ElapsedMilliseconds() - Time
    Until Time2 > Timeout Or Size <= 0
    CloseNetworkConnection(Connection)
    FreeMemory(*Buffer)
    If Time2 > Timeout
      If *Mem : FreeMemory(*Mem) : EndIf
      ProcedureReturn #False
    EndIf
    pos = FindString(PeekS(*mem, -1, #PB_UTF8), #CRLF$ + #CRLF$, 1) - 1
    pos = Len(#CRLF$ + #CRLF$) + pos
    Size2 = MemorySize(*Mem) - pos
    *Mem2 = AllocateMemory(Size2)
    If *Mem2
      CopyMemory(*Mem + pos, *Mem2, Size2)
      FreeMemory(*Mem)
      ProcedureReturn *Mem2
    EndIf
    FreeMemory(*Mem)
    ProcedureReturn #False
  EndProcedure

[infratec]

Hi,

yes I know, an old thread.
But I think it makes sense to place it here:

I modified the code of Thomas, to avoid most of the memory stuff.
I also added a test for "200 OK"
But the receive size is fixed to 4096.

Code: Select all

Procedure.i ReceiveHTTPMemory(URL.s, BufferSize = 0, Timeout = 5000)
  Protected Connection, Time, Time2, Size, SizeAll, pos
  Protected.s Server
  Protected *Buffer
  
  Size = 1
  
  If LCase(Left(URL, 7)) <> "http://" : URL = "http://" + URL : EndIf
  Server = GetURLPart(URL, #PB_URL_Site)
  If Not Server : ProcedureReturn #Null : EndIf
  Connection = OpenNetworkConnection(Server, 80, #PB_Network_TCP)
  If Not Connection : ProcedureReturn #Null : EndIf
  
  If BufferSize <= 0 : BufferSize = 4096 : EndIf
  
  *Buffer = AllocateMemory(BufferSize)
  If Not *Buffer : ProcedureReturn #Null : EndIf

  SendNetworkString(Connection, "GET " + URL + " HTTP/1.0" + #CRLF$ + #CRLF$)
  Time = ElapsedMilliseconds()
  Repeat
    If NetworkClientEvent(Connection) = #PB_NetworkEvent_Data
      Repeat
        Size = ReceiveNetworkData(Connection, *Buffer + SizeAll, 4096)
        
        If Size > 0
          Time = ElapsedMilliseconds()
          
          If pos = 0
            pos = FindString(PeekS(*Buffer, Size, #PB_UTF8), #CRLF$ + #CRLF$, 1) - 1
            If pos
              If FindString(PeekS(*Buffer, pos, #PB_UTF8), "200 OK") = 0
                CloseNetworkConnection(Connection)
                FreeMemory(*Buffer)
                ProcedureReturn #Null
              EndIf
              
              pos + Len(#CRLF$ + #CRLF$)
              SizeAll = Size - pos
              MoveMemory(*Buffer + pos, *Buffer, SizeAll)
            EndIf
          Else
            SizeAll + Size
          EndIf
          
          If SizeAll + 4096 > BufferSize
            *Buffer = ReAllocateMemory(*Buffer, SizeAll + 4096)
            If *Buffer = #Null
              CloseNetworkConnection(Connection)
              FreeMemory(*Buffer)
              ProcedureReturn #Null
            EndIf
          EndIf            
          
        EndIf
      Until Size <= 0
    EndIf
    Time2 = ElapsedMilliseconds() - Time
  Until Time2 > Timeout Or Size <= 0
  CloseNetworkConnection(Connection)
  
  If Time2 > Timeout
    FreeMemory(*Buffer)
    ProcedureReturn #Null
  EndIf
  
  *Buffer = ReAllocateMemory(*Buffer, SizeAll)
  If *Buffer : ProcedureReturn *Buffer : EndIf

  ProcedureReturn #Null
EndProcedure

If you make the BufferSize big enough, the memory stuff is reduced much more.

Bernd