Download a File Via HTTP Request with a Progress Bar
Keywords: Download File HTTP Progress Bar Wininet
Question:
How can I display a progress bar during HTTP file download?
User code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;HTTPDownload 1.4
;
;Files:
;HTTPDownload1.4.wbt main script
;wininet.wbt wininet and other functions used in main script
;
;Downloads a file showing bytes copied, total size, elapsed time,
;%completed, and progress bar, only for HTTP protocol.
;Uses the Wininet Api functions, without any extender.
;When the download is complete deletes the file from the IE Cache.
;
;Asumes that you are entering a valid link with the filename and extension, the file is saved in the same folder of the script.
;It will work only if it finds the file size in the HTTP headers, suggestion to solve the problem:
;
;Request the STATUS_CODE from the http headers to get the server response:
;
;response = HttpQueryInfo(openreqhandle, 19)
;
;if it is 200 continue processing, otherwise cancel.
;Set the 'size' variable to 0
;
;Allocate the buffers 'buf' and 'buf2' with enough space to recieve the file.
;
;-Guido 10/01
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;START OF DEFINE UDF FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
;lAccessType : DIRECT = 1 , PROXY = 3
;sProxyName : proxy name, or null for preconfigured registry entries.
;sProxyBypass : List of domains not accessed using proxy , null to read from the registry.
;Returns : tophandle for InternetConnect.
#DefineFunction InternetOpen(lAccessType,sProxyName,sProxyBypass)
sDLLName = StrCat(DirWindows(1), "wininet.dll")
sEntry = StrCat("long:", '"InternetOpenA"')
str = "Microsoft Internet Explorer"
lFlags= 0
sArgs ="lpstr:Str"
sArgs = StrCat(sArgs, ", long:lAccessType")
sArgs = StrCat(sArgs, ", lpstr:sProxyName")
sArgs = StrCat(sArgs, ", lpstr:sProxyBypass")
sArgs = StrCat(sArgs, ", long:lFlags")
xx=DLLCall(sDLLName, %sEntry%, %sArgs%)
Return xx
#EndFunction
;InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
;hInternetSession : tophandle returned by InternetOpen.
;sServerName : hostname to connect to.
;nServerPort : TCP/IP port on the server to connect to, defaults: FTP:21 GOPHER:70 HTTP:80 HTTPS:443
;lService : INTERNET_SERVICE_FTP = 1
; INTERNET_SERVICE_GOPHER = 2
; INTERNET_SERVICE_HTTP = 3
;sUserName : if required by host.
;sPassword : if required by host.
;Returns : connecthandle for HttpOpenRequest.
#DefineFunction InternetConnect(hInternet, lpszServerName, nServerPorts, lpszUsername, lpszPassword,lService )
sDLLName = StrCat(DirWindows(1), "wininet.dll")
sEntry = StrCat("long:", '"InternetConnectA"')
lContext = 0
lFlags = 0
sArgs ="long:hInternet"
sArgs = StrCat(sArgs, ", lpstr:lpszServerName")
sArgs = StrCat(sArgs, ", long:nServerPorts")
sArgs = StrCat(sArgs, ", lpstr:lpszUsername")
sArgs = StrCat(sArgs, ", lpstr:lpszPassword")
sArgs = StrCat(sArgs, ", long:lService")
sArgs = StrCat(sArgs, ", long:lFlags")
sArgs = StrCat(sArgs, ", long:lContext")
xx=DLLCall(sDLLName, %sEntry%, %sArgs%)
Return xx
#EndFunction
;HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (Byval hHttpSession As Long, Byval sVerb As String, Byval sObjectName As String, Byval sVersion As String, Byval sReferer As String, Byval something As Long, Byval lFlags As Long, Byval lContext As Long) As Long
;hHttpSession : connecthandle returned by InternetConnect.
;sVerb : GET or POST
;sObjectName : file or cgi script name, rest of url.
;sVersion : HTTP/1.1
;sReferer : referring url (optional).
;something : 0
;lFlags : INTERNET_FLAG_RELOAD = 2147483648 ;INTERNET_FLAG_KEEP_CONNECTION :4194304 INTERNET_FLAG_MULTIPART : 2097152
;lContext : 0
;Returns : openreqhandle for HttpSendRequest,HttpQueryInfo or InternetReadFile.
#DefineFunction HttpOpenRequest(hHttpSession, sVerb, sObjectName, sReferer)
sDLLName = StrCat(DirWindows(1), "wininet.dll")
sEntry = StrCat("long:", '"HttpOpenRequestA"')
sVersion = "HTTP/1.1"
something = 0
lFlags = 2147483648 ;INTERNET_FLAG_RELOAD dont uses cache 2097152: uses cache when d/l again
lContext = 0
sArgs ="long:hHttpSession"
sArgs = StrCat(sArgs, ", lpstr:sVerb")
sArgs = StrCat(sArgs, ", lpstr:sObjectName")
sArgs = StrCat(sArgs, ", lpstr:sVersion")
sArgs = StrCat(sArgs, ", lpstr:sReferer")
sArgs = StrCat(sArgs, ", long:something")
sArgs = StrCat(sArgs, ", long:lFlags")
sArgs = StrCat(sArgs, ", long:lContext")
xx=DLLCall(sDLLName, %sEntry%, %sArgs%)
Return xx
#EndFunction
;InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
;hFile : openreqhandle returned by HttpOpenRequest.
;sBuffer : buffer that receives the data read.
;NumBytesToRead : Number of bytes to read.
;lNumberOfBytesRead : Address of a variable that receives the number of bytes read.
;Returns : number of bytes read.
#DefineFunction InternetReadFile(hFile, sbuffer, lNumBytesToRead)
sDLLName = StrCat(DirWindows(1), "wininet.dll")
sEntry = StrCat("long:", '"InternetReadFile"')
buf = binaryalloc(1024) ;buffer that recieves number of bytes read.
bufaddr = IntControl(42, buf, 0, 0, 0)
sArgs ="long:hFile"
sArgs = StrCat(sArgs, ", lpbinary:sbuffer")
sArgs = StrCat(sArgs, ", long:lNumBytesToRead")
sArgs = StrCat(sArgs, ", long:bufaddr")
xx = DLLCall(sDLLName, %sEntry%, %sArgs%)
ebuf=binaryeodget(sbuffer)
BinaryEodSet(sbuffer, ebuf)
read = BinaryPeek4(buf,0)
BinaryFree(buf)
Return read ;bytes read.
#EndFunction
;HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (Byval hHttpRequest As Long, Byval sHeaders As String, Byval lHeadersLength As Long, sOptional As Any, Byval lOptionalLength As Long) As Integer
;hHttpRequest : openreqhandle returned by HttpOpenRequest.
;sHeaders : additional headers ""
;lHeadersLength : additional headers length 0
;sOptional : 0
;lOptionalLength : 0
;Returns : 1 succesfull , 0 error.
#DefineFunction HttpSendRequest(hHttpRequest, sHeaders, lHeadersLength, sOptional, lOptionalLength)
sDLLName = StrCat(DirWindows(1), "wininet.dll")
sEntry = StrCat("long:", '"HttpSendRequestA"')
sArgs ="long:hHttpRequest"
sArgs = StrCat(sArgs, ", lpstr:sHeaders")
sArgs = StrCat(sArgs, ", long:lHeadersLength")
sArgs = StrCat(sArgs, ", lpstr:sOptional")
sArgs = StrCat(sArgs, ", long:lOptionalLength")
xx=DLLCall(sDLLName, %sEntry%, %sArgs%)
Return xx
#EndFunction
;HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (Byval hHttpRequest As Long, Byval lInfoLevel As Long, Byval sBuffer As String, lBufferLength As Long, lIndex As Long) As Integer
;hHttpRequest : openreqhandle returned by HttpOpenRequest.
;lInfoLevel : HTTP_QUERY_RAW_HEADERS_CRLF = 22 , HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000
;sBuffer : buffer that recieves the data.
;lBufferLength : address of buffer that stores sBuffer lenght.
;lIndex : 0
;Returns: : info requested in lInfoLevel.
#DefineFunction HttpQueryInfo(hHttpRequest, lInfoLevel)
sDLLName = StrCat(DirWindows(1), "wininet.dll")
sEntry = StrCat("long:", '"HttpQueryInfoA"')
sBuffer = binaryalloc(2048) ;buffer that recieves the data.
buf = binaryalloc(2048) ;buffer that stores sBuffer lenght.
binarypoke2(buf, 0, 2048)
lBufferLength = IntControl (42, buf, 0, 0, 0)
lIndex = 0
sArgs ="long:hHttpRequest"
sArgs = StrCat(sArgs, ", long:lInfoLevel")
sArgs = StrCat(sArgs, ", lpbinary:sBuffer")
sArgs = StrCat(sArgs, ", long:lBufferLength")
sArgs = StrCat(sArgs, ", long:lIndex")
xx = DLLCall(sDLLName, %sEntry%, %sArgs%)
BinaryEodSet(sBuffer, 2048)
a = BinaryPeekstr(sBuffer, 0, 2048)
BinaryFree(sBuffer)
BinaryFree(buf)
Return a
#EndFunction
;InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
#DefineFunction InternetCloseHandle(hInet)
sDLLName = StrCat(DirWindows(1), "wininet.dll")
sEntry = StrCat("long:", '"InternetCloseHandle"')
sArgs ="long:hInet"
xx=DLLCall(sDLLName, %sEntry%, %sArgs%)
Return xx
#EndFunction
;CrackURL extracts requested info from a VALID url
;req = 0 service
;req = 1 host
;req = 2 mainurl
;req = 3 last part, filename
#DefineFunction CrackURL(link, req)
rest=""
;remove blanks
link = StrTrim(link)
;service
service = ItemExtract(1, link, ":")
;remove service
link = StrFixCharsl(link, "", StrLen(link)-(strlen(service)+3))
;remove endbackslash if exists
If StrSub(link, StrLen(link), 1)=="/" then link=StrFixChars(link, "", StrLen(link)-1)
host = ItemExtract(1, link, "/")
count = ItemCount(link, "/")
filename = ItemExtract(count, link, "/")
For x = 2 to count
item = ItemExtract(x, link, "/")
rest = StrCat(rest, "/", item)
Next
Switch req
Case 0
Return service
Case 1
Return host
Case 2
Return rest
Case 3
Return filename
EndSwitch
#EndFunction
;Delete files in recursive mode
;dir : directory to search
;mask : search criteria with wildcards
;buf : buffer that stores the number of deleted files
#DefineFunction FileDeleteRec(dir, mask, buf)
DirChange(dir)
topdir = DirGet()
filelist = FileItemize(mask)
filecount = itemcount(filelist, @tab)
For yy = 1 to filecount
thisfile = ItemExtract(yy, filelist, @tab)
;Files
file = strcat(topdir, thisfile)
FileAttrSet(file, "rash")
ErrorMode(@off) ;ignores error if the file can't be deleted
del = FileDelete(file)
ErrorMode(@on)
If del==@true Then BinaryIncr2(buf, 0) ;counter of deleted files
Next
;Get list of subdirectories
dirlist = DirItemize("*.*")
dircount = ItemCount(dirlist, @tab)
For xx = 1 to dircount
thisdir = ItemExtract(xx, dirlist, @tab)
FileDeleteRec(thisdir, mask, buf)
Next
DirChange("..")
Return BinaryPeek2(buf, 0)
#EndFunction
;Converts bytes to Kb or Mb
#DefineFunction convert(size)
size = StrCat(size,".00")
if size<1024 then return size
If size>=1024
size = size/1024
sizex = StrCat(size, "Kb")
Endif
If size>=1024
size = size/1024
sizex = StrCat(size, "Mb")
Endif
Return sizex
#EndFunction
;Creates a progress bar
#DefineFunction createprogress(smooth, vertical, startx, starty, width, height)
dll = StrCat(DirWindows(1),"user32.dll")
hwnd = Dllhwnd("")
hinst = Dllhinst("")
hprog = Dllcall(dll,long:"CreateWindowExA",long:0,lpstr:"msctls_progress32",lpstr:"",long:vertical|smooth|268435456|1073741824,long:startx,long:starty,long:width,long:height,long:hwnd,long:0,long:hinst,long:0)
Return hprog
#EndFunction
;Decodes a URL, it does not check if the url is bad encoded.
#DefineFunction decodeurl(link)
buf = BinaryAlloc(400)
BinaryPokeStr(buf, 0, link)
str = "0123456789abcdef"
start=1
pos=""
while 1
pos = StrScan (link, '%%', start, @fwdscan)
If pos==0 Then Break
start = pos+1
hex = StrSub(link, start, 2)
;Hex to dec
hexlen = StrLen(hex)
dec = 0
For x=1 To hexlen
dec = (dec*16) + StrIndex(str,StrSub(hex,x,1),0,@fwdscan) -1
Next
BinaryReplace(buf, StrCat('%%',hex), Num2char(dec), @false)
endwhile
link = BinaryPeekStr(buf, 0, Binaryeodget(buf))
BinaryFree(buf)
Return link
#EndFunction
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;END DEFINE OF UDF FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Decimals(2) ;for size conversion
IntControl(5, 1, 0, 0, 0) ;show hidden files for FileDeleteRec
IntControl (12, 5, "", 0, 0) ;quiet termination
PBM_SETPOS = 1026 ;message for progress bar
origdir = DirGet()
;Ask for link
:begin
BoxTitle(" HTTPDownload 1.4")
link = AskLine(" HTTPDownload 1.4", "Enter URL:", "")
;Extrac info from link
host = CrackURL(link, 1)
mainurl = CrackURL(link, 2)
filename = CrackURL(link, 3)
filenamedec = DecodeURL(CrackURL(link, 3)) ;filename decoded
;Define output file
outfile = StrCat(origdir, filenamedec)
;Create progress window
BoxOpen("Sending request...","")
hprog = createprogress(0, 0, 20, 30, 350, 15)
BoxText(StrCat("",@crlf,@crlf,@crlf,"Copied:",@crlf,"Elapsed time:"))
;Initialize wininet functions
tophandle = InternetOpen(1, "", "")
connecthandle = InternetConnect(tophandle, host, 80, "", "", 3)
openreqhandle = HttpOpenRequest(connecthandle, "GET", mainurl, "")
sendreq = HttpSendRequest(openreqhandle, "", 0, "", 0)
size = HttpQueryInfo(openreqhandle, 5) ;request size
;If size not found show headers
If size==""
headers = HttpQueryInfo(openreqhandle, 22) ;request headers
Message("Size not found, headers were:", headers)
BoxShut()
Goto begin
Endif
;Define vars
totalread = 0 ; total bytes reaad
buf = BinaryAlloc(size+100) ; recieves one data packet each time (set to 10000 bytes)
buf2 = BinaryAlloc(size+100); stores all packets
read ="" ; bytes read for packet
a = TimeYmdHms( ) ; current time
packet = 10000 ; data packet
;The packet must be smaller than the size
If size0
read = InternetReadFile(openreqhandle, buf, packet) ; copy 10000 bytes to buf
totalread = totalread + read ; total bytes read
completed = (totalread*100)/size ; %%completed
elapsed = StrfixCharsl(TimeDiff(TimeYmdHms( ), a), "", 8); elapsed time
;Set progress bar position
IntControl(22, hprog, PBM_SETPOS, completed, 0)
;Show progress
BoxTitle("%completed%%% Completed")
BoxText(StrCat(filenamedec,@crlf,@crlf,@crlf,"Copied: ",convert(totalread)," of ", convert(size), @crlf,"Elapsed time: ",elapsed))
endb = BinaryEODGet(buf2)
BinaryCopy(buf2, endb, buf, 0, read) ;stores data packets in buf2
EndWhile
BinaryWrite(buf2,outfile)
BinaryFree(buf)
BinaryFree(buf2)
;Close handles
InternetCloseHandle(openreqhandle)
InternetCloseHandle(connecthandle)
InternetCloseHandle(tophandle)
;Delete downloaded file from IE cache
BoxTitle("Cleaning cache...")
IEtemp = StrCat(DirWindows(0), "Temporary Internet Files")
If DirExist(IEtemp) == @false
Message("HTTP Download","Temporary Internet Files dir not found."
BoxShut()
;Set progress bar to 0
IntControl(22, hprog, PBM_SETPOS, 0, 0)
Goto begin
Endif
file = FileRoot (filename) ;filename without extension
mask = StrCat("*", file, "*", ".", FileExtension(filename))
counter = BinaryAlloc(100)
nfiles = FileDeleteRec(IEtemp, mask, counter)
BinaryFree(counter)
BoxTitle("Transfer complete.")
BoxText(StrCat(nfiles," file(s) deleted from cache.",@crlf,@crlf,@crlf,"Copied: ",convert(totalread)," of ",convert(size),@crlf,"Elapsed time: %elapsed%",@crlf,"Hit [SPACE] for more or [ESC] to exit."))
Exclusive(@off)
;Wait for key
k = WaitForKey("{ESC}", "{SP}", "", "", "")
Switch k
Case 1
Exit
Case 2
BoxShut()
;Set progress bar to 0
IntControl(22, hprog, PBM_SETPOS, 0, 0)
Goto begin
EndSwitch
;END
Article ID: W15283