PureBasic Forums - English

Posted: **Tue Oct 09, 2007 11:57 pm**

EDIT: removed, use the 2.0 linked here.

[Windows, PureBasic 4.02, HTTP]

Hi, after some lurking to similar routines posted in the forum, I decided to write one me too.

It can download a file in memory, to disk, in a single block or in chunk mode, optionally can call a callback function, can be aborted, can use a proxy (with or without authentication) and... don't remember, maybe nothing more.

Anyway, here some remarks / usage example from the source code, it's quite long so I'll put a link to a zip at the end of this post instead of pasting it. Hope it's ok with everyone.

Luis

Posted: **Sun Oct 14, 2007 8:32 pm**

Updated, see 1st post.

Bye!

Posted: **Tue Oct 16, 2007 7:20 am**

luis wrote:Updated, see 1st post.

Bye!

Thank you Luis; your code is really useful for me.

Regards.

Posted: **Tue Oct 16, 2007 1:38 pm**

This is just great.

Many thanks for sharing it.

cheers

Posted: **Tue Oct 16, 2007 2:46 pm**

Thanks!

Posted: **Thu Oct 18, 2007 5:09 pm**

Thanks for sharing your code.

I've added some details to the callback for reporting and included a working GUI example.

Code: Select all

; HTTPGetFromWeb()
; By Luis, October 2007
; Tested with PB 4.02 for Windows
; http://www.purebasic.fr/english/viewtopic.php?t=29083

; If you correct a bug, or extend the procedure, please post your version (or only the fix) on the original thread!
; If you use it, please acknowledge the source and the original author.

; Hope it helps someone.

; v1.00 - Oct 9,  2007

; v1.01 - Oct 14, 2007

; + Better error checking for disk full and file I/O errors
; + A check was missing after ReAllocateMemory(), added
; + Tested proxy authentication with SpoonProxy, guess should work with other proxies too.
; + Added the error constant #PBL_ERR_HTTP_PROXY_AUTH_REQ for HTTP 407 (proxy authentication required)

; v1.02 - Oct 18, 2007 - modified by TerryHough
; + added progress handling details to callback and download procedure
; + added GUI example

Prototype.l HTTPGetFromWeb_CallBack(lBytesReceived.l, lSize.l)

Structure T_PBL_HTTP_GET_FROM_WEB
  sURL.s             ; must contain the full URL (eg: http://www.domain.com/foo/bar/file.zip)
  lDestination.l     ; must contain #PBL_WRITE_TO_FILE or #PBL_WRITE_TO_MEMORY
  lChunkSize.l       ; must contain the size of the data chunk we want to read for any iteration, or 0 if we want all in one big block
  
  sUserAgent.s       ; defaults to "PureBasic for Windows (HTTPGetFromWeb)" if empty
  lPortNumber.l      ; defaults to 80 if not specified (if = 0)
  lAccess.l          ; defaults to #INTERNET_OPEN_TYPE_DIRECT if 0 (see the procedure body for other values)
  lFlags.l           ; defaults to #INTERNET_FLAG_NO_UI | #INTERNET_FLAG_RELOAD if 0 (see the procedure body for other values)
  sFullFileName.s    ; if lDestination = #PBL_WRITE_TO_FILE must contain the full pathname of the destination file
  *DestBuffer        ; if lDestination = #PBL_WRITE_TO_MEMORY will be used to allocate the destination memory buffer
  sError.STRING      ; if the procedure return is <> #PBL_OK it will contain an error message
  sProxyAndPort.s    ; if lAccess = #INTERNET_OPEN_TYPE_PROXY you must specify a proxy here (eg: "192.168.1.1:80")
  sProxyUsername.s   ; if lAccess = #INTERNET_OPEN_TYPE_PROXY and authentication is required must contain the username (not tested)
  sProxyPassword.s   ; if lAccess = #INTERNET_OPEN_TYPE_PROXY and authentication is required must contain the password (not tested)
  fpCallBack.HTTPGetFromWeb_CallBack ; if not #Null, the callback procedure will be called for any iteration (or one time only if lChunkSize = 0)
EndStructure

EnableExplicit
Define event.l, Quit.b
Global Time.f
Global BytesPerSecond.f
Global Msg.s
Global tHTTP.T_PBL_HTTP_GET_FROM_WEB
Global lTotBytesRead.l

; *** Gadgets ***
Enumeration
#Window
#Progress_Gadget
#Text_Gadget1
#Text_Gadget2
EndEnumeration
; ---------------

Enumeration
#PBL_OK

#PBL_ERR_CALL_FAILED
#PBL_ERR_OUT_OF_MEMORY
#PBL_ERR_INVALID_PARAMETERS
#PBL_ERR_NOT_FOUND
#PBL_ERR_ABORTED
#PBL_ERR_FILE_IO

#PBL_ERR_HTTP_MOVED_PERMANENTLY
#PBL_ERR_HTTP_TEMPORARY_REDIRECT
#PBL_ERR_HTTP_MOVED_TEMPORARILY
#PBL_ERR_HTTP_BAD_REQUEST
#PBL_ERR_HTTP_UNAUTHORIZED
#PBL_ERR_HTTP_FORBIDDEN
#PBL_ERR_HTTP_NOT_FOUND
#PBL_ERR_HTTP_PROXY_AUTH_REQ
#PBL_ERR_HTTP_REQUEST_TIMEOUT
#PBL_ERR_HTTP_GONE
#PBL_ERR_HTTP_INTERNAL_SERVER_ERROR
#PBL_ERR_HTTP_BAD_GATEWAY
#PBL_ERR_HTTP_SERVICE_UNAVAILABLE
#PBL_ERR_HTTP_GATEWAY_TIMEOUT

#PBL_WRITE_TO_FILE
#PBL_WRITE_TO_MEMORY
EndEnumeration

; *** from WININET.H --------------------------------------------------------------------------------
#INTERNET_FLAG_RELOAD                    = $80000000
#INTERNET_FLAG_RAW_DATA                  = $40000000
#INTERNET_FLAG_EXISTING_CONNECT          = $20000000
#INTERNET_FLAG_ASYNC                     = $10000000
#INTERNET_FLAG_PASSIVE                   = $08000000
#INTERNET_FLAG_NO_CACHE_WRITE            = $04000000
#INTERNET_FLAG_MAKE_PERSISTENT           = $02000000
#INTERNET_FLAG_FROM_CACHE                = $01000000
#INTERNET_FLAG_SECURE                    = $00800000
#INTERNET_FLAG_KEEP_CONNECTION           = $00400000
#INTERNET_FLAG_NO_AUTO_REDIRECT          = $00200000
#INTERNET_FLAG_READ_PREFETCH             = $00100000
#INTERNET_FLAG_NO_COOKIES                = $00080000
#INTERNET_FLAG_NO_AUTH                   = $00040000
#INTERNET_FLAG_CACHE_IF_NET_FAIL         = $00010000
#INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTP   = $00008000
#INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS  = $00004000
#INTERNET_FLAG_IGNORE_CERT_DATE_INVALID  = $00002000
#INTERNET_FLAG_IGNORE_CERT_CN_INVALID    = $00001000
#INTERNET_FLAG_RESYNCHRONIZE             = $00000800
#INTERNET_FLAG_HYPERLINK                 = $00000400
#INTERNET_FLAG_NO_UI                     = $00000200
#INTERNET_FLAG_PRAGMA_NOCACHE            = $00000100
#INTERNET_FLAG_CACHE_ASYNC               = $00000080
#INTERNET_FLAG_FORMS_SUBMIT              = $00000040
#INTERNET_FLAG_NEED_FILE                 = $00000010

#INTERNET_INVALID_PORT_NUMBER            = 0
#INTERNET_DEFAULT_FTP_PORT               = 21
#INTERNET_DEFAULT_GOPHER_PORT            = 70
#INTERNET_DEFAULT_HTTP_PORT              = 80
#INTERNET_DEFAULT_HTTPS_PORT             = 443
#INTERNET_DEFAULT_SOCKS_PORT             = 1080

#INTERNET_SERVICE_URL                    = 0
#INTERNET_SERVICE_FTP                    = 1
#INTERNET_SERVICE_GOPHER                 = 2
#INTERNET_SERVICE_HTTP                   = 3

#INTERNET_OPEN_TYPE_PRECONFIG                    = 0   ; use registry configuration
#INTERNET_OPEN_TYPE_DIRECT                       = 1   ; direct to net
#INTERNET_OPEN_TYPE_PROXY                        = 3   ; via named proxy
#INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY  = 4   ; prevent using java/script/INS

#HTTP_QUERY_FLAG_NUMBER                 = $20000000
#HTTP_QUERY_CONTENT_LENGTH              = 5
#HTTP_QUERY_STATUS_CODE                 = 19

#INTERNET_OPTION_PROXY_USERNAME         = 43
#INTERNET_OPTION_PROXY_PASSWORD         = 44

#HTTP_STATUS_OK                         = 200
; --------------------------------------------------------------------------------------------------

Macro MAKELANGID(p, s)
(s << 10 | p)
EndMacro

Macro PRIMARYLANGID(lgid)
(lgid & 0x3ff)
EndMacro

Macro SUBLANGID(lgid)
(lgid >> 10)
EndMacro

Procedure.l URLGetPath(sURL.s, *sPath.STRING)
  ; sURL
  ; [in]
  ; the full url to process
  
  ; *sPath
  ; [out]
  ; the portion of the url at the right of the domain
  
  ; [return]
  ; #PBL_OK if successful
  
  Protected lPos.l, lPosEnd.l
  
  lPos = FindString(sURL, ":", 1)
  If lPos
    If Mid(sURL, lPos + 1, 2) = "//"
      lPosEnd = FindString(sURL, "/", lPos + 3)
      
      If lPosEnd
        *sPath\s = Right(sURL, Len(sURL) - lPosEnd + 1)
        ProcedureReturn #PBL_OK
      EndIf
    EndIf
  EndIf
  ProcedureReturn #PBL_ERR_NOT_FOUND
EndProcedure


Procedure.l URLGetDomain (sURL.s, *sDomain.STRING)
  ; sURL
  ; [in]
  ; the full url to process
  
  ; *sDomain
  ; [out]
  ; the domain contained in the full url right after the protocol
  
  ; [return]
  ; #PBL_OK if successful
  
  Protected lPos.l, lPosEnd.l
  
  lPos = FindString(sURL, ":", 1)
  If lPos
    If Mid(sURL, lPos + 1, 2) = "//"
      lPosEnd = FindString(sURL, "/", lPos + 3)
      
      If lPosEnd
        lPosEnd - (LPos + 3)
      Else
        lPosEnd = Len(sURL) - (lPos + 2)
      EndIf
      
      If lPosEnd
        *sDomain\s = Mid(sURL, lPos + 3, lPosEnd)
        ProcedureReturn #PBL_OK
      EndIf
    EndIf
  EndIf
  ProcedureReturn #PBL_ERR_NOT_FOUND
EndProcedure

Procedure.l GetLastErrorString(*sErrText.STRING)
  ; *sErrText
  ; [out]
  ; the error string correspondent to the code returned by GetLastError_() if this is > 0
  
  ; [return]
  ; the error code returned by GetLastError_() or 0 if no error
  
  Protected lpMsgBuf.l, lErrCode.l = GetLastError_()
  
  If lErrCode
    FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER | #FORMAT_MESSAGE_FROM_SYSTEM, #Null, lErrCode, MAKELANGID(#LANG_NEUTRAL, #SUBLANG_DEFAULT), @lpMsgBuf, 0, #Null)
    *sErrText\s = PeekS(lpMsgBuf)
    LocalFree_(lpMsgBuf)
    ProcedureReturn lErrCode
  Else
    *sErrText\s = ""
    ProcedureReturn 0
  EndIf
  
EndProcedure


Procedure.l HTTPGetFromWeb(*tHTTP.T_PBL_HTTP_GET_FROM_WEB, *lTotBytesRead)
  ; *tHTTP
  ; [in / out]
  ; see the definition of structure T_PBL_HTTP_GET_FROM_WEB for the usage of the input / output fields
  
  ; *lTotBytesRead
  ; pointer to a long, it will contain the number of bytes read if the call is successful
  
  ; [return]
  ; #PBL_OK                               if successful
  ; #PBL_ERR_INVALID_PARAMETERS           if parameters are missing or invalid
  ; #PBL_ERR_CALL_FAILED                  if the proc fails, in this case the field sError of the *tHTTP structure will contain a message
  ; #PBL_ERR_OUT_OF_MEMORY                if there is an error when allocating memory for the data buffers
  ; #PBL_ERR_FILE_IO                      if there is an error while writing the file to disk
  ;
  ; the following errors are reported when the HTTP status code is different from HTTP OK (200)
  ; the sError field is again loaded with a message describing the error
  
  ; #PBL_ERR_HTTP_MOVED_PERMANENTLY
  ; #PBL_ERR_HTTP_MOVED_TEMPORARILY
  ; #PBL_ERR_HTTP_TEMPORARY_REDIRECT
  ; #PBL_ERR_HTTP_BAD_REQUEST
  ; #PBL_ERR_HTTP_UNAUTHORIZED
  ; #PBL_ERR_HTTP_FORBIDDEN
  ; #PBL_ERR_HTTP_NOT_FOUND
  ; #PBL_ERR_HTTP_PROXY_AUTH_REQ
  ; #PBL_ERR_HTTP_REQUEST_TIMEOUT
  ; #PBL_ERR_HTTP_GONE
  ; #PBL_ERR_HTTP_INTERNAL_SERVER_ERROR
  ; #PBL_ERR_HTTP_BAD_GATEWAY
  ; #PBL_ERR_HTTP_SERVICE_UNAVAILABLE
  ; #PBL_ERR_HTTP_GATEWAY_TIMEOUT
  
  ; [some usage examples]
  ;
  ; The simplest form: download bar.zip in memory.
  ; The pointer to the allocated memory area will be copied in tHTTP\*DestBuffer
  ;
  ; tHTTP\sURL = "http://www.domain.com/foo/bar.zip"
  ; tHTTP\lDestination = #PBL_WRITE_TO_MEMORY
  ;
  ; HTTPGetFromWeb (@tHTTP, @lTotBytesRead)
  
  
  ; Same as above, loaded in memory but copied to the specified file.
  ; The memory in this case will be automatically freed by the procedure after
  ; saving the file to disk.
  ;
  ; tHTTP\sURL = "http://www.domain.com/foo/bar.zip"
  ; tHTTP\lDestination = #PBL_WRITE_TO_FILE
  ; tHTTP\sFullFileName = "c:\download\bar.zip"
  ;
  ; HTTPGetFromWeb (@tHTTP, @lTotBytesRead)
  
  
  ; Again we download bar.zip, but this time we don't load it entirely in memory.
  ; We load it in "chunks" of 16384 bytes, we save a chunk to file and then repeat
  ; the process until the download is completed.
  ; In this call we use a callback procedure as well.
  ; The callback procedure (see the prototype definition) will receive the number of
  ; bytes downloaded up to this point and the total size of the download (if available, else 0).
  
  ; tHTTP\sURL = "http://www.domain.com/foo/bar.zip"
  ; tHTTP\lDestination = #PBL_WRITE_TO_FILE
  ; tHTTP\sFullFileName = "c:\download\bar.zip"
  ; tHTTP\lChunkSize = 16384
  ; tHTTP\fpCallBack = @MyCallBack()
  ;
  ; HTTPGetFromWeb (@tHTTP, @lTotBytesRead)
  
  
  ; Same as above but using a proxy without authentication required.
  ;
  ; tHTTP\sURL = "http://www.domain.com/foo/bar.zip"
  ; tHTTP\lAccess = #INTERNET_OPEN_TYPE_PROXY
  ; tHTTP\sProxyAndPort = "192.168.1.1:80"
  ; tHTTP\lDestination = #PBL_WRITE_TO_FILE
  ; tHTTP\sFullFileName = "c:\download\bar.zip"
  ; tHTTP\lChunkSize = 16384
  ; tHTTP\fpCallBack = @MyCallBack()
  ;
  ; HTTPGetFromWeb (@tHTTP, @lTotBytesRead)
  
  ; [notes]
  
  ; The procedure will fall back to use the chunk method even if the "all in one block" is requested if the server don't
  ; return the total size of the file we are about to download.
  ; This for example happen when downloading stock quotes from the Yahoo site.
  
  ; The callback procedure can optionally abort a download (if in chunk mode) when a user defined custom condition arise,
  ; returning #False instead of #True.
  
  ; *tHTTP\lAccess - see InternetOpen() documentation for more flags values
  ;
  ; #INTERNET_OPEN_TYPE_DIRECT                      = Direct connection to the Internet.
  ; #INTERNET_OPEN_TYPE_PROXY                       = Passes requests to the proxy specified in sProxyAndPort
  ;
  ; *tHTTP\lFlags - see HttpOpenRequest() documentation for more flags values
  ;
  ; #INTERNET_FLAG_NO_UI              = Disables the cookie dialog box.
  ; #INTERNET_FLAG_RELOAD             = Forces a download of the requested file, object, or directory listing from the origin server, not from the cache.
  ; #INTERNET_FLAG_NO_COOKIES         = Does not automatically add cookie headers to requests, and does not automatically add returned cookies to the cookie database.
  ; #INTERNET_FLAG_NO_AUTO_REDIRECT   = Does not automatically handle redirection in HttpSendRequest.
  
  Protected sDomain.STRING, sPath.STRING
  Protected hInet.l, hInetCon.l, hReq.l
  Protected lStatusCode.l, lContentLen.l, lBytesRead.l, lChunkCount.l, lBufSize.l, lLongSize.l = SizeOf(Long)
  Protected nFileNum.l, flgEOF.l = #False
  Protected lDefaultChunkSize.l = 64 * 1024 ; 64 KBytes - used when chunk size is not specified (0) and a fallback to chunk mode is needed
  
  ; clean up
  
  PokeL (*lTotBytesRead, 0)
  
  *tHTTP\sError\s = ""
  
  
  ; sanity checks
  
  If URLGetDomain (*tHTTP\sURL, @sDomain) <> #PBL_OK
    *tHTTP\sError\s = "Domain not found in the URL."
    ProcedureReturn #PBL_ERR_INVALID_PARAMETERS
  EndIf
  
  If URLGetPath(*tHTTP\sURL, @sPath) <> #PBL_OK
    *tHTTP\sError\s = "Path not found in the URL."
    ProcedureReturn #PBL_ERR_INVALID_PARAMETERS
  EndIf
  
  Select *tHTTP\lDestination
  Case #PBL_WRITE_TO_FILE
    If Len(*tHTTP\sFullFileName) = 0
      *tHTTP\sError\s = "A filename is required."
      ProcedureReturn #PBL_ERR_INVALID_PARAMETERS
    EndIf
    
  Case #PBL_WRITE_TO_MEMORY
    *tHTTP\DestBuffer = #Null
    
    Default
    *tHTTP\sError\s = "Invalid destination."
    ProcedureReturn #PBL_ERR_INVALID_PARAMETERS
  EndSelect
  
  If *tHTTP\lAccess = #INTERNET_OPEN_TYPE_PROXY
    If Len(*tHTTP\sProxyAndPort) = 0
      *tHTTP\sError\s = "A proxy name[:port] is required."
      ProcedureReturn #PBL_ERR_INVALID_PARAMETERS
    EndIf
  EndIf
  
  If *tHTTP\lChunkSize < 0 ; paranoid
    *tHTTP\lChunkSize = 0
  EndIf
  
  
  ; defaults
  
  If *tHTTP\lAccess = 0 ; if access type not specified
    *tHTTP\lAccess = #INTERNET_OPEN_TYPE_DIRECT
  EndIf
  
  If Len(*tHTTP\sUserAgent) = 0 ; if user agent not specified
    *tHTTP\sUserAgent = "PureBasic for Windows (HTTPGetFromWeb)"
  EndIf
  
  If *tHTTP\lFlags = 0 ; if flags not specified
    *tHTTP\lFlags = #INTERNET_FLAG_NO_UI | #INTERNET_FLAG_RELOAD ; no popup for cookies and load from internet (not from cache)
  EndIf
  
  If *tHTTP\lPortNumber = 0 ; if HTTP port not specified
    *tHTTP\lPortNumber = 80
  EndIf
  
  
  ; *** Internet Open ***
  
  hInet = InternetOpen_(*tHTTP\sUserAgent, *tHTTP\lAccess, *tHTTP\sProxyAndPort, #Null, 0)
  
  If hInet = #Null
    If GetLastErrorString (@*tHTTP\sError) = 0
      *tHTTP\sError\s = "InternetOpen() failed."
    EndIf
    ProcedureReturn #PBL_ERR_CALL_FAILED
  EndIf
  
  
  ; *** Internet Connect ***
  
  hInetCon = InternetConnect_(hInet, sDomain\s, *tHTTP\lPortNumber, #Null, #Null, #INTERNET_SERVICE_HTTP, 0, 0)
  
  If hInetCon = #Null
    If GetLastErrorString (@*tHTTP\sError) = 0
      *tHTTP\sError\s = "InternetConnect() failed."
    EndIf
    ProcedureReturn #PBL_ERR_CALL_FAILED
  EndIf
  
  ; *** proxy authentication required ? *** (not tested)
  
  If *tHTTP\lAccess = #INTERNET_OPEN_TYPE_PROXY
    If Len(*tHTTP\sProxyUsername)
      If InternetSetOption_(hInetCon, #INTERNET_OPTION_PROXY_USERNAME, *tHTTP\sProxyUsername, Len(*tHTTP\sProxyUsername)) = #False
        If GetLastErrorString (@*tHTTP\sError) = 0
          *tHTTP\sError\s = "Proxy username setting failed."
        EndIf
        ProcedureReturn #PBL_ERR_CALL_FAILED
      EndIf
    EndIf
  EndIf
  
  
  If *tHTTP\lAccess = #INTERNET_OPEN_TYPE_PROXY
    If Len(*tHTTP\sProxyPassword)
      If InternetSetOption_(hInetCon, #INTERNET_OPTION_PROXY_PASSWORD, *tHTTP\sProxyPassword, Len(*tHTTP\sProxyPassword)) = #False
        If GetLastErrorString (@*tHTTP\sError) = 0
          *tHTTP\sError\s = "Proxy password setting failed."
        EndIf
        ProcedureReturn #PBL_ERR_CALL_FAILED
      EndIf
    EndIf
  EndIf
  
  
  ; *** Open Request ***
  
  hReq = HttpOpenRequest_(hInetCon, "GET", sPath\s, #Null, #Null, #Null, *tHTTP\lFlags, 0)
  
  If hReq = #Null
    If GetLastErrorString (@*tHTTP\sError) = 0
      *tHTTP\sError\s = "HttpOpenRequest() failed."
    EndIf
    ProcedureReturn #PBL_ERR_CALL_FAILED
  EndIf
  
  
  ; *** Send Request ***
  
  If (Not HttpSendRequest_(hReq, #Null, 0, 0, 0))
    If GetLastErrorString (@*tHTTP\sError) = 0
      *tHTTP\sError\s = "HttpSendRequest() failed."
    EndIf
    ProcedureReturn #PBL_ERR_CALL_FAILED
  EndIf
  
  
  ; *** Query Info (status code) ***
  
  If (Not HttpQueryInfo_(hReq, #HTTP_QUERY_FLAG_NUMBER | #HTTP_QUERY_STATUS_CODE, @lStatusCode, @lLongSize, #Null))
    If GetLastErrorString (@*tHTTP\sError) = 0
      *tHTTP\sError\s = "HttpQueryInfo() failed."
    EndIf
    ProcedureReturn #PBL_ERR_CALL_FAILED
  EndIf
  
  
  ; *** check status code ***
  
  If lStatusCode <> #HTTP_STATUS_OK
    *tHTTP\sError\s = "HTTP: " + Str(lStatusCode)
    
    Select lStatusCode
    Case 301
      *tHTTP\sError\s + " (moved permanently)."
      ProcedureReturn #PBL_ERR_HTTP_MOVED_PERMANENTLY
    Case 302
      *tHTTP\sError\s + " (moved temporarily)."
      ProcedureReturn #PBL_ERR_HTTP_MOVED_TEMPORARILY
    Case 307
      *tHTTP\sError\s + " (temporary redirect)."
      ProcedureReturn #PBL_ERR_HTTP_TEMPORARY_REDIRECT
    Case 400
      *tHTTP\sError\s + " (bad request)."
      ProcedureReturn #PBL_ERR_HTTP_BAD_REQUEST
    Case 401
      *tHTTP\sError\s + " (unauthorized)."
      ProcedureReturn #PBL_ERR_HTTP_UNAUTHORIZED
    Case 403
      *tHTTP\sError\s + " (forbidden)."
      ProcedureReturn #PBL_ERR_HTTP_FORBIDDEN
    Case 404
      *tHTTP\sError\s + " (not found)."
      ProcedureReturn #PBL_ERR_HTTP_NOT_FOUND
    Case 407
      *tHTTP\sError\s + " (proxy authentication required)."
      ProcedureReturn #PBL_ERR_HTTP_PROXY_AUTH_REQ
    Case 408
      *tHTTP\sError\s + " (request timeout)."
      ProcedureReturn #PBL_ERR_HTTP_REQUEST_TIMEOUT
    Case 410
      *tHTTP\sError\s + " (gone)."
      ProcedureReturn #PBL_ERR_HTTP_GONE
    Case 500
      *tHTTP\sError\s + " (internal server error)."
      ProcedureReturn #PBL_ERR_HTTP_INTERNAL_SERVER_ERROR
    Case 502
      *tHTTP\sError\s + " (bad gateway)."
      ProcedureReturn #PBL_ERR_HTTP_BAD_GATEWAY
    Case 503
      *tHTTP\sError\s + " (service unavailable)."
      ProcedureReturn #PBL_ERR_HTTP_SERVICE_UNAVAILABLE
    Case 504
      *tHTTP\sError\s + " (gateway timeout)."
      ProcedureReturn #PBL_ERR_HTTP_GATEWAY_TIMEOUT
    EndSelect
    
    ProcedureReturn #PBL_ERR_CALL_FAILED
  EndIf
  
  
  ; *** Query Info (content length) ***
  
  If (Not HttpQueryInfo_(hReq, #HTTP_QUERY_FLAG_NUMBER | #HTTP_QUERY_CONTENT_LENGTH, @lContentLen, @lLongSize, #Null))
    lContentLen = 0 ; if failed, we set content length = 0
  EndIf
  
  ; *** Start the timer ***
  Time = ElapsedMilliseconds()
  ; -----------------------
  
  Select *tHTTP\lDestination
    
  Case #PBL_WRITE_TO_MEMORY ; we want to write the data to memory
    
    ; we want to read it all at once AND we know the total size
    
    If *tHTTP\lChunkSize = 0
      If lContentLen > 0
        
        *tHTTP\DestBuffer = AllocateMemory (lContentLen)
        
        If (*tHTTP\DestBuffer = 0)
          *tHTTP\sError\s = "Out of memory."
          ProcedureReturn #PBL_ERR_OUT_OF_MEMORY
        EndIf
        
        If (Not InternetReadFile_(hReq, *tHTTP\DestBuffer, lContentLen, @lBytesRead))
          If GetLastErrorString (@*tHTTP\sError) = 0
            *tHTTP\sError\s = "InternetReadFile() failed."
          EndIf
          ProcedureReturn #PBL_ERR_CALL_FAILED
        EndIf
        
        If *tHTTP\fpCallBack: *tHTTP\fpCallBack (lBytesRead, lContentLen) : EndIf
        
        PokeL (*lTotBytesRead, lBytesRead)
        
      EndIf ; lContentLen > 0
    EndIf
    
    
    ; we want to read it all at once BUT we don't know the total size (we must fallback to chunk mode)
    ; OR
    ; we want to read it in chunks
    
    If (*tHTTP\lChunkSize = 0 And lContentLen = 0) Or (*tHTTP\lChunkSize > 0)
      
      If *tHTTP\lChunkSize = 0
        lBufSize = lDefaultChunkSize
      Else
        lBufSize = *tHTTP\lChunkSize
      EndIf
      
      *tHTTP\DestBuffer = AllocateMemory (lBufSize)
      
      If (*tHTTP\DestBuffer = 0)
        *tHTTP\sError\s = "Out of memory."
        ProcedureReturn #PBL_ERR_OUT_OF_MEMORY
      EndIf
      
      lChunkCount = 0
      
      Repeat
        If (InternetReadFile_(hReq, *tHTTP\DestBuffer + lBufSize * lChunkCount, lBufSize, @lBytesRead)) = #False
          If GetLastErrorString (@*tHTTP\sError) > 0 ; we really have an error
            ProcedureReturn #PBL_ERR_CALL_FAILED
          EndIf
        EndIf
        
        If *tHTTP\fpCallBack
          If *tHTTP\fpCallBack ((lChunkCount * lBufSize) + lBytesRead, lContentLen) = #False
            ; abort requested by the callback
            
            FreeMemory(*tHTTP\DestBuffer)
            *tHTTP\sError\s = "CallBack is aborting."
            ProcedureReturn #PBL_ERR_ABORTED
          EndIf
        EndIf
        
        If lBufSize = lBytesRead ; probably more to come
          lChunkCount + 1
          *tHTTP\DestBuffer = ReAllocateMemory (*tHTTP\DestBuffer, lBufSize * (lChunkCount + 1))
        Else ; last chunk
          *tHTTP\DestBuffer = ReAllocateMemory (*tHTTP\DestBuffer, lBufSize * lChunkCount + lBytesRead)
          flgEOF = #True
        EndIf
        
        If (*tHTTP\DestBuffer = 0)
          *tHTTP\sError\s = "Out of memory."
          ProcedureReturn #PBL_ERR_OUT_OF_MEMORY
        EndIf
        
      Until flgEOF
      
      PokeL (*lTotBytesRead, lBufSize * lChunkCount + lBytesRead)
      
    EndIf
    
  Case #PBL_WRITE_TO_FILE; we want to write the data to file
    
    nFileNum = CreateFile (#PB_Any, *tHTTP\sFullFileName)
    
    If nFileNum = 0
      *tHTTP\sError\s = "File creation failed."
      ProcedureReturn #PBL_ERR_CALL_FAILED
    EndIf
    
    ; we want to read it all at once AND we know the total size
    
    If *tHTTP\lChunkSize = 0
      
      If lContentLen > 0
        
        *tHTTP\DestBuffer = AllocateMemory (lContentLen)
        
        If (*tHTTP\DestBuffer = 0)
          *tHTTP\sError\s = "Out of memory."
          ProcedureReturn #PBL_ERR_OUT_OF_MEMORY
        EndIf
        
        If (Not InternetReadFile_(hReq, *tHTTP\DestBuffer, lContentLen, @lBytesRead))
          If GetLastErrorString (@*tHTTP\sError) = 0
            *tHTTP\sError\s = "InternetReadFile() failed."
          EndIf
          ProcedureReturn #PBL_ERR_CALL_FAILED
        EndIf
        
        If *tHTTP\fpCallBack: *tHTTP\fpCallBack (lBytesRead, lContentLen) : EndIf
        
        WriteData(nFileNum, *tHTTP\DestBuffer, lBytesRead)
        
        PokeL (*lTotBytesRead, lBytesRead)
        
      EndIf ; lContentLen > 0
      
    EndIf
    
    
    ; we want to read it all at once BUT we don't know the total size (we must fallback to chunk mode)
    ; OR
    ; we want to read it in chunks
    
    If (*tHTTP\lChunkSize = 0 And lContentLen = 0) Or (*tHTTP\lChunkSize > 0)
      
      If *tHTTP\lChunkSize = 0
        lBufSize = lDefaultChunkSize
      Else
        lBufSize = *tHTTP\lChunkSize
      EndIf
      
      *tHTTP\DestBuffer = AllocateMemory (lBufSize)
      
      If (*tHTTP\DestBuffer = 0)
        *tHTTP\sError\s = "Out of memory."
        ProcedureReturn #PBL_ERR_OUT_OF_MEMORY
      EndIf
      
      lChunkCount = 0
      
      Repeat
        If (InternetReadFile_(hReq, *tHTTP\DestBuffer, lBufSize, @lBytesRead)) = #False
          If GetLastErrorString (@*tHTTP\sError) > 0 ; we really have an error
            ProcedureReturn #PBL_ERR_CALL_FAILED
          EndIf
        EndIf
        
        If *tHTTP\fpCallBack
          If *tHTTP\fpCallBack ((lChunkCount * lBufSize) + lBytesRead, lContentLen) = #False
            ; abort requested by the callback
            
            FreeMemory(*tHTTP\DestBuffer)
            CloseFile(nFileNum)
            DeleteFile(*tHTTP\sFullFileName)
            *tHTTP\sError\s = "CallBack is aborting."
            ProcedureReturn #PBL_ERR_ABORTED
          EndIf
        EndIf
        
        WriteData (nFileNum, *tHTTP\DestBuffer, lBytesRead)
        
        If lBufSize = lBytesRead ; probably more to come
          lChunkCount + 1
          
          If Lof(nFileNum) <> lChunkCount * lBufSize
            FreeMemory(*tHTTP\DestBuffer)
            CloseFile(nFileNum)
            DeleteFile(*tHTTP\sFullFileName)
            *tHTTP\sError\s = "File I/O error - Disk full ?"
            ProcedureReturn #PBL_ERR_FILE_IO
          EndIf
        Else ; last chunk
          flgEOF = #True
        EndIf
        
      Until flgEOF
      
      PokeL (*lTotBytesRead, (lChunkCount * lBufSize) + lBytesRead)
      
    EndIf
    
    FreeMemory(*tHTTP\DestBuffer)
    
    FlushFileBuffers(nFileNum)
    
    If Lof(nFileNum) <> PeekL(*lTotBytesRead)
      CloseFile(nFileNum)
      DeleteFile(*tHTTP\sFullFileName)
      *tHTTP\sError\s = "File I/O error - Disk full ?"
      PokeL (*lTotBytesRead, 0)
      ProcedureReturn #PBL_ERR_FILE_IO
    EndIf
    
    CloseFile(nFileNum)
    
  EndSelect
  
  ; *** close connection ***
  If (Not InternetCloseHandle_(hInetCon))
    *tHTTP\sError\s = "InternetCloseHandle() error."
    ProcedureReturn #PBL_ERR_CALL_FAILED
  EndIf
  
  ; *** close Internet ***
  If (Not InternetCloseHandle_(hInet))
    *tHTTP\sError\s = "InternetCloseHandle() error."
    ProcedureReturn #PBL_ERR_CALL_FAILED
  EndIf
  
  ; *** Pass back the elapsed time ***
  Time = (ElapsedMilliseconds() - Time)/1000  ; pass back the elapsed time
  ; ----------------------------------
  ProcedureReturn #PBL_OK
EndProcedure

Procedure.l MyCallBack(lBytesReceived.l, lSize.l)
  BytesPerSecond = Round(lBytesReceived/((ElapsedMilliseconds() - Time)/1000)/1024,#True)
  SetGadgetState(#Progress_Gadget, Round((lBytesReceived / lSize)*100,#True))
  Msg.s = Str(lBytesReceived) + " of " + Str(lSize) + " bytes received. "
  Msg   + StrF((lBytesReceived/lSize)*100,1) + "% complete. "
  Msg   + Str(BytesPerSecond)+"kb/s"
  SetGadgetText(#Text_Gadget1,Msg)
  ProcedureReturn #True
EndProcedure

;******************************************************************************
; Test
;******************************************************************************

; Example usage - this example downloads a PDF file and then displays it.
tHTTP\sURL = "http://www.irs.gov/pub/irs-pdf/i1040gi.pdf"   ; URL of the source file
tHTTP\lDestination = #PBL_WRITE_TO_FILE                     ; #PBL_WRITE_TO_FILE or #PBL_WRITE_TO_MEMORY
tHTTP\lChunkSize = 8192 ; 8Kb best, 16Kb second best        ; 0 to download entire file, or chunk size
tHTTP\fpCallBack = @MyCallBack()                            ; Callback procedure to use
tHTTP\sFullFileName = "C:\" + GetFilePart(tHTTP\sURL)       ; Path of target file

If OpenWindow(#Window,0,0,500,300,"HTTPGetFromWeb Example",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  If CreateGadgetList(WindowID(#Window))
    ProgressBarGadget(#Progress_Gadget,10,30,480,20,0,100,#PB_ProgressBar_Smooth)
    TextGadget(#Text_Gadget1,10,46,480,20,"",#PB_Text_Center)
    TextGadget(#Text_Gadget2,10,66,480,20,tHTTP\sURL,#PB_Text_Center)
    
    If HTTPGetFromWeb (@tHTTP, @lTotBytesRead) = #PBL_OK
      MessageRequester("HTTPGeFromWeb", "Successful = " + Str(lTotBytesRead) + " bytes downloaded in " + StrF(Time,1) + " seconds.",#MB_ICONINFORMATION)
      ;OpenHelp(tHTTP\sFullFileName, "OpeningBanner.html")      ; Example of a .CHM file opened at a specific page
      ;RunProgram("hh.exe","Manual.chm","C:\",#PB_Program_Wait) ; Similar to above, but directly calling HtmlHelp
      RunProgram(tHTTP\sFullFileName,"","C:\",#PB_Program_Wait) ; Example to run downloaded file with a File Association
                                                                ; program established, here we used a .PDF file.
      Quit = #True ; Optionally end task here                                                           
    Else
      MessageRequester("HTTPGetFromWeb", "Failure = " + tHTTP\sError\s, #MB_ICONERROR)
      Quit = #True
    EndIf
  Else
    MessageRequester("Program Error","Gadget list wasn't created",#MB_ICONERROR)
    Quit = #True
  EndIf
Else
  MessageRequester("Program Error","Window failed To open",#MB_ICONERROR)
  Quit = #True
EndIf
Repeat
  event.l = WaitWindowEvent()
Until Quit Or event = #PB_Event_CloseWindow
End

Posted: **Fri Oct 26, 2007 1:21 pm**

TerryHough wrote:I've added some details to the callback for reporting and included a working GUI example.
Code: Select all
; HTTPGetFromWeb()
; By Luis, October 2007
; Tested with PB 4.02 for Windows
; http://www.purebasic.fr/english/viewtopic.php?t=29083

Hi, nice gui example but the window seems to freeze when download a larger file?!

I also get an error while not connected to the internet saying:

Code: Select all

[ERROR] Specified address is null !

The line code was:

Code: Select all

AT_MESSAGE_FROM_SYSTEM, #Null, lErrCode, MAKELANGID(#LANG_NEUTRAL, #SUBLANG_DEFAULT), @lpMsgBuf, 0, #Null)

Is there a way to fix these problems, thanks.

Posted: **Fri Oct 26, 2007 2:46 pm**

Sorry, I can't duplicate either problem. I've tested with a 100Mb file many times and have not had a failure yet.

Perhaps luis, the original author, may chime in.

Posted: **Fri Oct 26, 2007 3:13 pm**

I haven't used it for any 100mb files but I have downloaded many smaller files with nary a problem.

cheers

Posted: **Fri Oct 26, 2007 5:08 pm**

abc123 wrote: I also get an error while not connected to the internet saying:
Code: Select all
[ERROR] Specified address is null !

Sorry, I don't understand where this message is coming from, or when.
Who is emitting this text and where ?

Please note you should check to be connected to Internet before calling HTTPGetFromWeb(). The procedure expect a Internet connection is in place.

Anyway, it should gracefully return an error code + message string even when called offline.

It does for me.

Maybe if you can give us some more info and the smallest code snippet using HTTPGetFromWeb() causing this problem... (possibly using the last version I attached in the original post) we can help. What OS are you using ? What kind of Internet connection?

Bye,

Luis

Posted: **Fri Oct 26, 2007 5:43 pm**

About the window freezing, I believe the problem is not in the routine but in the demo program. The way it is constructed, the repeat-loop processing the messages for the window is not reached until the download is completed. The progress bar update generate a lot of messages and these need to be removed from the queue and processed. Try to add a "WindowEvent()" in the callback routine and the freezing should go away.

BTW: If you like the fact the TerryHough's routine keep tracks of the time passed, you should at least add a field to the communication structure instead of communicate using a global variable. The idea is the procedure should be a black box, and the communication should be go through the params passed to it.

For the reasons above, for now I advise to use the 1.01 version and build from here if you need to. Maybe I'll add this field in the future and do a gui example program if requested, but it should not be needed, it's all normal purebasic/windows programming and having the source should be enough for all.

Bye!

Posted: **Sun Oct 28, 2007 3:06 pm**

I have tried your updated code and it still gave me an error while not connected to the internet.
For my program i want to inform the user why the program coundnt connect to the internet.

Posted: **Sun Oct 28, 2007 3:50 pm**

abc123 wrote:I have tried your updated code and it still gave me an error while not connected to the internet.

Well, it's not a surprise. The 1.01 was write before your post. Cannot contain any modification to that effect.

I'll try again:

luis wrote: Maybe if you can give us some more info and the smallest code snippet using HTTPGetFromWeb() causing this problem... (possibly using the last version I attached in the original post) we can help. What OS are you using ? What kind of Internet connection?

So please post the smallest code snippet calling HTTPGetFromWeb() 1.01 and causing the problem and any other info you can provide.

abc123 wrote: For my program i want to inform the user why the program coundnt connect to the internet.

If you want to check if you are connected to Internet you should investigate the InternetGetConnectedStateEx_ API's function.
Then, when you know you are connected (by modem, by lan, by proxy) you can try to download.

Anyway I still don't understand where your error message is coming from, or when. Who is emitting this text and where ? Where the string "[ERROR] Specified address is null !" is coming from ?

And about the freezing problem ? Did you try a

Code: Select all

While WindowEvent(): Delay(0):  Wend

in the callback ?

Posted: **Sun Oct 28, 2007 4:58 pm**

Here, you can check my project:

download.zip

To see the error, you will need to be disconnected from the internet.

Posted: **Sun Oct 28, 2007 6:11 pm**

GetLastError() it's a wierd API function. It's not always affidable (sometimes returns OK when the parent API function returns ERROR) and now I just saw some error codes returned cannot be automatically translated with FormatMessage().

Probably in a next version of this procedure I'll rearrange its approach to error checking in some way.

For now, replace the old GetLastErrorString with this:

Code: Select all


Procedure.l GetLastErrorString(*sErrText.STRING)
; *sErrText
; [out]
; the error string correspondent to the code returned by GetLastError_() if this is > 0
 
; [return]
; the error code returned by GetLastError_() or 0 if no error
 
 Protected lpMsgBuf.l, lErrCode.l = GetLastError_()
 
 If lErrCode
    Select lErrCode
        Case 12000 To 12174    
                ; these error codes cannot be translated with FormatMessage_()
                ; see Wininet.h if you want to manually map them to strings     
                
                ; http://msdn2.microsoft.com/en-us/library/ms681384.aspx
                
                *sErrText\s = "Internet error number " + Str(lErrCode) 
                ProcedureReturn lErrCode                    
        Default                        
            If (FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER | #FORMAT_MESSAGE_FROM_SYSTEM, #Null, lErrCode, MAKELANGID(#LANG_NEUTRAL, #SUBLANG_DEFAULT), @lpMsgBuf, 0, #Null))
                *sErrText\s = PeekS(lpMsgBuf)
                LocalFree_(lpMsgBuf)
                ProcedureReturn lErrCode
            Else
                *sErrText\s = "Unknown error (FormatMessage() failed)."
                ProcedureReturn lErrCode
            EndIf
    EndSelect                
 Else
    ; no error 
    *sErrText\s = ""
    ProcedureReturn 0
 EndIf
 
EndProcedure

Please note the remarks

If you want translate the codes to text add "CASE"s in the select case and use this table

http://msdn2.microsoft.com/en-us/library/ms681384.aspx

follow "Internet Error Codes"

It's still better to check for a valid Internet connection before use HTTPGetFromWeb()

PureBasic Forums - English

HTTPGetFromWeb() - HTTP download to memory or file

HTTPGetFromWeb() - HTTP download to memory or file