11-07-2023, 07:39 AM
I recently posted a question about grabbing a url and wrote the following:
This attempts to grab a url and writes it to a filename:
This attempts to grab a url and writes it to a filename:
Code: (Select All)
Rem program to grab url filename.
DefLng A-Z
On Error GoTo Hell
$Unstable:Http
Print "Enter url";: Input url$
Print "Enter filename";: Input Urlfile$
If Len(url$) And Len(Urlfile$) Then
Z = DownloadToFileX&(url$, Urlfile$)
If Z = 404 Then
Print "File not found."
Else
If Z >= 200 And Z < 300 Then
Print "Download success."
Else
Print "Download failure."
End If
End If
End If
End
Hell:
Z = 404
Resume Next
' get a file from url and download
Function DownloadToFileX& (url As String, Urlfile$)
Dim bytescopied As Double
Dim bytestring As String
Dim clienthandle As Long
Dim filehandle As Long
client$ = url
If Left$(client$, 2) = "//" Then
client$ = "HTTP:" + client$
End If
If Left$(LCase$(client$), 5) = "http:" Or Left$(LCase$(client$), 6) = "https:" Then
eat$ = ""
Else
client$ = "HTTP:" + client$
End If
' check url exists.
clienthandle = _OpenClient(client$)
If clienthandle = 0 Then
DownloadToFileX& = 404
Print "Cannot open client."
Exit Function
End If
If clienthandle Then
x = _StatusCode(clienthandle)
DownloadToFileX& = x
If x >= 200 And x < 300 Then
' prompt to delete output file only if url exists.
If _FileExists(Urlfile$) Then
Print "Output file exists."
Print "Delete file(y/n/q)?";
Do
_Limit 50
X$ = InKey$
If LCase$(X$) = "y" Then
Var$ = Urlfile$ + Chr$(0)
Kill Var$
Exit Do
End If
If LCase$(X$) = "n" Then
Exit Do
End If
If LCase$(X$) = "q" Then
Close #clienthandle
DownloadToFileX& = 404
Exit Function
End If
Loop
End If
' open output file only if url exists.
filehandle = FreeFile
Open Urlfile$ For Binary As #filehandle
' copy the file.
bytescopied = 0#
starttimer = Timer
While Not EOF(clienthandle)
_Limit 60
Get #clienthandle, , bytestring
Put #filehandle, , bytestring
bytescopied = bytescopied + Len(bytestring)
elapsed = Timer - starttimer
If elapsed < 0 Then elapsed = elapsed + 86400
If elapsed >= 1 Then
starttimer = Timer
_Title "QB64 - Url: " + Str$(bytescopied) + " bytes copied."
End If
Wend
Print "QB64 - Url: " + Str$(bytescopied) + " bytes copied."
Else
Print "Cannot open client."
End If
End If
Close #clienthandle, filehandle
End Function
