et c'est super rapdide ... comme quoi la fonction native de PB doit être buggé
Code : Tout sélectionner
; PureHTTP Include - Version: 0.45b
; OS: Linux / Windows / AmigaOS / MacOSX
; Author: Marius Eckardt (Thalius)
; a lil lib for HTTP ( for now just Downloading ;)
; Last Changes: 24.12.2008
;
; PureHTTP is aimed to be a HTTP 1.0-Compatible Crossplatform Library for use in your Projects.
; This code is PublicDomain - Credits apprechiated if you use it tho ;)
;
; Thx go to mp303 who brought me on the Idea initially with some Networkquestions in the Bugsection. :)
;
; Note: This Code is supposed to be fast but not super optimized. Basically ok for the Job - if you do optimizations
; / improvements you feel the Community could benefit from feel free to post them. :)
;
; Features:
; - HTTP Download to File with :
; - HTTP HEADER Info
; - HTTP Error Handling
; - HTTP Redirect support ( should work now! )
; - Connection Timeout Handling
; - Callback Support
; - Download Timer
; - KB/s o Meter
; - Limit Download Speed
;
; Changes:
; 0.2b:
; - Added Callback Function Support
; 0.3b:
; - lil Optimization
; 0.4b:
; - more Optimizations
; - Fixed Speedlimit To a per Kb/s Value
; - Added PureHTTP_SplitURL(url.s, type.i) - Splits an URL to Host/Path/Filename
; - Extended Example a little
; 0.41 - 0.45b:
; - small Optimizations
; - Added Redirect Support
; - Download to Memory ( Weee ! ;)
; - Added fixes by "moogle"
; - Added fix by oryaaaaa
; - Modified for PB 4.30 / 64 Bit compatibility ( if you need it for an older version simply replace all .i with .l ;))
;
; ToDo:
; - Bugfixes ?
; - Extend HTTP Header Structure to support more of HTTP/1.0
; - HTTP Resume Support
; - GUI with Callback Example
; - HTTP POST Functionality
; - Manual
;- Konstants
; Network
#PureHTTP_Name = "PureHTTP" ; UserAgent Name
#PureHTTP_Defaultfile = "index.html" ; Default for index Files ( used to parse URLs )
#PureHTTP_Buffersize = 4096 ; Chunk-/Buffersize (This Value is balanced ok for average usage. There might be a speedgain on large files increasing this, but slowdown for smaller files)
#PureHTTP_Timeout = 10000 ; Network Timeout in ms
; Status
Enumeration
#PureHTTP_STATUS_CONNECTING ; Connecting
#PureHTTP_STATUS_CONNECTED ; Connected
#PureHTTP_STATUS_GOTHEADER ; Got Header info Filesize / Content-Type
#PureHTTP_STATUS_RECEIVE ; Receiving...
#PureHTTP_STATUS_REDIRECT ; HTTP Redirect
#PureHTTP_STATUS_IDLE ; Idle, Waiting for Data...
#PureHTTP_STATUS_FINISHED ; Download Finished
#PureHTTP_STATUS_TIMEOUT ; Timeout
#PureHTTP_STATUS_HTTPERROR ; HTTP Error / Return
#PureHTTP_STATUS_FILEERROR ; Can't create file
#PureHTTP_STATUS_ABORT ; Download Aborted
EndEnumeration
; HTTP URL Related
#PureHTTP_URL_Protocol = "http://"
; URL Return-Selection Konstants
Enumeration
#PureHTTP_URL_TO_HOST ; Host
#PureHTTP_URL_TO_PATH ; Path
#PureHTTP_URL_TO_FILE ; Filename
EndEnumeration
; HTTP Protocol Related
#HTTP_Port = 80
#HTTP_Protocol10 = "HTTP/1.0"
#HTTP_Protocol11 = "HTTP/1.1"
#HTTP_ContentLength = "Content-Length:"
#HTTP_ContentType = "Content-Type:"
; HTTP Retruncodes
#HTTP_CODE_OK = 200 ; OK
#HTTP_CODE_REDIRECT = 301 ; Redirect
#HTTP_CODE_TREDIRECT = 307 ; Transparent Redirect
;- Structures
; HTTP Header Struct
Structure _PureHTTP_HEADER
Returncode.i ; HTTP Return Code -> 200 = OK -> 404 = File Not Found
ContentLength.i ; Reported Content-Size
ContentType.s ; Reported Content-Type
HTTPReturnString.s ; HTTP Retrunstring -> "HTTP ERROR 404 Not Found"
EndStructure
; File Struct
Structure _PureHTTP_GET_FILE
; File
id.i ; FileIDThread ( in case we download multiple files at once )
*Callback ; Callback Function
ConID.i ; ConnectionID
Host.s ; Host to Connect to
Path.s ; Path to File on Host
outputfile.s ; Path to local Filetarget
*DestBuffer ; Pointer to Destination Memory Buffer ( Alternative to File Download )
Status.i ; Download Status
; HTTP Header Meta Info
Header._PureHTTP_HEADER
; Network
*Buffer ; Pointer to our Paketbuffer
Totalbytes.i ; Holds actual Total bytes received from this File
StartTimer.i ; Start Timer in ms
Timer.i ; Current Our Timer in ms
Totaltime.i ; Total DownloadTime
limitspeed.i ; Limit Downloadspeed in Kb/s
kbps.f ; KB/s
EndStructure
;- Procs
; -- Semi Internal Functions
; Builds GET HTTP Header, kinda interna therefor in CAPS
; Returns HTTP HeaderString
Procedure.s PureHTTP_BUILDHEADER_HTTP_GET(*this._PureHTTP_GET_FILE)
Protected extras.s
If Len(*this\Path) <= 1
*this\Path = "/"
EndIf
; Add more Checks & stuff here...
extras.s = Chr(13) + Chr(10) + "User-Agent: " + #PureHTTP_Name
ProcedureReturn "GET " + *this\Path + " " + #HTTP_Protocol10 + Chr(13) + Chr(10) + "host: "+ *this\Host + Chr(13) + Chr(10) +"Connection: Close" + extras.s + Chr(13) + Chr(10) + Chr(13) + Chr(10)
EndProcedure
; Set Download Status
; kinda Interna-helper function
; Can be used to send an event to thread
; for ex: PureHTTP_SET_STATUS(@mydownload, #PureHTTP_STATUS_ABORT )
; Aborts download.
Procedure PureHTTP_SET_STATUS(*this._PureHTTP_GET_FILE, Status.i)
;// Set Status
*this\Status = Status.i
;// Call Callback
If *this\Callback <> 0
CallFunctionFast(*this\Callback,*this)
EndIf
EndProcedure
; -- User Functions
; Func: PureHTTP_SplitURL(url.s, [ #Pure_HTTP_URL_* ])
; Desc: Little Helper Function to Extract Host/Path/Filename out of an URL
; Returns: String: Hostname, Path, Filename
; See Types:
; #PureHTTP_URL_HOST ; Host
; #PureHTTP_URL_PATH ; Path
; #PureHTTP_URL_FILE ; Filename
;
; Example: Debug PureHTTP_SplitURL("http://www.wavemage.com/edscore/5-EndTitle.mp3",#PureHTTP_URL_FILE)
; See example below for more...
Procedure.s PureHTTP_SplitURL(URL.s, type.i = #PureHTTP_URL_TO_HOST)
Protected i.i, a.i
Result.s = ""
;// Do we have a http:// ?
a.i = FindString(URL.s,#PureHTTP_URL_Protocol,0)
If a.i
URL.s = Right(URL.s,Len(URL.s) - Len(#PureHTTP_URL_Protocol))
If type.i >= #PureHTTP_URL_TO_HOST And type.i <= #PureHTTP_URL_TO_FILE
;// Host
Result.s = StringField(URL.s,0,"/")
If type.i = #PureHTTP_URL_TO_FILE
;// Filename
;// Find File
num_slash=CountString(URL.s, "/")
Result.s=StringField(URL.s, num_slash+1, "/")
;// Sure we got a File ?
If FindString(Result.s,".",0) = 0 Or Result.s = StringField(URL.s,0,"/")
;// No ? Assuming its an index HTML
Result.s = #PureHTTP_Defaultfile
EndIf
EndIf
;// Path
If type.i = #PureHTTP_URL_TO_PATH
Result.s = Right(URL.s,Len(URL.s)-Len(Result.s))
EndIf
EndIf
EndIf
ProcedureReturn Result.s
EndProcedure
; Func: PureHTTP_Get_File(@myfile)
; Returns: Statuscode See: #PureHTTP_STATUS_*
; Desc: Downloads File
Procedure PureHTTP_Get_File(*this._PureHTTP_GET_FILE)
Protected offset.i, eoffset.i, cloffset.i, ctoffset.i, solocoffset.i, eolocoffset.i, Bytes.i, PaketCounter.i, *SEvent, *outfile
Protected m_mul.i, redirection.i = 0, dest_buffersize.i, tmp_redir_url.s
;// Set Status
PureHTTP_SET_STATUS(*this, #PureHTTP_STATUS_CONNECTING)
*this\ConID = OpenNetworkConnection( *this\Host , #HTTP_Port )
If *this\ConID
;// Set Status
PureHTTP_SET_STATUS(*this, #PureHTTP_STATUS_CONNECTED)
Debug "* Connected"
;// Allocate Receivebuffer
*this\Buffer = AllocateMemory(#PureHTTP_Buffersize)
;// Init Timer
*this\StartTimer = ElapsedMilliseconds()
*this\Timer = *this\StartTimer
;// Send HTTP Request
SendNetworkString(*this\ConID,PureHTTP_BUILDHEADER_HTTP_GET(*this))
Debug "* Sending Request"
;// Wait for incoming Data ...
Debug "* Waiting for Reply"
Repeat
*SEvent = NetworkClientEvent(*this\ConID)
Select *SEvent
;// We received Data!
Case #PB_NetworkEvent_Data
Debug "* Receiving..."
;// Now go Fetch!
Repeat
Bytes.i = ReceiveNetworkData(*this\ConID, *this\Buffer, #PureHTTP_Buffersize)
;// Is this the first Paket containing the Header ?
If PaketCounter.i = 0
; PrintN(PeekS(*this\Buffer,#PureHTTP_Buffersize)) ;<- lil Debug For the header
;// Basic Process Header - Get DataOffsets
eoffset.i = FindString(PeekS(*this\Buffer, 200), #HTTP_Protocol10, 0) + Len(#HTTP_Protocol10)
If eoffset.i = Len(#HTTP_Protocol10) ;// We got a HTTP1.1 response, find new offset.
eoffset.i = FindString(PeekS(*this\Buffer, 200), #HTTP_Protocol11, 0) + Len(#HTTP_Protocol11)
EndIf
;// We sure in for a right Response now ?
If eoffset.i = Len(#HTTP_Protocol10) ; no .. still no offset
PureHTTP_SET_STATUS(*this,#PureHTTP_STATUS_HTTPERROR)
Else ; Yeah baby!
cloffset.i = FindString(PeekS(*this\Buffer, #PureHTTP_Buffersize), #HTTP_ContentLength, eoffset.i) + Len(#HTTP_ContentLength)
ctoffset.i = FindString(PeekS(*this\Buffer, #PureHTTP_Buffersize), #HTTP_ContentType, eoffset.i) + Len(#HTTP_ContentType)
offset.i = FindString(PeekS(*this\Buffer, #PureHTTP_Buffersize),Chr(13) + Chr(10) + Chr(13) + Chr(10),eoffset.i) + 3
;// Do we have a Content-Length Info? if so, set Size
If cloffset.i <> Len(#HTTP_ContentLength)
*this\Header\ContentLength = Val(LTrim(RTrim(PeekS(*this\Buffer+cloffset.i,FindString(PeekS(*this\Buffer+cloffset.i,#PureHTTP_Buffersize-cloffset.i),Chr(13) + Chr(10),0)))))
EndIf
;// Set Content-Type
If ctoffset.i <> Len(#HTTP_ContentType)
*this\Header\ContentType = LTrim(RTrim(PeekS(*this\Buffer+ctoffset.i,FindString(PeekS(*this\Buffer+ctoffset.i,#PureHTTP_Buffersize-ctoffset.i),Chr(13) + Chr(10),0))))
EndIf
;// Select Header Response
*this\Header\Returncode = Val(PeekS(*this\Buffer+eoffset.i, 3))
Select *this\Header\Returncode
Case #HTTP_CODE_OK
;// Create File
If Len(*this\outputfile) > 0
*outfile = CreateFile(#PB_Any,*this\outputfile+".part")
EndIf
;//Set status
PureHTTP_SET_STATUS(*this,#PureHTTP_STATUS_GOTHEADER)
;// Write first bytes to File
If *outfile
Debug "Writing HeaderData to File..."
*this\Totalbytes = Bytes.i - offset.i
WriteData(*outfile, *this\Buffer + offset.i, Bytes.i - offset.i)
Else
;// Check if Download to Memory & Set Status
If Not *this\Destbuffer
PureHTTP_SET_STATUS(*this,#PureHTTP_STATUS_FILEERROR)
EndIf
EndIf
; -- Add
;// Check if Memory Reserved.
If *this\Destbuffer
dest_buffersize.i = MemorySize(*this\Destbuffer)
;// Check if Buffer is Big enough for first data...
If #PureHTTP_Buffersize > dest_buffersize.i
;// Reallocate Memory to Rec-Buffersize
*this\Destbuffer = ReAllocateMemory(*this\Destbuffer,#PureHTTP_Buffersize)
EndIf
;// Download first Data to Memory Buffer
CopyMemory(*this\Buffer + offset.i,*this\Destbuffer,Bytes.i - offset.i)
*this\Totalbytes + ( Bytes.i - offset.i)
EndIf
;// Process HTTP REDIRECT
Case #HTTP_CODE_REDIRECT To #HTTP_CODE_TREDIRECT
Debug "302 -> Redirect"
;// Set Status
PureHTTP_SET_STATUS(*this,#PureHTTP_STATUS_GOTHEADER)
;// Handle Redirection - Find new Location
solocoffset.i = FindString(PeekS(*this\Buffer),"Location:",eoffset.i) + 10
eolocoffset.i = FindString(PeekS(*this\Buffer),Chr(13) + Chr(10),solocoffset.i)
tmp_redir_url.s = Mid(PeekS(*this\Buffer), solocoffset, eolocoffset - solocoffset)
;// Got Location ? Rewrite URL !
If solocoffset.i
*this\Host = PureHTTP_SplitURL(tmp_redir_url.s,#PureHTTP_URL_TO_HOST)
*this\Path = PureHTTP_SplitURL(tmp_redir_url.s,#PureHTTP_URL_TO_PATH)
redirection.i = 1
;// Set status
PureHTTP_SET_STATUS(*this,#PureHTTP_STATUS_REDIRECT)
EndIf
Default ; Unknown Error Code
;// Set Status
PureHTTP_SET_STATUS(*this,#PureHTTP_STATUS_HTTPERROR)
*this\Header\HTTPReturnString = PeekS(*this\Buffer+eoffset.i,FindString(PeekS(*this\Buffer+eoffset.i,200),Chr(13) + Chr(10),0))
EndSelect
EndIf
Else ;// Download Finished ?
If Bytes.i = 0
PureHTTP_SET_STATUS(*this,#PureHTTP_STATUS_FINISHED)
Debug "** FINISHED **"
Else ;// No? ok then write some ...
*this\Totalbytes + Bytes.i
;// Set Status
PureHTTP_SET_STATUS(*this, #PureHTTP_STATUS_RECEIVE)
;// write Data To File
If *outfile
WriteData(*outfile,*this\Buffer,Bytes.i)
Else
;// Set Status
If Not *this\Destbuffer
PureHTTP_SET_STATUS(*this,#PureHTTP_STATUS_FILEERROR)
EndIf
EndIf
;// Download to Memory: Check if Memory Reserved.
If *this\Destbuffer
dest_buffersize.i = MemorySize(*this\Destbuffer)
;// Check if Buffer is Big enough for coming data...
If *this\Totalbytes > dest_buffersize.i
;// Reallocate Memory to Fit
m_mul.i = Round(*this\Totalbytes / #PureHTTP_Buffersize,1) + 1
*this\Destbuffer = ReAllocateMemory(*this\Destbuffer,(#PureHTTP_Buffersize * m_mul.i))
EndIf
;// Download first Data to Memory Buffer
CopyMemory(*this\Buffer,*this\Destbuffer + *this\Totalbytes - Bytes.i,Bytes.i)
EndIf
;// Update KB/s
*this\kbps = (*this\Totalbytes / ((ElapsedMilliseconds()-*this\StartTimer)/1000)) / 1024
Debug StrF(*this\kbps) + " kb/s"
;// Update Timer
*this\Timer = ElapsedMilliseconds()
EndIf
EndIf
PaketCounter.i + 1
;// Limit Speed to
If *this\limitspeed <> 0
While *this\kbps > *this\limitspeed
;// Update KB/s & wait out our Limit...
*this\kbps = (*this\Totalbytes / ((ElapsedMilliseconds()-*this\StartTimer)/1000)) / 1024
Delay(10)
Wend
EndIf
Until *this\Status >= #PureHTTP_STATUS_FINISHED
;// Close File
If *outfile
CloseFile(*outfile)
CopyFile(*this\outputfile+".part",*this\outputfile)
DeleteFile(*this\outputfile+".part")
EndIf
Default
;// Set Status
PureHTTP_SET_STATUS(*this,#PureHTTP_STATUS_IDLE)
Debug "- IDLE -"
EndSelect
;// Check Timeout
If ElapsedMilliseconds() - *this\Timer > #PureHTTP_Timeout
PureHTTP_SET_STATUS(*this,#PureHTTP_STATUS_TIMEOUT)
EndIf
;// Don't burn CPU while waiting...
Delay(10)
Until *this\Status >= #PureHTTP_STATUS_FINISHED
;// Free Memory
If *this\Buffer
FreeMemory(*this\Buffer)
EndIf
*this\Totaltime = ElapsedMilliseconds() - *this\StartTimer
If *this\ConID
CloseNetworkConnection(*this\ConID)
EndIf
Else
;// Connection Timeout
PureHTTP_SET_STATUS(*this,#PureHTTP_STATUS_TIMEOUT)
EndIf
If redirection.i = 1
PureHTTP_Get_File(*this._PureHTTP_GET_FILE)
EndIf
ProcedureReturn *this\Status
EndProcedure
; **** END OF INCLUDE ****
; ******************************************************************************************************************************
;-Simple EXAMPLE
; ******************************************************************************************************************************
;- Example: Our happy Callback Function
Procedure MyCallback(*this._PureHTTP_GET_FILE)
Protected Pct.f
;// Calculate Percent
If *this\Status >= #PureHTTP_STATUS_GOTHEADER And *this\Totalbytes <> 0
Pct.f = ( 100 / *this\Header\ContentLength ) * *this\Totalbytes
EndIf
;// Print Status to Console
Select *this\Status
Case #PureHTTP_STATUS_GOTHEADER
Debug("* Processing Header Information...")
Case #PureHTTP_STATUS_RECEIVE
Debug("Received: "+Str(*this\Totalbytes/1024)+" kb -> "+StrF(Pct.f)+" % -> @ "+StrF(*this\kbps)+" kb/s")
Case #PureHTTP_STATUS_REDIRECT
Debug("* HTTP Redirect: http://" + *this\Host + *this\Path)
Case #PureHTTP_STATUS_FINISHED
Debug("* Finished HTTP Request.")
EndSelect
EndProcedure
Procedure.s ReceiveHTTPData(Url$,Filename$)
;// Initialize our Download Object, THIS CAN BE A VARIBLE, ARRAY OR LINKEDLIST-ENTRY
myfile._PureHTTP_GET_FILE
;// Set Host to Connect to
myfile\Host = PureHTTP_SplitURL(Url$,#PureHTTP_URL_TO_HOST)
;// Set Path on Host
myfile\Path = PureHTTP_SplitURL(Url$,#PureHTTP_URL_TO_PATH)
myfile\limitspeed = 0
;// Download to Memory ( Allocate Memory Area - gets resized if needed ) - not needed for simple file download.
myfile\Destbuffer = AllocateMemory(#PureHTTP_Buffersize)
Status.i = PureHTTP_Get_File(@myfile)
;// Select Status after we are done.
Select Status.i
Case #PureHTTP_STATUS_CONNECTING ; Connecting
Case #PureHTTP_STATUS_CONNECTED ; Connected
Case #PureHTTP_STATUS_RECEIVE ; Receiving...
Case #PureHTTP_STATUS_IDLE ; Idle, Waiting for Data...
Case #PureHTTP_STATUS_FINISHED ; Download Finished
Debug("")
Debug("*** File Download Finished ***")
Debug("HTTP-Header Info -> "+"HTTP Return-Code: " +Str(myfile\Header\Returncode))
Debug("Content-Type: "+myfile\Header\ContentType)
Debug("Reported-Size : "+Str(myfile\Header\ContentLength)+" byte")
Debug("")
Debug("File : "+myfile\outputfile)
Debug("Size : "+Str(myfile\Totalbytes/1024)+" kb")
Debug("Time : "+Str(Round((myfile\Totaltime/1000)-0.5,1))+" s")
Debug("Speed : "+StrF((myfile\Totalbytes / (myfile\Totaltime/1000)) / 1024)+" kb/s")
Debug("")
Case #PureHTTP_STATUS_TIMEOUT ; Timeout
Debug("* Connection Timeout!")
Case #PureHTTP_STATUS_HTTPERROR ; HTTP Error / Return
Debug("HTTP ERROR "+myfile\Header\HTTPReturnString)
Case #PureHTTP_STATUS_REDIRECT
Debug("HTTP REDIRECT 302")
Case #PureHTTP_STATUS_FILEERROR ; Cant create file
Debug("Unable to Write File: "+myfile\outputfile)
Case #PureHTTP_STATUS_ABORT ; Download Aborted
EndSelect
Var.s=PeekS(myfile\Destbuffer)
FreeMemory(myfile\Destbuffer)
ProcedureReturn Var
EndProcedure
Structure Game
HighScoreMutex.i
EndStructure
Global Game.Game
Structure HighScore
Name.s
Score.s
Rank.l
EndStructure
Global NewList HighScore.HighScore()
Procedure ReadHighScore(*l)
Var.s="Act=HighScore"
file.s=GetTemporaryDirectory()+"EBQTmpData.txt"
Debug file
Result.s = ReceiveHTTPData("http://www.thyphoon.com/EBQ/score.php?"+Var,file)
Debug Result
;If DownloadToMem ( "http://www.thyphoon.com/EBQ/score.php?"+Var, @Result, 63000 )
;n=CountString(Result,Chr(13),1)-1
;Result=Left(Result,n)
;If Trim(Result)="UPDATE"
; MessageRequester("Information", "Cette version est obsolète !", #PB_MessageRequester_Ok)
; End
; EndIf
;EndIf
n=CountString(Result,Chr(10))
Debug n
LockMutex(Game\HighScoreMutex)
ClearList(HighScore())
For z=1 To n
AddElement(HighScore())
line.s=StringField(Result, z, Chr(10))
HighScore()\Name=StringField(line, 1, "|")
HighScore()\Score=StringField(line, 2, "|")
Next
UnlockMutex(Game\HighScoreMutex)
EndProcedure
InitNetwork()
Game\HighScoreMutex=CreateMutex()
ReadHighScore(0)
ForEach HighScore()
Debug HighScore()\Name+" "+HighScore()\Score
Next
)
en effet oui il faut attendre 10 bonnes secondes c'est bizarre quand même se temps 