RE: NEW NEW URL Downloader (All Platforms!) - bplus - 06-26-2023
(06-26-2023, 11:27 AM)Ultraman Wrote: Some people have a hobby of resurrecting old posts, I reckon.
@Ultraman = Balderdash = Spriggsy (because one name just isn't enough!)
That is beauty of forums, something you can't get on say a Discord chat.
RE: NEW NEW URL Downloader (All Platforms!) - Ultraman - 06-26-2023
Si, it is me. I just lost access to Spriggsy and don't have my email and password anymore. I used a temporary email lol. Same for Balderdash.
RE: NEW NEW URL Downloader (All Platforms!) - bplus - 06-26-2023
Ah! that sucks, I keep a spiral notebook, so old fashioned of me I know. LOL
Which is worse passwords or whole hard drives? No old fashioned methods for that, I think.
Update:
Quote:Si, it is me. I just lost access to Spriggsy and don't have my email and password anymore. I used a temporary email lol. Same for Balderdash.
wait... temporary email? WTH? Isn't that a troll trick?
Please tell me a legit reason to do that?
RE: NEW NEW URL Downloader (All Platforms!) - Ultraman - 06-26-2023
Nah, I use an email forwarding service for basically every website. Each website has a different email address for me. I just lost access to the first two for here. Keeps spam and stuff minimized since it allows me to disable forwards at will. Also maintains privacy since it doesn't attach my main personal email account to my name as much as it used to.
RE: NEW NEW URL Downloader (All Platforms!) - bplus - 06-26-2023
OK thanks
RE: NEW NEW URL Downloader (All Platforms!) - Ultraman - 06-29-2023
(06-24-2023, 08:41 PM)loopy750 Wrote: This is cool, and it's nice to see lower CPU usage while downloading with this vs using a browser. On line 86 though I had to replace Round with Int for accurate download rate (was displaying only 60 MBps instead of 112 MBps).
For even greater accuracy, you can Dim x as Double, remove Round, if x = 1 becomes if x >= 1, and replace Timer with Timer(.001).
Also for some weird reason, every 2 GB interval, LOF(outfile) returns a negative number, but using a mathematical equations fixes it... kinda a weird QB64 issue.
So to fix that for example, line 53 becomes Select Case LOF(outfile) + 0
doesn't make sense to me, but it works. I'm curious.... What version of QB64 are you using? 32 bit? 64 bit? Linux? Windows?
I tried out those changes you mentioned and saw nothing different at all on my output. Not a single thing was different. I even tried KiloManjaro's suggestions.
Oops. I forgot to take off ROUND before sending that post. It looks like it does pull through at around double the rate, which is odd. LOF(outfile) should handle up to 9 GB, at least. But I didn't think about the fact that at 9GB, it would overflow anyways. So, as KiloManjaro suggested, I've stored the result in an _INTEGER64 variable:
Code: (Select All)
Option Explicit
$NoPrefix
$Unstable:Http
Const KILOBYTE = 1024
Const MEGABYTE = KILOBYTE ^ 2
Const GIGABYTE = KILOBYTE ^ 3
Const TERABYTE = KILOBYTE ^ 4
Screen NewImage(480, 120, 32)
$ScreenHide
ScreenHide
$Console
Dest Console
Title "QB64 URL Downloader"
ConsoleTitle "Enter Link"
Dim As String link
Do
Cls
Line Input "Link: ", link
Loop Until link <> ""
ScreenShow
Title Title$ + " - " + link
Console Off
Dest 0
Dim As Long connection: connection = OpenClient("HTTP:" + link)
Dim As String buf
If connection <> 0 And StatusCode(connection) = 200 Then
Dim As Long length: length = LOF(connection)
Dim As _Unsigned _Integer64 totalSize
Dim As String server, path
DivideURL link, path
Dim As String filepath: filepath = path
filepath = Mid$(filepath, InStrRev(filepath, "/") + 1)
If InStr(filepath, ".") Then filepath = Mid$(filepath, 1, InStrRev(filepath, ".") + 3)
If InStr(filepath, "?") Then filepath = Mid$(filepath, 1, InStr(filepath, "?") - 1)
Dim As Long outfile: outfile = FreeFile
filepath = UnescapeURL(filepath)
If FileExists(filepath) Then Kill filepath
Open "B", outfile, filepath
Dim As Double y: y = Timer(0.001)
While Not EOF(connection)
Cls
Dim As Long bytesForRate
Get connection, , buf
bytesForRate = bytesForRate + Len(buf)
Put outfile, , buf
totalSize = totalSize + Len(buf)
If length > 0 Then
Select Case totalSize
Case Is < KILOBYTE
Print Using "#### B downloaded of "; totalSize;
Case Is < MEGABYTE And totalSize >= KILOBYTE
Print Using "####.## KB downloaded of "; totalSize / KILOBYTE;
Case Is < GIGABYTE And totalSize >= MEGABYTE
Print Using "####.## MB downloaded of "; totalSize / MEGABYTE;
Case Is < TERABYTE And totalSize >= GIGABYTE
Print Using "####.## GB downloaded of "; totalSize / GIGABYTE;
End Select
Select Case length
Case Is < KILOBYTE
Print Using "#### B"; length
Case Is < MEGABYTE And length >= KILOBYTE
Print Using "####.## KB"; length / KILOBYTE
Case Is < GIGABYTE And length >= MEGABYTE
Print Using "####.## MB"; length / MEGABYTE
Case Is < TERABYTE And length >= GIGABYTE
Print Using "####.## GB"; length / GIGABYTE
End Select
Else
Select Case totalSize
Case Is < KILOBYTE
Print Using "#### B downloaded"; totalSize
Case Is < MEGABYTE And LOF(outfile) >= KILOBYTE
Print Using "####.## KB downloaded"; totalSize / KILOBYTE
Case Is < GIGABYTE And LOF(outfile) >= MEGABYTE
Print Using "####.## MB downloaded"; totalSize / MEGABYTE
Case Is < TERABYTE And LOF(outfile) >= GIGABYTE
Print Using "####.## GB downloaded"; totalSize / GIGABYTE
End Select
End If
Dim As Single Rate
Dim As Double x: x = Timer - y
If x >= 1 Then
Rate = (bytesForRate / x)
bytesForRate = 0
y = Timer(0.001)
End If
Select Case Rate
Case Is < KILOBYTE
Print Using "Rate: #### Bps"; Rate
Case Is < MEGABYTE And Rate >= KILOBYTE
Print Using "Rate: ####.## KBps"; Rate / KILOBYTE
Case Is < GIGABYTE And Rate >= MEGABYTE
Print Using "Rate: ####.## MBps"; Rate / MEGABYTE
Case Is < TERABYTE And Rate >= GIGABYTE
Print Using "Rate: ####.## GBps"; Rate / GIGABYTE
End Select
Display
Limit 60
Wend
Close connection
Close outfile
Print "The resource was successfully retrieved"
Print "Saved to "; filepath
Else
Print "Could not connect or another error occurred"
End If
EscapeCodes:
Data "%20","%3C","%3E","%23","%25","%2B"
Data "%7B","%7D","%7C","%5C","%5E","%7E"
Data "%5B","%5D","%60","%3B","%2F","%3F"
Data "%3A","%40","%3D","%26","%24"
Data "%28","EOD"
Sub DivideURL (url As String, path As String)
Dim As String server
If InStr(url, "http:") Or InStr(url, "https:") Then
server = Mid$(url, InStr(url, "/") + 2)
If InStr(server, "/") Then
server = Mid$(server, 1, InStr(server, "/") - 1)
End If
Else
If InStr(url, "/") Then
server = Mid$(url, 1, InStr(url, "/") - 1)
End If
End If
path = Mid$(url, InStr(url, server) + Len(server))
End Sub
Function UnescapeURL$ (url As String)
Restore EscapeCodes
Dim As String code, before, after, newurl
newurl = url
Read code
While code <> "EOD"
If InStr(newurl, code) Then
While InStr(newurl, code)
before = Mid$(newurl, 1, InStr(newurl, code) - 1)
after = Mid$(newurl, InStr(newurl, code) + Len(code))
newurl = before + Chr$(Val("&H" + Mid$(code, 2))) + after
Wend
End If
Read code
Wend
UnescapeURL = newurl
End Function
RE: NEW NEW URL Downloader (All Platforms!) - Ultraman - 06-29-2023
Huh. Actually kind of glad y'all brought back this post. Made me realize I had another bug in here as well. Now I should be able to unescape URLs a lot better:
Code: (Select All)
Option Explicit
$NoPrefix
$Unstable:Http
Const KILOBYTE = 1024
Const MEGABYTE = KILOBYTE ^ 2
Const GIGABYTE = KILOBYTE ^ 3
Const TERABYTE = KILOBYTE ^ 4
Screen NewImage(480, 120, 32)
$ScreenHide
ScreenHide
$Console
Dest Console
Title "QB64 URL Downloader"
ConsoleTitle "Enter Link"
Dim As String link
Do
Cls
Line Input "Link: ", link
Loop Until link <> ""
ScreenShow
Title Title$ + " - " + link
Console Off
Dest 0
Dim As Long connection: connection = OpenClient("HTTP:" + link)
Dim As String buf
If connection <> 0 And StatusCode(connection) = 200 Then
Dim As Long length: length = LOF(connection)
Dim As _Unsigned _Integer64 totalSize
Dim As String server, path
DivideURL link, path
Dim As String filepath: filepath = path
filepath = Mid$(filepath, InStrRev(filepath, "/") + 1)
If InStr(filepath, ".") Then filepath = Mid$(filepath, 1, InStrRev(filepath, ".") + 3)
If InStr(filepath, "?") Then filepath = Mid$(filepath, 1, InStr(filepath, "?") - 1)
Dim As Long outfile: outfile = FreeFile
filepath = UnescapeURL(filepath)
If FileExists(filepath) Then Kill filepath
Open "B", outfile, filepath
Dim As Double y: y = Timer(0.001)
While Not EOF(connection)
Cls
Dim As Long bytesForRate
Get connection, , buf
bytesForRate = bytesForRate + Len(buf)
Put outfile, , buf
totalSize = totalSize + Len(buf)
If length > 0 Then
Select Case totalSize
Case Is < KILOBYTE
Print Using "#### B downloaded of "; totalSize;
Case Is < MEGABYTE And totalSize >= KILOBYTE
Print Using "####.## KB downloaded of "; totalSize / KILOBYTE;
Case Is < GIGABYTE And totalSize >= MEGABYTE
Print Using "####.## MB downloaded of "; totalSize / MEGABYTE;
Case Is < TERABYTE And totalSize >= GIGABYTE
Print Using "####.## GB downloaded of "; totalSize / GIGABYTE;
End Select
Select Case length
Case Is < KILOBYTE
Print Using "#### B"; length
Case Is < MEGABYTE And length >= KILOBYTE
Print Using "####.## KB"; length / KILOBYTE
Case Is < GIGABYTE And length >= MEGABYTE
Print Using "####.## MB"; length / MEGABYTE
Case Is < TERABYTE And length >= GIGABYTE
Print Using "####.## GB"; length / GIGABYTE
End Select
Else
Select Case totalSize
Case Is < KILOBYTE
Print Using "#### B downloaded"; totalSize
Case Is < MEGABYTE And LOF(outfile) >= KILOBYTE
Print Using "####.## KB downloaded"; totalSize / KILOBYTE
Case Is < GIGABYTE And LOF(outfile) >= MEGABYTE
Print Using "####.## MB downloaded"; totalSize / MEGABYTE
Case Is < TERABYTE And LOF(outfile) >= GIGABYTE
Print Using "####.## GB downloaded"; totalSize / GIGABYTE
End Select
End If
Dim As Single Rate
Dim As Double x: x = Timer(0.001) - y
If x >= 1 Then
Rate = (bytesForRate / x)
bytesForRate = 0
y = Timer(0.001)
End If
Select Case Rate
Case Is < KILOBYTE
Print Using "Rate: #### Bps"; Rate
Case Is < MEGABYTE And Rate >= KILOBYTE
Print Using "Rate: ####.## KBps"; Rate / KILOBYTE
Case Is < GIGABYTE And Rate >= MEGABYTE
Print Using "Rate: ####.## MBps"; Rate / MEGABYTE
Case Is < TERABYTE And Rate >= GIGABYTE
Print Using "Rate: ####.## GBps"; Rate / GIGABYTE
End Select
Display
Limit 60
Wend
Close connection
Close outfile
Print "The resource was successfully retrieved"
Print "Saved to "; filepath
Else
Print "Could not connect or another error occurred"
End If
Sub DivideURL (url As String, path As String)
Dim As String server
If InStr(url, "http:") Or InStr(url, "https:") Then
server = Mid$(url, InStr(url, "/") + 2)
If InStr(server, "/") Then
server = Mid$(server, 1, InStr(server, "/") - 1)
End If
Else
If InStr(url, "/") Then
server = Mid$(url, 1, InStr(url, "/") - 1)
End If
End If
path = Mid$(url, InStr(url, server) + Len(server))
End Sub
Function UnescapeURL$ (url As String)
Dim As String before, after, newurl
newurl = url
Dim As _Unsigned _Byte code
For code = 32 To 255
If InStr(newurl, "%" + Hex$(code)) Then
While InStr(newurl, "%" + Hex$(code))
before = Mid$(newurl, 1, InStr(newurl, "%" + Hex$(code)) - 1)
after = Mid$(newurl, InStr(newurl, "%" + Hex$(code)) + Len("%" + Hex$(code)))
newurl = before + Chr$(code) + after
Wend
End If
Next
UnescapeURL = newurl
End Function
RE: NEW NEW URL Downloader (All Platforms!) - TerryRitchie - 06-29-2023
Your code always amazes me. Works perfectly, thank you for the toolbox addition.
|