Progressbar for URLDownloadToFile

[xra7en]

As per this page
https://www.qb64.org/forum/index.php?topic=3910.0

I been busy, but been tinkering with this, got it to work. But been doing research on the last var lpfnCB
I cant seem to find documentation on how to make this display a progress bar - instead of just a blankscreen.
At least nothing for the BASIC language.

Anyone help on this?

code in question:

Code: QB64: [Select]

1.  Function URLDownloadToFileA%& (ByVal pCaller As Long, szURL As String, szFileName As String, Byval dwReserved As Long, Byval lpfnCB As Long)

[SpriggsySpriggs]

For this particular function, you'd need to use "interfaces" and a callback function. That still wouldn't display a progress bar. You'd have to code that yourself or use a library like InForm or my Task Dialog library. I have yet to successfully use interfaces but I have made code for downloading files that does return progress if you'd like that.

[xra7en]

sure I can take a look.
what I am looking for is something to show that there is activity vs screen locked (which its not) :-)

[xra7en]

o and fyi, I like pain LOL - I mean progress bar in dos and I am still working on a command line downloader
 :-)

is there a way to make something run in the background
example I can just whip up an animated scroll bar to show motion, but it would need to run in the backghroug

psuedo:

run fancy scrollbar
run download action

then scrollbar stops when download is finished.

something asynchronous

[SpriggsySpriggs]

Yes, but not with that function. I'm on vacation right now but if I'm able to get that code to you I will

[xra7en]

o no rush.. is there something in qb64 that allows two functions to run at the same time?

[FellippeHeitor]

ON TIMER can be used to trigger multiple procedures simultaneously. In the following example, if instead of GOSUB Timer.Trap you had a SUB Timer.Trap, it'd run even if mySub was already being run too:

Code: QB64: [Select]

1. t1 = _FREETIMER
2. t2 = _FREETIMER
3. ON TIMER(t1, 1) GOSUB Timer.Trap 'the code following the Timer.Trap label will be run every 1 second
4.  
5. ON TIMER(t2, .5) mySub 'QB64 can also trigger a SUB procedure with TIMER;
6. '                       in this case mySUB will be triggered every 500 milliseconds
7.  
8. 'activate timers:
9. TIMER(t1) ON
10. TIMER(t2) ON
11.  
12. DO 'go into an infinite loop until the window is closed
13.     _LIMIT 1 'run the main loop at 1 cycle per second, to show how timers are independent from main program flow
14. LOOP
15.  
16. Timer.Trap:
17. PRINT "1s; ";
18. RETURN
19.  
20. SUB mySub
21.     PRINT "500ms; ";
22. END SUB

[SpriggsySpriggs]

Right. I don't think it would allow us to capture how much has been downloaded yet with that function, though

[Richard Frost]

Using ON TIMER gives the appearance of running two things at the same time,
but actually the timed event pauses main execution, as the following code shows.
If it was simultaneous execution like running on another core, the delay in the sub
would not effect the count.

Code: QB64: [Select]

1. Common Shared showcount, xdelay!
2. t1 = _FreeTimer
3. On Timer(t1, 1) mySub
4. Timer(t1) On
5.  
6. Do: _Limit 100
7.     count = count + 1
8.     If showcount Then
9.         Print Using "#.##"; xdelay!;
10.         Print count
11.         count = 0
12.         showcount = 0
13.     End If
14. Loop
15.  
16. Sub mySub
17.     xdelay! = Rnd + .1
18.     _Delay xdelay
19.     showcount = 1
20. End Sub
21.  

[xra7en]

OK, took a shot at Richard's method.. It would not go past the download.

 

Code: QB64: [Select]

1.        Dim t1
2.         t1 = _FreeTimer
3.         On Timer(t1, 1) progressBar
4.         Timer(t1) On
5.  
6.         appTxt = FileDownload(thisAppLink, "dl/" + filename)
7.         If appTxt <> 0 Then
8.             Print
9.             Color 4
10.             Print "Problem retreiving " + filename + " from " + thisAppLink
11.             System
12.         End If
13.  

or did I put that incorrect?

thanks guys for checking this out

[xra7en]

Might check out spriggs libs.
I would be satisfied with a windows progress bar dialog.
I found this: https://www.vbforums.com/showthread.php?800993-RESOLVED-Need-Code-For-Downloading-with-Progress-Bar-!
looks promising, but more up spriggs line of programing :-)

[SpriggsySpriggs]

I'm not able to access my home PC right now. Looks like it is offline. As soon as I can get into it then I will give it to ya.

[xra7en]

I'm not able to access my home PC right now. Looks like it is offline. As soon as I can get into it then I will give it to ya.

hey yer on VAY-K, no peekin' on qb :P

[xra7en]

Here is the whole "scratch book" drawing I am workiing on.
I tried all this with wget, curl and powershell and currently working with a download script from spriggy. Since powershell works well, I found there was a problem with windows 7 fresh install, because you need I believe PS5+. The command that allows you to download doesn't work on earlier versions, and I wanted this to work on fresh installs. I could have used the curl/wget but each had their own problems (mostly security and SSL issues) and besides, I wanted a self contained version, thus spriggy idea. But that was problematic. Example I did another win7 fresh install, and the download no longer works. Not sure whats missing and why it worked on the other win7 but not my fresh one.

Still looking for a progress bar -

I did see another site appget.net that has  a progress bar and looks identical to what I was trying to do. Just saw it 2 days ago and tried it out. Perfect.  LOL. puts mine to shame /sigh
here is their source code: https://github.com/appget/appget/tree/master/src
havent looked at it,as I do not use or even looked at c-sharp.

So now just using it as a learning too. I still want to see if i can get this to do downloads without having to resort to 3rd party and use all QB64 natively

Take a look and see what you think
you can use the database here https://appgetmgr.com/db/app.txt
save it as app.db

Code: QB64: [Select]

1. Option _Explicit
2. $ScreenHide
3. $Console
4. _Dest _Console
5.  
6. Declare Dynamic Library "urlmon"
7.     Function URLDownloadToFileA%& (ByVal pCaller As Long, szURL As String, szFileName As String, Byval dwReserved As Long, Byval lpfnCB As Long)
8. End Declare
9.  
10. Const REL = "210709.0519"
11. Const DATABASE = "app.db"
12. Const DOWNLOAD_FOLDER = "dl\"
13. Const REMOTE_DB = ""
14. Const APP_NAME = "AppGet Manager"
15. Const APP_URL = ""
16. Const TRUE = 1
17. Const FALSE = 0
18.  
19. Dim Shared thisAppLink As String
20. Dim Shared FF As Integer 'free file
21. Dim Shared matches(100) As String ' should not be more than 100 matches.
22. Dim Shared filename As String
23. Dim appTxt As _Offset
24.  
25.  
26. 'create a download dir if not exists
27. If Not _DirExists(DOWNLOAD_FOLDER) Then MkDir (DOWNLOAD_FOLDER)
28.  
29.  
30.  
31. ' act on param sent
32. Select Case UCase$(Command$(1))
33.     Case "D", "-D":
34.  
35.         thisAppLink = findApp(Command$(2))
36.  
37.  
38.         Cls
39.         appGetHeader
40.  
41.         '*** D O W N L O A D I N G  F I L E
42.         '*** Strip the filename off the end
43.         '*** "file" is appended at the back of mediafire files.
44.         If Right$(thisAppLink, 4) = "file" Then
45.             Print thisAppLink
46.             thisAppLink = Mid$(thisAppLink, 1, Len(thisAppLink) - 5)
47.             filename = _Trim$(Mid$(thisAppLink, _InStrRev(thisAppLink, "/") + 1))
48.  
49.         Else
50.             filename = _Trim$(Mid$(thisAppLink, _InStrRev(thisAppLink, "/") + 1))
51.         End If
52.  
53.         LWRITELN "`2Downloading  ... [ `0" + filename + " ]"
54.         LWRITELN "`#URL: `%" + thisAppLink
55.  
56.  
57.         '*** download it...
58.         'Shell "cd " + DOWNLOAD_FOLDER + " && curl -LO -k " + thisAppLink + " && cd .."
59.         'Shell "cd " + DOWNLOAD_FOLDER + " && Powershell -Command Invoke-WebRequest -Uri " + thisAppLink + " -Outfile " + filename + " && cd .."
60.  
61.         Print
62.         LWRITELN "`6Downloading now, one moment . . ."
63.  
64.  
65.         appTxt = FileDownload(thisAppLink, "dl/" + filename)
66.         If appTxt <> 0 Then
67.             Print
68.             Color 4
69.             Print "Problem retreiving " + filename + " from " + thisAppLink
70.             System
71.         End If
72.  
73.         LWRITELN "`0Success! `6Your file has been saved to `%.\DL\ "
74.         LWRITELN "`7If you do not see " + filename + "installing, check the taskbar below"
75.  
76.  
77.         'check to see if it is an archive 7z,zip,rar,arj.exe
78.         Select Case LCase$(Right$(filename, 3))
79.             Case ".7z", "arj", "rar", "zip": Shell _Hide _DontWait "cmd /c 7zFM .\" + DOWNLOAD_FOLDER + filename
80.             Case "exe", "msi": Shell _Hide _DontWait "cmd /c .\" + DOWNLOAD_FOLDER + filename
81.         End Select
82.  
83.         '*** originall was going to clean up, but save downloaded files
84.         'Kill DOWNLOAD_FOLDER +  filename
85.  
86.         System
87.  
88.  
89.     Case "-V", "V": Print: Print "Current Release: "; REL: Print
90.     Case Else:
91.         appGetHeader
92.         LWRITELN "`!Usage: appget command [`%appname...]"
93.         LWRITELN "`3Available commands:"
94.         LWRITELN "     `%d - `7download appname (or partial search)"
95.         Print
96.         LWRITELN "`7Example:"
97.         LWRITELN "`2appget `$d `0notepad`7"
98.         Print
99.         System
100.  
101. End Select
102. System
103.  
104.  
105.  
106. ' $include: 'utils.bi'
107.  
108.  
109. Sub progressBar
110.     Print ".";
111. End Sub
112.  
113. Function FileDownload%& (URL As String, File As String)
114.     FileDownload = URLDownloadToFileA(0, URL + Chr$(0), File + Chr$(0), 0, 0)
115. End Function
116.  
117.  
118.  
119. Sub downloadDB
120.     '*** see page for variable types
121.     '*** in order to work must be defined as offset
122.     '*** https://www.qb64.org/wiki/Variable_Types
123.     Dim appTxt As _Offset
124.     Dim x As Integer
125.  
126.  
127.     'If _FileExists("app.db") Then Kill "app.db"
128.     Print
129.     LWRITE "`8Reading remote database...."
130.  
131.     '*** download it...
132.     'check to see if there is an existing one
133.     If _FileExists("app.db") Then Exit Sub
134.  
135.  
136.     appTxt = FileDownload(REMOTE_DB, "app.db") ' download the db and save it to "APP.DB"
137.     If appTxt <> 0 Then
138.         Print
139.         Print "AppTxt Val = "; appTxt
140.         Print
141.         LWRITELN "`4*** `2ISSUE RET RIEVING DATABASE `4***`7"
142.         LWRITELN "`8Location: " + REMOTE_DB + "`7"
143.         System
144.     End If
145.  
146.     'Shell _Hide "rename app.txt app.db"
147.  
148.     LWRITELN "`%Done!"
149.  
150.     Print
151. End Sub
152.  
153.  
154.  
155. Sub openDB
156.     downloadDB
157.     FF = FreeFile
158.  
159.     Open DATABASE For Input As #FF
160. End Sub
161.  
162.  
163. Function findApp$ (appname As String)
164.  
165.     Dim appSelectStr As String
166.  
167.     Dim aline As String
168.     Dim recNum As Integer ' record count
169.     'If Not _FileExists(DATABASE) Then findApp = "": Exit Function
170.  
171.     recNum = 1
172.     Dim recCount As Integer: recCount = 0
173.     appGetHeader
174.  
175.     openDB
176.     Print "Results"
177.     While Not EOF(FF)
178.         recCount = recCount + 1
179.         Line Input #FF, aline
180.         'Remove the trailing "," if there is one.
181.         'Sometimes I use a spread sheet to organize and when exporting it
182.         'adds aother ","
183.         If Right$(aline, 1) = "," Then aline = Left$(aline, Len(aline) - 1)
184.  
185.         ReDim d(5) As String
186.         EXPLODE aline, ",", d()
187.  
188.         If InStr(LCase$(d(1)), LCase$(appname)) And aline > "" Then
189.  
190.             LWRITE "`8[`%"
191.             Print recNum;
192.             LWRITE "`8] `3"
193.             Print d(1);
194.             LWRITE " `8ver. `7"
195.             Print d(3)
196.             matches(recNum) = d(2)
197.             recNum = recNum + 1
198.         End If
199.     Wend
200.     Close
201.     Kill "app.db" ' Make sure each db is downloaded fresh
202.  
203.     If recNum - 1 = 0 Then
204.         Print "Scanned "; recCount; " files..."
205.         Print appname; " not found. Put in a request"
206.         System
207.     Else
208.  
209.         LWRITELN "`8[ `@0 `8] `4Cancel": Print
210.         Color 10
211.         Line Input "Select id of app to install: "; appSelectStr: recNum = Val(appSelectStr)
212.         If recNum = 0 Then System
213.         findApp$ = matches(recNum)
214.     End If
215.  
216. End Function
217.  
218.  
219.  
220.  
221.  
222. Sub appGetHeader
223.     Cls
224.     LWRITELN "`3- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - "
225.     LWRITELN "`!" + APP_NAME + " x64 (Windows)`3 rel: `#" + REL
226.     LWRITELN "`3- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - "
227.  
228. End Sub
229.  

Required for pretty colored text :-)

Code: QB64: [Select]

1. Sub LWRITE (TXT As String)
2.     Dim i As Integer
3.     '======================================================
4.     '--- THIS IS A POPULAR COLOR ROUTINE BASED ON THE
5.     '--- SETH ABLE L.O.R.D. BBS GAME COLOR FORMATTING
6.     '=====================================================
7.     Color 7 ' DEFAULT COLOR
8.     For i = 1 To Len(TXT$)
9.         ' CHECK FOR A COLOR CHANGE
10.         If Mid$(TXT$, i, 1) = "`" Then
11.             i = i + 1
12.             Select Case Mid$(TXT, i, 1)
13.                 Case "0": Color 10
14.                 Case "1": Color 1
15.                 Case "2": Color 2
16.                 Case "3": Color 3
17.                 Case "4": Color 4
18.                 Case "5": Color 5
19.                 Case "6": Color 6
20.                 Case "7": Color 7
21.                 Case "8": Color 8
22.                 Case "9": Color 9
23.                 Case "!": Color 11
24.                 Case "@": Color 12
25.                 Case "#": Color 13
26.                 Case "$": Color 14
27.                 Case "%": Color 15
28.                 Case "n": Print '           new line
29.                 Case "t": Print , ; '       TAB
30.             End Select
31.             i = i + 1
32.  
33.         End If
34.         Print Mid$(TXT$, i, 1);
35.     Next
36.     Print ;
37. End Sub
38.  
39. Sub LWRITELN (TXT As String)
40.     LWRITE (TXT$)
41.     Print
42. End Sub
43.  
44.  

[SpriggsySpriggs]

@xra7en

Code: QB64: [Select]

1. Option _Explicit
2.  
3. Const INTERNET_OPEN_TYPE_DIRECT = 1
4.  
5. Const INTERNET_DEFAULT_HTTP_PORT = 80
6. Const INTERNET_DEFAULT_HTTPS_PORT = 443
7.  
8. Const INTERNET_SERVICE_HTTP = 3
9.  
10. 'Flags
11. Const INTERNET_FLAG_SECURE = &H00800000
12. Const INTERNET_FLAG_RELOAD = &H80000000
13.  
14. Const HTTP_QUERY_CONTENT_LENGTH = 5
15.  
16. Const TRUE = 1
17. 'CONST FALSE = 0
18.  
19. Declare Dynamic Library "Wininet"
20.     Function InternetOpen%& Alias "InternetOpenA" (ByVal lpszAgent As _Offset, Byval dwAccessType As Long, Byval lpszProxy As _Offset, Byval lpszProxyBypass As _Offset, Byval dwFlags As Long)
21.     Function InternetConnect%& Alias "InternetConnectA" (ByVal hInternet As _Offset, Byval lpszServerName As _Offset, Byval nServerPort As Integer, Byval lpszUserName As _Offset, Byval lpszPassword As _Offset, Byval dwService As Long, Byval dwFlags As Long, Byval dwContext As _Offset)
22.     Function HTTPOpenRequest%& Alias "HttpOpenRequestA" (ByVal hConnect As _Offset, Byval lpszVerb As _Offset, Byval lpszObjectName As _Offset, Byval lpszVersion As _Offset, Byval lpszReferrer As _Offset, Byval lpszAcceptTypes As _Offset, Byval dwFlags As Long, Byval dwContext As _Offset)
23.     Function HTTPSendRequest%% Alias "HttpSendRequestA" (ByVal hRequest As _Offset, Byval lpszHeaders As _Offset, Byval dwHeadersLength As Long, Byval lpOptional As _Offset, Byval dwOptionalLength As Long)
24.     Sub InternetCloseHandle (ByVal hInternet As _Offset)
25.     Function InternetReadFile%% (ByVal hFile As _Offset, Byval lpBuffer As _Offset, Byval dwNumberOfBytesToRead As Long, Byval lpdwNumberOfBytesRead As _Offset)
26.     Function HTTPQueryInfo%% Alias "HttpQueryInfoA" (ByVal hRequest As _Offset, Byval dwInfoLevel As Long, Byval lpBuffer As _Offset, Byval lpdwBufferLength As _Offset, Byval lpdwIndex As _Offset)
27. End Declare
28.  
29. Declare Dynamic Library "Kernel32"
30.     Function GetLastError& ()
31.     Sub SetLastError (ByVal dwErrCode As Long)
32.     Function FormatMessage& Alias "FormatMessageA" (ByVal dwFlags As Long, Byval lpSource As Long, Byval dwMessageId As Long, Byval dwLanguageId As Long, Byval lpBuffer As _Offset, Byval nSize As Long, Byval Arguments As _Offset)
33. End Declare
34.  
35. Declare CustomType Library ".\offsettostring"
36.     Function offset_to_string$ Alias "offset_to_offset" (ByVal offset As _Offset)
37. End Declare
38.  
39. Declare Library
40.     Function MAKELANGID& (ByVal p As Long, Byval s As Long)
41. End Declare
42.  
43.  
44. Screen _NewImage(480, 80, 32)
45. $ScreenHide
46. _ScreenHide
47. $Console
48. _Dest _Console
49.  
50. _Title "URL Downloader"
51. _ConsoleTitle "Enter Link"
52. Dim link As String
53. Dim filename As String
54.  
55. Do
56.     Cls
57.     Line Input "Link: ", link
58.     Line Input "File Name : ", filename
59. Loop Until link <> "" And filename <> ""
60. _ScreenShow
61. _Title _Title$ + " - " + Mid$(filename, _InStrRev(filename, "\") + 1)
62.  
63. _Console Off
64. _Dest 0
65.  
66. DownloadLink link, filename
67.  
68. Sub DownloadLink (URL As String, File As String)
69.     Dim As String URLFile
70.     URLFile = URL
71.     Dim As _Offset hsession
72.     hsession = InternetOpen(0, INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0)
73.     If hsession = 0 Then
74.         Cls
75.         Print "Error : InternetOpen", ErrorMessage(GetLastError)
76.         InternetCloseHandle hsession
77.         Exit Sub
78.     End If
79.  
80.     Dim As _Offset httpsession
81.     URL = Mid$(URL, InStr(URL, "/") + 2)
82.     URL = Mid$(URL, 1, InStr(URL, "/") - 1)
83.  
84.     httpsession = InternetConnect(hsession, _Offset(URL), INTERNET_DEFAULT_HTTPS_PORT, 0, 0, INTERNET_SERVICE_HTTP, 0, 0)
85.     If httpsession = 0 Then
86.         Cls
87.         Print "Error : Internet Connect", ErrorMessage(GetLastError)
88.         InternetCloseHandle hsession
89.         Exit Sub
90.     End If
91.  
92.     Dim As _Offset httpRequest
93.     Dim As String sessiontype, location, accepttypes
94.     sessiontype = "GET" + Chr$(0)
95.     location = Mid$(URLFile, InStr(URLFile, URL) + Len(URL)) + Chr$(0)
96.     accepttypes = "*/*" + Chr$(0)
97.     httpRequest = HTTPOpenRequest(httpsession, _Offset(sessiontype), _Offset(location), 0, 0, _Offset(accepttypes), INTERNET_FLAG_RELOAD Or INTERNET_FLAG_SECURE, 0)
98.     If httpRequest = 0 Then
99.         Cls
100.         Print "Error : HTTPOpenRequest", ErrorMessage(GetLastError)
101.         InternetCloseHandle hsession
102.         Exit Sub
103.     End If
104.  
105.     Dim As Long sendrequest
106.     Dim As String headers
107.     headers = ""
108.     sendrequest = HTTPSendRequest(httpRequest, 0, 0, 0, 0)
109.     If sendrequest <> TRUE Then
110.         Cls
111.         Print "Error : HTTPSendRequest", ErrorMessage(GetLastError)
112.         InternetCloseHandle hsession
113.         Exit Sub
114.     End If
115.  
116.  
117.     Dim As _Byte query
118.     Dim As String queryinfo
119.     queryinfo = Space$(1024)
120.     Dim As Long querylen
121.     querylen = Len(queryinfo) - 1
122.  
123.     query = HTTPQueryInfo(httpRequest, HTTP_QUERY_CONTENT_LENGTH, _Offset(queryinfo), _Offset(querylen), 0)
124.     If query <> TRUE Then
125.         Cls
126.         Print "Error : HTTPQueryInfo", ErrorMessage(GetLastError)
127.         InternetCloseHandle hsession
128.     End If
129.  
130.     Dim As _Unsigned _Integer64 bytesToRead
131.     bytesToRead = Val(queryinfo)
132.  
133.     Dim As String szBuffer
134.     szBuffer = Space$(4097)
135.     Dim As _Unsigned _Integer64 dwRead, bytesRead
136.     If _FileExists(File) Then
137.         Kill File
138.     End If
139.     Open File For Binary As #1
140.     Dim As _Byte a
141.     Dim As String filedownload
142.     Dim As Long errr, bytesForRate
143.     Dim x!
144.     Dim y!
145.     Dim Rate!
146.     Dim As Single ratetime
147.     Do
148.         x! = Timer
149.         a = InternetReadFile(httpRequest, _Offset(szBuffer), Len(szBuffer) - 1, _Offset(dwRead))
150.         errr = GetLastError
151.         If dwRead > 0 Then
152.             filedownload = Mid$(szBuffer, 1, dwRead)
153.             Put #1, , filedownload
154.             bytesRead = bytesRead + dwRead
155.             bytesForRate = bytesForRate + dwRead
156.             ratetime = timeElapsedSince(x!)
157.             If _Round(ratetime) >= 1 Then
158.                 Rate! = (bytesForRate / ratetime) / 1024
159.                 bytesForRate = 0
160.             End If
161.             Cls
162.             Print "Downloading to " + File
163.             If bytesToRead <> 0 Then
164.                 Select Case bytesRead
165.                     Case Is < 1024
166.                         Print Using "#### B downloaded of "; bytesRead;
167.                     Case Is < (1024 ^ 2) And bytesRead >= 1024
168.                         Print Using "####.## KB downloaded of "; (bytesRead / 1024);
169.                     Case Is < (1024 ^ 3) And bytesRead >= (1024 ^ 2)
170.                         Print Using "####.## MB downloaded of "; (bytesRead / (1024 ^ 2));
171.                     Case Is < (1024 ^ 4) And bytesRead >= (1024 ^ 3)
172.                         Print Using "####.## GB downloaded of "; (bytesRead / (1024 ^ 3));
173.                 End Select
174.                 Select Case bytesToRead
175.                     Case Is < 1024
176.                         Print Using "#### B"; bytesToRead
177.                     Case Is < (1024 ^ 2) And bytesToRead >= 1024
178.                         Print Using "####.## KB"; (bytesToRead / 1024)
179.                     Case Is < (1024 ^ 3) And bytesToRead >= (1024 ^ 2)
180.                         Print Using "####.## MB"; (bytesToRead / (1024 ^ 2))
181.                     Case Is < (1024 ^ 4) And bytesToRead >= (1024 ^ 3)
182.                         Print Using "####.## GB"; (bytesToRead / (1024 ^ 3))
183.                 End Select
184.                 Print Using "###.##%"; bytesRead / bytesToRead * 100
185.             Else
186.                 Select Case bytesRead
187.                     Case Is < 1024
188.                         Print Using "   ####  B downloaded"; bytesRead
189.                     Case Is < (1024 ^ 2) And bytesRead >= 1024
190.                         Print Using "####.## KB downloaded"; (bytesRead / 1024)
191.                     Case Is < (1024 ^ 3) And bytesRead >= (1024 ^ 2)
192.                         Print Using "####.## MB downloaded"; (bytesRead / (1024 ^ 2))
193.                     Case Is < (1024 ^ 4) And bytesRead >= (1024 ^ 3)
194.                         Print Using "####.## GB downloaded"; (bytesRead / (1024 ^ 3))
195.                 End Select
196.             End If
197.             Select Case Rate!
198.                 Case Is < 1024
199.                     Print Using "Rate: #### Bps"; Rate!
200.                 Case Is < (1024 ^ 2) And Rate! >= 1024
201.                     Print Using "Rate: ####.## KBps"; Rate! / 1024
202.                 Case Is < (1024 ^ 3) And Rate! >= (1024 ^ 2)
203.                     Print Using "Rate: ####.## MBps"; Rate! / (1024 ^ 2)
204.                 Case Is < (1024 ^ 4) And Rate! >= (1024 ^ 3)
205.                     Print Using "Rate: ####.## GBps"; Rate! / (1024 ^ 3)
206.             End Select
207.             'Print "Rate="; _Round(Rate!); "KBps"
208.             _Display
209.         End If
210.     Loop Until bytesRead = bytesToRead Or errr <> 0
211.     If errr Then
212.         Print "Error downloading file:"; errr
213.         Close #1
214.         InternetCloseHandle hsession
215.         Kill File
216.         Exit Sub
217.     Else
218.     End If
219.     Close #1
220.     InternetCloseHandle hsession
221.     Cls
222.     Select Case bytesRead
223.         Case Is < 1024
224.             Print Using "#### B downloaded of "; bytesRead;
225.         Case Is < (1024 ^ 2) And bytesRead >= 1024
226.             Print Using "####.## KB downloaded of "; (bytesRead / 1024);
227.         Case Is < (1024 ^ 3) And bytesRead >= (1024 ^ 2)
228.             Print Using "####.## MB downloaded of "; (bytesRead / (1024 ^ 2));
229.         Case Is < (1024 ^ 4) And bytesRead >= (1024 ^ 3)
230.             Print Using "####.## GB downloaded of "; (bytesRead / (1024 ^ 3));
231.     End Select
232.     Select Case bytesToRead
233.         Case Is < 1024
234.             Print Using "#### B"; bytesToRead
235.         Case Is < (1024 ^ 2) And bytesToRead >= 1024
236.             Print Using "####.## KB"; (bytesToRead / 1024)
237.         Case Is < (1024 ^ 3) And bytesToRead >= (1024 ^ 2)
238.             Print Using "####.## MB"; (bytesToRead / (1024 ^ 2))
239.         Case Is < (1024 ^ 4) And bytesToRead >= (1024 ^ 3)
240.             Print Using "####.## GB"; (bytesToRead / (1024 ^ 3))
241.     End Select
242.     Print Using "###.##%"; bytesRead / bytesToRead * 100
243.     Print "Downloaded to " + File
244. End Sub
245.  
246. Function timeElapsedSince! (startTime!)
247.     If startTime! > Timer Then startTime! = startTime! - 86400
248.     timeElapsedSince! = Timer - startTime!
249. End Function
250.  
251. Function ErrorMessage$ (errCode As Long)
252.     Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H00000100
253.     Const FORMAT_MESSAGE_FROM_SYSTEM = &H00001000
254.     Const FORMAT_MESSAGE_IGNORE_INSERTS = &H00000200
255.  
256.     Const LANG_NEUTRAL = &H00
257.     Const SUBLANG_DEFAULT = &H01
258.  
259.     Dim As _Offset lpMsgBuf
260.     Dim As Long msg
261.  
262. msg = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or _
263.                     FORMAT_MESSAGE_FROM_SYSTEM Or _
264.                     FORMAT_MESSAGE_IGNORE_INSERTS, _
265.                    0, _
266.                     errCode, _
267.                     MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), _
268.                     _Offset(lpMsgBuf), _
269.                    0, 0)
270.  
271.  
272.     ErrorMessage = offset_to_string(lpMsgBuf)
273. End Function
274.