PureBasic

Code : Tout sélectionner

Enumeration
  #Window_0
  #status_bar
  #StatusBarProgress
EndEnumeration

;{ HTTP

#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
;}


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

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

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,1,"/")
     
      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,1,"/")
          ;// 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

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

Procedure MyCallback(*this._PureHTTP_GET_FILE)
  Protected Pct.f
  If *this\Status >= #PureHTTP_STATUS_GOTHEADER And *this\Totalbytes <> 0
    Pct.f =  ( 100 / *this\Header\ContentLength ) * *this\Totalbytes
  EndIf
EndProcedure


Procedure mise_a_jour(*valeur)
  Delay(2000)
  Status.i = PureHTTP_Get_File(@myfile)
EndProcedure

Procedure OpenWindow_Window_0()
  OpenWindow(#Window_0, 0, 0, 870, 710, "", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar|#PB_Window_ScreenCentered)

  CreateStatusBar(#status_bar,WindowID(#Window_0))
  AddStatusBarField(820-30)
  AddStatusBarField(30)
  AddStatusBarField(50)

EndProcedure


OpenWindow_Window_0()

pilenetwork = InitNetwork()

StatusBarText(#status_bar,0,"ok")

If FindString(ProgramParameter() , "-nomaj") = 0
myurl.s = "http://pro.clubic.com/entreprises/amazon/actualite-498618-amazon-entrepot-chalon.html"
myfile._PureHTTP_GET_FILE
myfile\Host = PureHTTP_SplitURL(myurl.s,#PureHTTP_URL_TO_HOST)
myfile\Path = PureHTTP_SplitURL(myurl.s,#PureHTTP_URL_TO_PATH)
myfile\outputfile = "c:\test.html"
myfile\limitspeed = 0
myfile\Callback = @MyCallback()

;numero_thread_maj = CreateThread(@mise_a_jour(),1)
Status.i = PureHTTP_Get_File(@myfile)
  
EndIf

Repeat
  WaitWindowEvent()
  fin_forever:
ForEver

Code : Tout sélectionner

numero_thread_maj = CreateThread(@mise_a_jour(),1)
;Status.i = PureHTTP_Get_File(@myfile)