ReceiveHTTPMemory einfach und Crossplattform

[ts-soft]

Code: Alles auswählen

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)
  Protected Connection, Time, Time2, Event, Size, Size2, SizeAll, pos
  Protected.s Server
  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

  SendNetworkString(Connection, "GET " + URL + " HTTP/1.0" + #LFCR$ + #LFCR$)
  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

Gruß
Thomas
/edit
stargates hinweise berücksichtigt.

/edit2
tipp von Hex0r berücksichtig.
Ausserdem wird bei Timeout jetzt false zurückgegeben.

/edit3
Tipp von Nino berücksichtigt

[TomS]

Danke für's teilen.

Code: Alles auswählen

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

[ts-soft]

Danke, auch für das Crossplattform Beispiel, da war ich gerade zu Faul
Hab die Routine aber unter Linux getestet. Mac sollte auch gehen.

[Shardik]

@Thomas,
Danke für Deine ReceiveHTTPMemory-Prozedur.

@TomS,
leider steckt der Teufel bei der Plattformunabhängigkeit im Detail. Während Dein

Code: Alles auswählen

ImageGadget(0, 5, 5, ImageWidth(0), ImageHeight(0), ImageID(0), #PB_Image_Border)

in Windows perfekt funktioniert, erhalte ich in Linux folgende Fehlermeldung
(PB 4.51 in andLinux/Kubuntu 9.04 x86 und PB 4.51 x64 in Suse Linux Enterprise Server 10 SP3 x64):

Zeile 70 - Das angegebene Image ist nicht initialisiert

Das Herunterladen der Icon-Datei in der Prozedur von Thomas funktioniert in Windows und Linux
perfekt, aber vielleicht kommt Linux mit dem Icon-Format nicht zurecht?

[TomS]

Da ich weder Linux noch Mac habe, wirst du dich damit an die PB-Entwickler wenden müssen.
Kann schon sein, dass Linux mit dem Iconformat nicht klar kommt.
Probier's aus: http://www.pureattraction.eu/bitmapicon.bmp (moderne Kunst )


EDIT:

Das Bildformat kann im BMP-, Icon- (.ico, nur auf Windows) oder jedem anderen von der ImagePlugin Library unterstützten Format vorliegen.

[Shardik]

Das Problem stellt CatchImage() dar, weil das .ico-Format nur von Windows unterstützt wird:

Das Bild kann im BMP-, Icon- (.ico, nur auf Windows) oder jedem anderen Format vorliegen,
welches durch die ImagePlugin Library unterstützt wird. Ist das Laden des Bildes nicht möglich,
wird als 'Ergebnis' 0 zurückgegeben.

Edit: TomS war schneller...

[STARGÅTE]

Wieso kommt mir dieser Code so bekannt vor ReceiveHTTPString()

Aber dein Code kann ja sogar Binär runterladen ^^

Aber eine Frage, wieso lädtst du erst mit ReceiveNetworkData() ein einen Zwischenspeicher, und nicht gleich in den erweiterten echten Speicher?
ReAllocateMemory() musst du ja eh, aber das CopyMemory() innerhalb der Schleife ist doch unnötig ...

Das du am schluss alles Kopierst ist klar, damit man eine gültige MemoryID hat.

Im Übrigen ist es schlecht "If Size" abzufragen denn:
"Wenn ein Fehler bei der Verbindung auftrat (Verbindung unterbrochen, Verbindung durch den Server beendet, etc.), wird 'Ergebnis' gleich -1 sein."
dann würdest du SizeAll - 1 ... usw. machen ...
EDIT: Ups das fehlte mir auch ^^

So sehe es dann aus:

Code: Alles auswählen

;[...]
  Repeat
    Event = NetworkClientEvent(Connection)
    If Event = #PB_NetworkEvent_Data
      Repeat
        *mem = ReAllocateMemory(*mem, SizeAll+BufferSize)
        Size = ReceiveNetworkData(Connection, *Mem+SizeAll, BufferSize)
        If Size > 0
          SizeAll + Size
        EndIf
      Until Size <= 0
      If SizeAll
        *mem = ReAllocateMemory(*mem, SizeAll)
      EndIf
    EndIf   
  Until ElapsedMilliseconds() - Time > Timeout Or Not Size
;[...]

[ts-soft]

Wieso kommt mir dieser Code so bekannt vor ReceiveHTTPString()

Ich hab hier auch einen Code, der von edel, kiffi und mir entwickelt wurde, aber weit vor Deinem Snippet

Code: Alles auswählen

Procedure.s RemoteXMLString(url.s, buffersize.l = 1024, timeout.l = 3000)
  
  ; by edel
  ; modified by kiffi
  ; modified by ts-soft
  
  Protected cid.l, pos.l, headerlen.l, NetEvent.l, Buffer.l 
  Protected server.s, file.s, Header.s, response.s
  
  url = LCase(url)
  RemoveString(url, "http://", 1, 1)
  pos = FindString(url, "/", 0)
  If pos = 0
    server = url
    file   = "/"
  Else
    server = Left(url, pos - 1)
    file   = Right(url, Len(url) - pos + 1)
  EndIf
  cid = OpenNetworkConnection(server, 80, #PB_Network_TCP)
  If cid
    Header  = "GET "+ file + " HTTP/1.0"  + #CRLF$
    Header  + "Host: " + server           + #CRLF$
    Header  + "Accept: */*"               + #CRLF$
    Header  + "Connection: close"         + #CRLF$ + #CRLF$
    SendNetworkString(cid, Header)
    Buffer  = AllocateMemory(buffersize)
    timeout + ElapsedMilliseconds()
    Repeat
      NetEvent = NetworkClientEvent(cid)
      If NetEvent = #PB_NetworkEvent_Data
        Repeat
          headerlen = ReceiveNetworkData(cid, Buffer, buffersize)
          response  + PeekS(Buffer, headerlen, #PB_UTF8)
        Until headerlen = 0
        FreeMemory(Buffer)
        pos      = FindString(response, #CRLF$ + #CRLF$, 0) - 1
        pos      = Len(#CRLF$ + #CRLF$) + pos
        pos      = FindString(response, "<", pos) - 1
        response = Mid(response, pos, Len(response) - pos - 1)
        CloseNetworkConnection(cid)
        ProcedureReturn response
      EndIf
      If timeout < ElapsedMilliseconds()
        CloseNetworkConnection(cid)
        ProcedureReturn ""
      EndIf
    ForEver
    CloseNetworkConnection(cid)
  EndIf
  If Buffer
    FreeMemory(Buffer)
  EndIf
  ProcedureReturn ""
EndProcedure

Siehste die Ähnlichkeit?

Danke für die Hinweise.

[HeX0R]

Nett

Aber ich würde die time-Variable bei jedem Datenempfang neu setzen.
Ansonsten kommst du evtl. versehentlich in den Timeout, obwohl noch übertragen wird.

[DarkDragon]

Hallo,

Ich bin schon die ganze Zeit am überlegen ob man sowas nicht geschickterweise etwas anders macht: z.B. könnte man Cookies oder allein schon die Headerfelder in einer Map verwalten, die man der Methode übergibt (Cookies werden dann auch aktualisiert und Headerfelder der Antwort werden zurückübergeben), allerdings fehlt mir momentan die Zeit dazu .