PureBasic Forums - English

Code: Select all

;Improvements to be made:
;-Handle SendNetworkData limit
;-Handle 301 and 302 transparantly by parsing and calling selves
;-Better default timeout value?
EnableExplicit
InitNetwork()

Procedure.s GetHeader(Packet$,Name$)
  ProcedureReturn Mid(Packet$,FindString(Packet$,Name$)+Len(Name$)+2,FindString(Packet$,#CRLF$,FindString(Packet$,Name$))-(FindString(Packet$,Name$)+Len(Name$)+2))
EndProcedure

Procedure.s HTTPPost(server$,port.l,vars$,headers$,timeout.l=6000)
  ;headers$ should already have #CRLF$ after each
  ;variables should already be encoded in server$ and vars$
  ;chunked responses are transparent, PB doesn't show 0-length packet
  Protected con.l
  Protected head$
  Protected part$
  Protected ret.l
  Protected bytes.l
  Protected timer.l
  Protected buffer$
  Protected response$
  con=OpenNetworkConnection(GetURLPart(server$,#PB_URL_Site),port,#PB_Network_TCP,timeout)
  If con
    ;build header
    head$="POST /"+GetURLPart(server$,#PB_URL_Path)
    If Len(GetURLPart(server$,#PB_URL_Parameters))>0 : head$=head$+"?"+GetURLPart(server$,#PB_URL_Parameters) : EndIf
    head$=head$+" HTTP/1.1"+#CRLF$
    If Len(headers$)>0 : head$=head$+headers$ : EndIf
    head$=head$+"Host: "+GetURLPart(server$,#PB_URL_Site)+#CRLF$
    head$=head$+"Accept: */*"+#CRLF$
    If CountString(headers$,"Content-Type:")=0 : head$=head$+"Content-Type: application/x-www-form-urlencoded"+#CRLF$ : EndIf
    head$=head$+"Connection: keep-alive"+#CRLF$
    head$=head$+"Content-Length: "+Str(Len(vars$))+#CRLF$
    head$=head$+#CRLF$
    ;send header
    timer=ElapsedMilliseconds()
    Repeat
      If ret>0
        ;send remaining
        part$=Mid(head$,ret,Len(head$))
        bytes=SendNetworkData(con,@part$,Len(part$))
      Else
        ;start sending
        bytes=SendNetworkData(con,@head$,Len(head$))
      EndIf
      If bytes<>-1 : ret=ret+bytes : EndIf
      If ElapsedMilliseconds()-timer>=timeout : CloseNetworkConnection(con) : ProcedureReturn "" : EndIf
    Until ret=Len(head$)
    ret=0
    ;send content
    timer=ElapsedMilliseconds()
    Repeat
      If ret>0
        ;send remaining
        part$=Mid(vars$,ret,Len(vars$))
        bytes=SendNetworkData(con,@part$,Len(part$))
      Else
        ;start sending
        bytes=SendNetworkData(con,@vars$,Len(vars$))
      EndIf
      If bytes<>-1 : ret=ret+bytes : EndIf
      If ElapsedMilliseconds()-timer>=timeout : CloseNetworkConnection(con) : ProcedureReturn "" : EndIf
    Until ret=Len(vars$)
    ret=0
    ;receive response
    timer=ElapsedMilliseconds()
    Repeat
      Delay(100)
      Select NetworkClientEvent(con)
        Case #PB_NetworkEvent_Data
          buffer$=Space(14500)
          bytes=ReceiveNetworkData(con,@buffer$,Len(buffer$))
          buffer$=Left(buffer$,bytes)
          If bytes<>-1 : response$=response$+buffer$ : EndIf
          ;check for end of response
          If (bytes<14500 And bytes<>-1)
            If CountString(response$,"Transfer-Encoding: chunked")=0
              If CountString(response$,"Content-Length")>0 And Len(Mid(response$,FindString(response$,#CRLF$+#CRLF$,1)+4))=Val(GetHeader(response$,"Content-Length"))
                Break
              EndIf
            Else
              ;chunk handling
              timer=ElapsedMilliseconds()
            EndIf
          EndIf
      EndSelect
      ;this will handle both chunked and timeouts
      If ElapsedMilliseconds()-timer>=timeout : CloseNetworkConnection(con) : Break : EndIf
    ForEver
    CloseNetworkConnection(con)
  EndIf
  ProcedureReturn response$
EndProcedure

Procedure.s HTTPGet(server$,port.l,headers$,timeout.l=6000)
  ;headers$ should already have #CRLF$ after each
  ;chunked responses are transparent, PB doesn't shows 0-length packet
  Protected.l con
  Protected.l timer
  Protected.l bytes
  Protected.l ret
  Protected head$
  Protected part$
  Protected buffer$
  Protected response$
  con=OpenNetworkConnection(GetURLPart(server$,#PB_URL_Site),port,#PB_Network_TCP,timeout)
  If con
    ;build header
    head$="GET /"+GetURLPart(server$,#PB_URL_Path)
    If Len(GetURLPart(server$,#PB_URL_Parameters))>0 : head$=head$+"?"+GetURLPart(server$,#PB_URL_Parameters) : EndIf
    head$=head$+" HTTP/1.1"+#CRLF$
    If Len(headers$)>0 : head$=head$+headers$ : EndIf
    head$=head$+"Host: "+GetURLPart(server$,#PB_URL_Site)+#CRLF$
    head$=head$+"Accept: */*"+#CRLF$+#CRLF$
    timer=ElapsedMilliseconds()
    Repeat
      If ret>0
        ;send remaining
        part$=Mid(head$,ret,Len(head$))
        bytes=SendNetworkData(con,@part$,Len(part$))
      Else
        ;start sending
        bytes=SendNetworkData(con,@head$,Len(head$))
      EndIf
      If bytes<>-1 : ret=ret+bytes : EndIf
      If ElapsedMilliseconds()-timer>=timeout : CloseNetworkConnection(con) : ProcedureReturn "" : EndIf
    Until ret=Len(head$)
    ret=0
    ;receive response
    timer=ElapsedMilliseconds()
    Repeat
      Delay(100)
      Select NetworkClientEvent(con)
        Case #PB_NetworkEvent_Data
          buffer$=Space(14500)
          bytes=ReceiveNetworkData(con,@buffer$,Len(buffer$))
          buffer$=Left(buffer$,bytes)
          If bytes<>-1 : response$=response$+buffer$ : EndIf
          ;check for end of response
          If (bytes<14500 And bytes<>-1)
            If CountString(response$,"Transfer-Encoding: chunked")=0
              If CountString(response$,"Content-Length")>0 And Len(Mid(response$,FindString(response$,#CRLF$+#CRLF$,1)+4))=Val(GetHeader(response$,"Content-Length"))
                Break
              EndIf
            Else
              ;chunk handling
              timer=ElapsedMilliseconds()
            EndIf
          EndIf
      EndSelect
      ;this will handle both chunked and timeouts
      If ElapsedMilliseconds()-timer>=timeout : Break : EndIf
    ForEver
    CloseNetworkConnection(con)
  EndIf
  ProcedureReturn response$
EndProcedure

SetClipboardText(HTTPGet("http://www.purebasic.com/",80,""))
;SetClipboardText(HTTPPost("http://www.purebasic.fr/english/ucp.php?mode=login",80,"username=user&password=mypass&redirect=index.php&login=Login&redirect=.%2Fucp.php%3Fmode%3Dlogin",""))

Code: Select all

 If CountString(response$,"Content-Length")>0 And Len(Mid(response$,FindString(response$,#CRLF$+#CRLF$,1)+4))=Val(GetHeader(response$,"Content-Length"))