If you want SSL and/or compression I suggest API, although you have to use bloated COM for flexible POST on Windows.
Let me know if you hit issues
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",""))
