PureBoard

Code: Alles auswählen

; -:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-
;
;             PMVs XXXXX XXXX XXX - Include
;                               
;                          http-requests
;
; -:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-
;
; begin:  01.12.2007
; finish: --.--.----
; to Version 1.00.00
;
; {|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}
;
;
; © 2007 + 2008 by PMV 
; 
;
; {|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}
;
; History:
;  
; 30.01.08 (18:00 - 04:00)
; geändert: OpenHttpRequest() Parametern geändert/ hinzugefügt
; geändert: ReceiveHttpRequest() für Chunked-Encoding
; hinzügefügt: HttpRequestNextCookie()
; 
; 03.02.08 (17:30 - 20:00)
; geändert ReceiveHttpRequest() für Chunked-Encoding
;
; 06.02.08 (0:00 - 02:00)
; ReadHttpRequestHeader schließt den Request nun nicht mehr selbstständig
; ReceiveHttpRequest schweren korigiert
; HttpRequestToFile hinzugefügt
;
; 15.02.08 (22:00 - 22:30)
; HttpRequestToBuffer hinzugefügt
;
;
; -|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|- 

;         ;- am ende kommen 2 Zeichen zu viel raus!
;         ;- Unterscheidung von UTF8/ UTF16/ Ascii

EnableExplicit

  #BufferLength = 1024         ;Größe des Speicherpuffers
  #HeaderTimeout = 5000        ;Timeout beim lesen des Headers

Structure HttpRequest
  ConID.l
  *Buffer
  State.l                    ;4 = Fehler, 2 = OK, 3 = Weiterleitung
  Location.s                 ;wenn Weiterleitung, dann hier die neue Adresse
  Cookie.s                   ;fals beim Request ein "Set-Cookie" auftritt, auslesen mit NextCookie()
  ContentLength.l
  Charset.l                  ;
  Receive.l
  Event.l
  ;Daten für chunked-Transfer
  *Chunked                  ; false fals kein chunked aktiviert ist, sonnst Pointer auf einen Speicherbreich
  cSize.l             ; bytes im Speicher *chunked
EndStructure

Procedure.l OpenHttpRequest(Server$, Port.l, Request$, Accept$="", ContentType$="", Cookie$="", Dat$="")
  Protected *Request.HttpRequest = AllocateMemory(SizeOf(HttpRequest))

  *Request\Buffer = AllocateMemory(#BufferLength)
  If *Request\Buffer = #False
    FreeMemory(*Request)
    ProcedureReturn 0
  EndIf
  
  *Request\ConID = OpenNetworkConnection(Server$, Port)
  If Not *Request\ConID
    FreeMemory(*Request\Buffer)
    FreeMemory(*Request)
    ProcedureReturn 0
  EndIf
  If Port <> 80
    Server$ + ":" + Str(Port)
  EndIf
  
  ;SendNetworkString(*Request\ConID, "POST " + Path$ + " " + Version$ + Chr(13)+Chr(10))
  ;Request$ = <RequestTyp> HTTP:\\<Server><Pfad> HTTP/1.0
  ;Request$ = <RequestTyp> <Pfad> HTTP/1.1
  SendNetworkString(*Request\ConID, Request$ + Chr(13)+Chr(10))
  SendNetworkString(*Request\ConID, "Host: " + Server$ + Chr(13)+Chr(10))
  If Accept$ : SendNetworkString(*Request\ConID, "Accept: " + Accept$ + Chr(13)+Chr(10)) : EndIf
  If Cookie$ : SendNetworkString(*Request\ConID, "Cookie: " + Cookie$ + Chr(13)+Chr(10)) : EndIf
  If Dat$ : SendNetworkString(*Request\ConID, "Content-Length: " + Str(Len(Dat$)) + Chr(13)+Chr(10)) : EndIf
  If ContentType$ : SendNetworkString(*Request\ConID, "Content-Type: " + ContentType$ + Chr(13)+Chr(10)) : EndIf
  SendNetworkString(*Request\ConID, "Connection: close" + Chr(13) + Chr(10))
  SendNetworkString(*Request\ConID, Chr(13)+Chr(10))
  If Dat$ : SendNetworkString(*Request\ConID, Dat$) : EndIf
  
  ;Debug Request$
  ;Debug "Host: " + Server$
  ;Debug "Content-Length: " + Str(Len(Dat$))
  ProcedureReturn *Request
EndProcedure

; Procedure PassHttpRequest(*Request.HttpRequest, Accept$)
;   Protected Server$, Get$
;   
;   Server$ = Mid(*Request\Location, 8, FindString(*Request\Location, "/", 9) - 8)
;   Get$ = Right(*Request\Location, Len(*Request\Location) - FindString(*Request\Location, "/", 9))
; 
;   SendNetworkString(*Request\ConID, "GET /" + Get$ + " HTTP/1.1" + Chr(13)+Chr(10))
;   SendNetworkString(*Request\ConID, "Host: " + Server$ + Chr(13)+Chr(10))
;   SendNetworkString(*Request\ConID, "Accept: " + Accept$ + Chr(13)+Chr(10))
;   SendNetworkString(*Request\ConID, "Connection: close" + Chr(13) + Chr(10))
;   SendNetworkString(*Request\ConID, Chr(13)+Chr(10))  
; 
;   ProcedureReturn *Request
; EndProcedure

Procedure CloseHttpRequest(*Request.HttpRequest)
  If *Request
    Debug *Request
    FreeMemory(*Request\Buffer)
    CloseNetworkConnection(*Request\ConID)
    If *Request\Chunked : FreeMemory(*Request\Chunked) : EndIf
    FreeMemory(*Request)
  EndIf
EndProcedure

;ließt den Http-Header und gibt den ermittelten Verbindungsstatus zurück
; z.B.:
; 200 = OK
; 404 = Not Found
; 303 = See Other
Procedure.l ReadHttpRequestHeader(*Request.HttpRequest)
  Protected Timer.l
  Protected DataLength.l
  Protected Pos.l
  Protected String$
  Protected Result.l
  Protected String.s
  Protected NewList Header.s()
  
  If Not *Request : ProcedureReturn 0 : EndIf
  
  ;Http-Header einlesen
  Timer = ElapsedMilliseconds()
  Repeat
    If NetworkClientEvent(*Request\ConID) = 2
      DataLength = ReceiveNetworkData(*Request\ConID, *Request\Buffer + *Request\Receive, #BufferLength)
      *Request\Receive + DataLength
      Pos = FindString(PeekS(*Request\Buffer, *Request\Receive, #PB_UTF8), Chr(13) + Chr(10), *Request\Receive - DataLength - 1)
        
      While Pos
        AddElement(Header())
        Header() = Left(PeekS(*Request\Buffer, *Request\Receive, #PB_UTF8), Pos - 1)
        *Request\Receive - Len(Header()) - 2
        CopyMemory(*Request\Buffer + Len(Header()) + 2, *Request\Buffer, *Request\Receive)
        Debug "Headerzeile: " + Header()
        ;Debug "Rest String: " + PeekS(*Buffer, *Search\Receive, #PB_UTF8)
        If Header() = "" : Break 2 : EndIf
        Pos = FindString(PeekS(*Request\Buffer, *Request\Receive, #PB_UTF8), Chr(13) + Chr(10), Len(String$) - DataLength - 1)
      Wend
    Else
      Delay(1)
    EndIf
    If Timer + #HeaderTimeout <= ElapsedMilliseconds()
      ;Beep_(2000, 100)
      ;Debug "Timeout!"
      ;CloseHttpRequest(*Request)
      ProcedureReturn 0
    EndIf
  ForEver
  ; -------------------

  ;Default Charset 
  *Request\Charset = #PB_Ascii

  ; Header überprüfen
  ForEach Header()
    If FindString(Header(), "HTTP/1.1 ", 0) = 1
      *Request\State = Val(StringField(Header(), 2, " "))
      Debug "Status: " + Str(*Request\State)
    Else
      String = StringField(Header(), 1,":") 
      If String = "Content-Length"
          *Request\ContentLength = Val(StringField(Header(), 2,":"))
          Debug "zu empfangende Länge: " + Str(*Request\ContentLength)
      
      ElseIf String = "Location"
          Pos = FindString(Header(), ":", 0) + 2
          *Request\Location = Mid(Header(), Pos, Len(Header()) - Pos + 1)
        
      ElseIf String = "Set-Cookie"
          *Request\Cookie + Header()
        
      ElseIf String = "Transfer-Encoding"
          If StringField(Header(), 2, ":") = " chunked"
            *Request\Chunked = AllocateMemory(40)
          EndIf
      
      ElseIf String = "Content-Type"
          String = LCase(StringField(Header(), 2, ":"))
          Pos = FindString(String, "charset", 1)
          If Pos
            Pos = FindString(String, "=", Pos)
            If Pos
              String = Right(String, Len(String) - Pos)
              Select String
                Case "utf-8"
                  *Request\Charset = #PB_UTF8
                Case "utf-16"
                  *Request\Charset = #PB_UTF16
              EndSelect
            EndIf
          EndIf
      EndIf
    EndIf
  Next
  ; --------------
  
  If *Request\Receive
    *Request\Event = 1
  EndIf
  
  ProcedureReturn *Request\State
EndProcedure

Procedure.l HttpRequestContentLength(*Request.HttpRequest)
  If *Request
    ProcedureReturn *Request\ContentLength
  EndIf
  
  ProcedureReturn 0
EndProcedure

Procedure.s HttpRequestLocation(*Request.HttpRequest)
  If *Request
    ProcedureReturn *Request\Location
  EndIf
  
  ProcedureReturn ""
EndProcedure

Procedure.l ReadChunkLength(*Request.HttpRequest, DataLength.l)
  Protected Begin.l = DataLength - (*Request\Receive - *Request\ContentLength)
  Protected Size.l = 40 - *Request\CSize
  Protected Pos.l, i.l, value.l
  Protected Length.l, Result.l
  Protected Digit$
  
  
;       Debug "ChunkBegin: " + Str(Begin)
;       Debug "Receive: " + Str(*Request\Receive)
;       Debug "ContentLength: " + Str(*Request\ContentLength)
;       Debug "DataLength:" + Str(DataLength)

  If Size > DataLength - Begin : Size = DataLength - Begin: EndIf
  If Size
    ;Debug *Request\CSize
    ;Debug Size
    CopyMemory(*Request\Buffer + Begin, *Request\Chunked + *Request\CSize, Size)
    ;Debug "Davor: " + PeekS(*Request\Chunked, *Request\CSize + Size, *Request\Charset)
    
    Digit$ = LCase(PeekS(*Request\Chunked, *Request\CSize + Size, *Request\Charset))
    Pos = FindString(Digit$, Chr(13) + Chr(10), 2)
    If Pos
      For i = 1 To Pos
        value = FindString("0123456789abcdef", Mid(Digit$, i, 1), 1)
        If value
          Length << 4 + value - 1
        EndIf
      Next
      Pos + 1
      
      *Request\ContentLength + Length
      
      Result = Pos - *Request\CSize
      *Request\CSize = 0
      
      ;Debug "Length: " + Str(Length)
      If Length = 0
        FreeMemory(*Request\Chunked)
        *Request\Chunked = #False
      EndIf
    Else
      Result = DataLength - Begin
      *Request\CSize + DataLength - Begin
    EndIf
    MoveMemory(*Request\Buffer + Begin + Result, *Request\Buffer + Begin, DataLength - Begin - Result)
    ;Debug "Danach: " + PeekS(*Request\Buffer + Begin, DataLength - Begin, *Request\Charset)
    ProcedureReturn Result
  EndIf  
  ProcedureReturn -1
 EndProcedure


;empfängt das nächste Datenpaket, sofern es existiert
; Rückgabewert:   Anzahl der empfangenden Bytes (0 = nichts empfangen; -1 = fertig)
Procedure.l ReceiveHttpRequest(*Request.HttpRequest)
  Protected DataLength.l = 0 
  ;Protected ChunkSize.l, i.l, ii.l, Digit$, ChunkBegin.l, value.l
  Protected Result.l
  
  If Not *Request : ProcedureReturn 0 : EndIf

  If *Request\Chunked = #False
    If *Request\Receive >= *Request\ContentLength : ProcedureReturn -1 : EndIf
  EndIf
  
  If *Request\Event = 1
    *Request\Event = 0
    DataLength = *Request\Receive
    
  ElseIf *Request\Event = 2 Or NetworkClientEvent(*Request\ConID) = 2
   
    DataLength = ReceiveNetworkData(*Request\ConID, *Request\Buffer, #BufferLength)
    *Request\Receive + DataLength
    If *Request\Event = 2 And DataLength < #BufferLength
      *Request\Event = 0
    ElseIf *Request\Event = 0 And DataLength = #BufferLength
      *Request\Event = 2
    EndIf
  EndIf
  
  
  If DataLength And *Request\Chunked
    While *Request\ContentLength - *Request\Receive <= 0
      Result = ReadChunkLength(*Request, DataLength)
    
      If Result > 0
        DataLength - Result
        *Request\Receive - Result
        If *Request\Chunked = #False; Or *Request\ContentLength - *Request\Receive = 0
          Break
        EndIf
      ElseIf Result = -1
        Break
      EndIf
    Wend 
  EndIf
  
  ProcedureReturn DataLength
EndProcedure

Procedure.l HttpRequestBuffer(*Request.HttpRequest)
  If *Request
    ProcedureReturn *Request\Buffer
  EndIf
  
  ProcedureReturn 0
EndProcedure

Procedure.s HttpRequestNextCookie(*Request.HttpRequest)
  Protected Cookie$ = "", Pos.l
  
  If *Request\Cookie
    Pos = FindString(*Request\Cookie, "Set-Cookie: ", 13)
    If Pos
      Cookie$ = Mid(*Request\Cookie, 13, Pos - 13)
      *Request\Cookie = Right(*Request\Cookie, Len(*Request\Cookie) - Pos + 1) 
    Else
      Cookie$ = Right(*Request\Cookie, Len(*Request\Cookie) - 12)
      *Request\Cookie = ""
    EndIf
  EndIf
  
  ProcedureReturn Cookie$
EndProcedure

Procedure.l HttpRequestToFile(*Request.HttpRequest, File$)
  Protected File.l, Receive.l
  
  If *Request
    If ReadHttpRequestHeader(*Request)
      File = CreateFile(#PB_Any, File$) 
      If File
        Repeat
          Receive = ReceiveHttpRequest(*Request)
          If Receive > 0
            WriteData(File, HttpRequestBuffer(*Request), Receive)
          Else
            Delay(1)
          EndIf
        Until Receive = -1
        CloseFile(File)
        ProcedureReturn #True
      EndIf
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure.l HttpRequestToBuffer(*Request.HttpRequest, *Length.LONG)
  Protected File.l, Receive.l, *Buffer
  *Length\l = 0
  
  If *Request
    If ReadHttpRequestHeader(*Request)
      Repeat
        Receive = ReceiveHttpRequest(*Request)
        If Receive > 0
          If *Buffer
            *Buffer = ReAllocateMemory(*Buffer, *Length\l + Receive)
          Else
            *Buffer = AllocateMemory(Receive)
          EndIf
          CopyMemory(HttpRequestBuffer(*Request), *Buffer + *Length\l, Receive)
          *Length\l + Receive
        Else
          Delay(1)
        EndIf
      Until Receive = -1
      ProcedureReturn *Buffer
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure
; InitNetwork()
; Define Request.l, *pointer, DataLength.l, Length.l
; ;Request.l = OpenHttpRequest("pmv.pytalhost.com", 80, "GET / HTTP/1.1", "", "", "", "")
; ;Request.l = OpenHttpRequest("74.125.97.96", 80, "GET /get_video?video_id=uTRjrmIlyAo&origin=dal-v36.dal.youtube.com HTTP/1.1", "", "", "", "")
; Request.l = OpenHttpRequest("www.trackmania-the-game.de", 8080, "GET /tmu/ HTTP/1.1", "", "", "", "")
; ReadHttpRequestHeader(Request)
; Debug HttpRequestNextCookie(Request)
; Debug HttpRequestNextCookie(Request)
; 
; *pointer = AllocateMemory(1024)
; Repeat
;   Length = ReceiveHttpRequest(Request) 
;   If Length = -1
;     Break
;   ElseIf Length
;     DataLength + Length
;     Debug "Empfangen: " + Str(Length)
;     *pointer = ReAllocateMemory(*pointer, DataLength)
;     CopyMemory(HttpRequestBuffer(Request), *pointer + DataLength - Length, Length)
;     ;Debug PeekS(*pointer, DataLength, #PB_Ascii)
;     ;Debug "Zeichenlänge: " + Str(Len(PeekS(*pointer, DataLength, #PB_Ascii)))
;   Else
;     Delay(1)
;   EndIf
; ForEver  
; CloseHttpRequest(Request)
; 
; CreateFile(0, "d:\temp.html")
; WriteData(0, *pointer, DataLength)
; CloseFile(0)