Text Only | Text with Attachments

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: xra7en on July 08, 2021, 12:01:04 am

Title: Progressbar for URLDownloadToFile
Post by: xra7en on July 08, 2021, 12:01:04 am
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)
Title: Re: Progressbar for URLDownloadToFile
Post by: SpriggsySpriggs on July 08, 2021, 12:12:24 am
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 (https://www.qb64.org/forum/index.php?topic=4032.msg133688#msg133688) 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.
Title: Re: Progressbar for URLDownloadToFile
Post by: xra7en on July 08, 2021, 08:41:27 am
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) :-)
Title: Re: Progressbar for URLDownloadToFile
Post by: xra7en on July 08, 2021, 10:02:04 am
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
Title: Re: Progressbar for URLDownloadToFile
Post by: SpriggsySpriggs on July 08, 2021, 10:22:51 am
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
Title: Re: Progressbar for URLDownloadToFile
Post by: xra7en on July 08, 2021, 03:36:07 pm
o no rush.. is there something in qb64 that allows two functions to run at the same time?
Title: Re: Progressbar for URLDownloadToFile
Post by: FellippeHeitor on July 08, 2021, 04:21:29 pm
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]
  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
  15.  
  16. Timer.Trap:
  17. PRINT "1s; ";
  19.  
  20. SUB mySub
  21.     PRINT "500ms; ";
Title: Re: Progressbar for URLDownloadToFile
Post by: SpriggsySpriggs on July 08, 2021, 04:36:21 pm
Right. I don't think it would allow us to capture how much has been downloaded yet with that function, though
Title: Re: Progressbar for URLDownloadToFile
Post by: Richard Frost on July 08, 2021, 09:17:56 pm
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!
  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
  15.  
  16. Sub mySub
  17.     xdelay! = Rnd + .1
  18.     _Delay xdelay
  19.     showcount = 1
  21.  
Title: Re: Progressbar for URLDownloadToFile
Post by: xra7en on July 08, 2021, 11:04:45 pm
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
Title: Re: Progressbar for URLDownloadToFile
Post by: xra7en on July 08, 2021, 11:37:34 pm
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 :-)
Title: Re: Progressbar for URLDownloadToFile
Post by: SpriggsySpriggs on July 09, 2021, 07:52:34 am
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.
Title: Re: Progressbar for URLDownloadToFile
Post by: xra7en on July 09, 2021, 08:03:40 am
Quote from: SpriggsySpriggs on July 09, 2021, 07:52:34 am
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
Title: Re: Progressbar for URLDownloadToFile
Post by: xra7en on July 10, 2021, 02:11:40 pm
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]
  5.  
  7.     Function URLDownloadToFileA%& (ByVal pCaller As Long, szURL As String, szFileName As String, Byval dwReserved As Long, Byval lpfnCB As Long)
  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
  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.  
  103.  
  104.  
  105.  
  106. ' $include: 'utils.bi'
  107.  
  108.  
  109. Sub progressBar
  110.     Print ".";
  112.  
  113. Function FileDownload%& (URL As String, File As String)
  114.     FileDownload = URLDownloadToFileA(0, URL + Chr$(0), File + Chr$(0), 0, 0)
  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
  152.  
  153.  
  154.  
  155. Sub openDB
  156.     downloadDB
  157.     FF = FreeFile
  158.  
  159.     Open DATABASE For Input As #FF
  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.  
  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.  
  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 ;
  38.  
  39. Sub LWRITELN (TXT As String)
  40.     LWRITE (TXT$)
  41.     Print
  43.  
  44.  
Title: Re: Progressbar for URLDownloadToFile
Post by: SpriggsySpriggs on July 12, 2021, 03:29:55 pm
@xra7en

Code: QB64: [Select]
  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.  
  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)
  28.  
  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)
  34.  
  35. Declare CustomType Library ".\offsettostring"
  36.     Function offset_to_string$ Alias "offset_to_offset" (ByVal offset As _Offset)
  38.  
  40.     Function MAKELANGID& (ByVal p As Long, Byval s As Long)
  42.  
  43.  
  44. Screen _NewImage(480, 80, 32)
  49.  
  50. _Title "URL Downloader"
  51. _ConsoleTitle "Enter Link"
  53. Dim filename As String
  54.  
  56.     Cls
  57.     Line Input "Link: ", link
  58.     Line Input "File Name : ", filename
  59. Loop Until link <> "" And filename <> ""
  61. _Title _Title$ + " - " + Mid$(filename, _InStrRev(filename, "\") + 1)
  62.  
  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
  245.  
  246. Function timeElapsedSince! (startTime!)
  247.     If startTime! > Timer Then startTime! = startTime! - 86400
  248.     timeElapsedSince! = Timer - startTime!
  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)
  274.  
Title: Re: Progressbar for URLDownloadToFile
Post by: xra7en on July 13, 2021, 05:05:32 pm
link used

https://www.7-zip.org/a/7z1900-x64.exe

Title: Re: Progressbar for URLDownloadToFile
Post by: SpriggsySpriggs on July 13, 2021, 05:08:05 pm
@xra7en Worked for me:

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Make sure that when you are pasting the link it isn't immediately trying to download. It should ask for a link and then immediately ask for a file name.
Title: Re: Progressbar for URLDownloadToFile
Post by: xra7en on July 13, 2021, 05:33:01 pm
your on windows 11, Im still using (by choice) windows 7.
I have noticed that when I use my 10 rig, I run into less issue (not always).

And the app does indeed ask for a file an not download right away.

I noticed when I used win10 with powershell download scripts, they work good, win7 was a hit and miss. Mostly because win7 comes with PS2, vs PS5+
The scrip is great.. and there are no errors, but when I run it, it craps out on me.

Starting to believe it is a win7 issue.
Title: Re: Progressbar for URLDownloadToFile
Post by: SpriggsySpriggs on July 13, 2021, 05:39:46 pm
Could be, but I ran this on 10 on my work PC. Not 11
Title: Re: Progressbar for URLDownloadToFile
Post by: xra7en on July 13, 2021, 05:49:41 pm
I was just tinkering around with it again and it worked ! Only once!
Not sure why, because when I repeat it, it fails again.

so that is weird..
I'll keep playing with it... thanks for the code...
not sure why its being goofy on my end.

edit:
also noticed it is not giving me an error.
Title: Re: Progressbar for URLDownloadToFile
Post by: SpriggsySpriggs on July 13, 2021, 06:10:03 pm
Win32 API is weird, sometimes. It can be very wonky. Let me know if you ever need more help.
Title: Re: Progressbar for URLDownloadToFile
Post by: xra7en on July 13, 2021, 06:20:53 pm
absolutely - you are very educational, albeit over my head a bit LOL.

I'll tinker with it for awhile and see why it downloads one time and not another.


edit:
this link worked

https://www.mediafire.com/file/wl3bcf75p6ledep/torbrowser-install-win64-10.5_en-US.exe/file
i repeated this link a few times, so far so good.


this one did not
https://github.com/wavebox/waveboxapp/releases/download/v4.11.6/install_wavebox_4_11_6_x64.exe

stil cant get
https://www.7-zip.org/a/7z1900-x64.exe
this to work.

is it possible that it is running into a security protocol? (win10 might process those differently from win7)
Title: Re: Progressbar for URLDownloadToFile
Post by: SMcNeill on July 13, 2021, 07:11:07 pm
If this works with a c-based library, you may need CHR$(0) string termination.  Make certain there’s a CHR$(0) added to the end of your link and see if that changes anything.
Title: Re: Progressbar for URLDownloadToFile
Post by: xra7en on July 13, 2021, 08:02:04 pm
no joy.. some links work, others don't
(oddly the 7zip link does not work)
Title: Re: Progressbar for URLDownloadToFile
Post by: SpriggsySpriggs on July 13, 2021, 09:00:19 pm
Sometimes this is caused by the request not matching what they want and so they block the request. All of your links worked for me. I might have to look at that User Agent variable
Text Only | Text with Attachments