PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

ReceiveHTTPMemory simple and crossplattform

https://www.purebasic.fr/english/viewtopic.php?t=44954

Page 1 of 1

ReceiveHTTPMemory simple and crossplattform

Posted: Thu Jan 13, 2011 3:57 pm
by 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

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Thu Jan 13, 2011 4:26 pm
by 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 :mrgreen:

Bernd

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Thu Jan 13, 2011 4:33 pm
by TomS
infratec wrote: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.

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Thu Jan 13, 2011 4:35 pm
by ts-soft
you are welcome :D

@infratec
to point 1: it's by me :mrgreen:
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) :wink:

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Thu Jan 13, 2011 4:51 pm
by TomS
Yeah, I said it might^^
They're designing their servers like they're designing their browser. :lol: They just accept anything that makes kinda sense, regardless of w3c's or other gloabally agreed upon rules.

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Thu Jan 13, 2011 6:35 pm
by Marlin
TomS wrote:
infratec wrote: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.
rfc1945 wrote: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. :wink:

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Thu Jan 13, 2011 9:19 pm
by 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

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Fri Jan 14, 2011 3:00 am
by netmaestro
Nice work! Quite useful, thanks for sharing it. :D

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Fri Jan 14, 2011 9:37 am
by C64
The code should allow for "https://" URLs too.

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Fri Jan 14, 2011 4:55 pm
by DoubleDutch
I think that https may be slightly more compicated. ;)

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Fri Jan 14, 2011 5:48 pm
by 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

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Sat Jan 15, 2011 8:20 pm
by Kwai chang caine
@TsSoft
Thanks a lot for sharing, especially the second with music :shock:
Image
You are really great...even my cats dancing on popcorn 8)

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Fri Jan 21, 2011 3:38 pm
by C64
DoubleDutch wrote: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://" ?

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Mon Sep 05, 2011 10:07 am
by 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

Re: ReceiveHTTPMemory simple and crossplattform

Posted: Fri Apr 27, 2012 9:03 pm
by 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
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited