View Full Version : [Vb] Download file binari via http
buongiorno a tutti :D
volevo chiedervi come si può fare a trasferire file, per esempio, immagini, da internet a locale tipo da "www.sito.it/immagine1.jpg" a "C:/", se avete qualche straccio di codice concreto che funzioni realmente tanto meglio perchè con internet e vb combinati sono proprio negato :muro:
grazie in anticipo :mano:
buongiorno a tutti :D
volevo chiedervi come si può fare a trasferire file, per esempio, immagini, da internet a locale tipo da "www.sito.it/immagine1.jpg" a "C:/", se avete qualche straccio di codice concreto che funzioni realmente tanto meglio perchè con internet e vb combinati sono proprio negato :muro:
grazie in anticipo :mano:
metti un controllo Inet sul form (aggiungilo da componenti)
-------------code-------------------
'global in generali
Dim strURL As String
Dim bit() As Byte
Dim nominativo As String
'Command1
strURL = "http://tuosito/" & "tuofile.jpg": nominativo = "tuofile.jpg"
bit() = Inet1.OpenURL(strURL, icByteArray)
' il file lo crea nella dir del progetto
Open nominativo For Binary Access Write As #1
' il file lo crea nel percorso specificato
'Open "c:\" & nominativo For Binary Access Write As #1
Put #1, , bit()
Close #1
--------end code--------------------
ciao
metti un controllo Inet sul form (aggiungilo da componenti)
'global in generali
Dim strURL As String
Dim bit() As Byte
Dim nominativo As String
'Command1
strURL = "http://tuosito/" & "tuofile.jpg": nominativo = "tuofile.jpg"
bit() = Inet1.OpenURL(strURL, icByteArray)
' il file lo crea nella dir del progetto
Open nominativo For Binary Access Write As #1
' il file lo crea nel percorso specificato
'Open "c:\" & nominativo For Binary Access Write As #1
Put #1, , bit()
Close #1
ciao
grazie tante! Ciao
Massi91
Dal regolamento
1.5 - Avatar, signature e sito personale
.........
b) Signature: 3 righe a 1024 solo testo con un massimo di 3 smiles dell'Hardware Upgrade Forum oppure un'immagine 100 X 50 X 5KB e una riga di testo (non deve andare a capo).
Direi che la tua signature è fuori regola ;)
Ti pregherei di modificarla
Grazie
leadergl
25-07-2005, 17:29
perchè a me non scarica nulla?
ho provato sia col mio sito che con l'immagine "im_msn.gif" di questo forum...ma nulla
perchè a me non scarica nulla?
ho provato sia col mio sito che con l'immagine "im_msn.gif" di questo forum...ma nulla
In generali aggiungi:
dim path as string
e in form load metti:
path=App.path & "\"
quindi modifica questa riga
Open path & nominativo For Binary Access Write As #1
........... avrai il file nella dir di progetto
Nell'altro modo pure ti ha creato il file non nella dir di progetto ma probabilmente hai fatto doppio click per aprire il progetto direttamente dalla dir e quindi la dir principale non è la dir di progetto ma quella locale di dove risiede l'IDE.
Per tua curiosità fai una ricerca sul pc per tuofile.jpg, ovvero il nome che hai dato a nominativo e guarda in che dir ti ha salvato il file (perchè sicuramente te l'ha salvato).
ciao
leadergl
25-07-2005, 20:29
no, non è questo il problema...il file glielo facevo creare in c:\ ma mi creava un file vuoto...senza niente dentro e questo perchè non leggeva niente da internet ma creava lo stesso il file:
Open "c:\msn.gif" For Binary Access Write As #1
' il file lo crea nel percorso specificato
Put #1, , bit()
Close #1
il problema è che proprio non mi legge niente da internet...come mai?
(P.S. io ho fastweb)
posta il codice che usi così che posso aiutarti
se usi solo questo:
Open "c:\msn.gif" For Binary Access Write As #1
' il file lo crea nel percorso specificato
Put #1, , bit()
Close #1
.....èchiaro che ti crea un file vuoto devi scrivere anche questo codice e cioè l'indirizzo di dove si trova il file:
'questo è l'indirizzo di dove prelevare il file
'tuosito deve essere un link esistente del web
strURL = "http://tuosito/" & "tuofile.jpg": nominativo = "tuofile.jpg"
'questo è il controllo inet che prende il link che gli passi
bit() = Inet1.OpenURL(strURL, icByteArray)
questo per esempio è il mio dominio webe puoi scaricare questo:
strURL = "http://www.twork.it/work/" & "": nominativo = "oki_tut.zip"
metti questo e vedrai lo zip nella dir
spero che era questo il problema
ciao
leadergl
25-07-2005, 21:30
Ma noo...ovvio che non uso solo quello...avevo indicato solo la parte modificata...cmq questo è il codice:
Dim strURL As String
Dim bit() As Byte
Dim nominativo As String
Private Sub Command1_Click()
strURL = "http://www.leadergl.net/upgrade/italiano.lng": nominativo = "italiano.lng"
bit() = Inet1.OpenURL(strURL, icByteArray)
' il file lo crea nella dir del progetto
Open "c:\italiano.lng" For Binary Access Write As #1
Put #1, , bit()
Close #1
End Sub
ed anche se provo in "icString" non funziona
Ma noo...ovvio che non uso solo quello...avevo indicato solo la parte modificata...cmq questo è il codice:
Dim strURL As String
Dim bit() As Byte
Dim nominativo As String
Private Sub Command1_Click()
strURL = "http://www.leadergl.net/upgrade/italiano.lng": nominativo = "italiano.lng"
bit() = Inet1.OpenURL(strURL, icByteArray)
' il file lo crea nella dir del progetto
Open "c:\italiano.lng" For Binary Access Write As #1
Put #1, , bit()
Close #1
End Sub
ed anche se provo in "icString" non funziona
okay, infatti questo è errato:
strURL = "http://www.leadergl.net/upgrade/italiano.lng"
modifica così:
strURL = "http://www.leadergl.net/upgrade/"
.... ecco devi passare la dir dell'ubicazione del file e la stringa nominativo deve essere il file che scarichi nel tuo caso:
nominativo = "italiano.lng"
quì, per eleganza puoi fare:
Open "c:\" & nominativo For Binary Access Write As #1
sono sicuro che adesso funziona
ciao
leadergl
25-07-2005, 21:44
non sono troppo convinto...scusa se metto
strURL = "http://www.leadergl.net/upgrade/"
poi la funzione
bit() = Inet1.OpenURL(strURL, icByteArray)
come fa a capire il file che deve prelevare?
cmq ho provato ma non è cambiato nulla...
leadergl
25-07-2005, 21:57
:D trovato il problema...era il bastardo del mio FireWall che impediva a VisualBasic di accedere a Internet....c'ho perso una giornata...ma porca.... :muro:
leadergl
25-07-2005, 22:41
ok, una sola domanda....come faccio a farmi dare la grandezza del file che sto per scaricare?
:D trovato il problema...era il bastardo del mio FireWall che impediva a VisualBasic di accedere a Internet....c'ho perso una giornata...ma porca.... :muro:
dim stfilelen as string
stfilelen="c:\tuofile.exe"
TotBytes = Str(FileLen(stfilelen))
ciao
leadergl
25-07-2005, 23:20
...intendo del file che sto per scaricare da internet...
in pratica mi serve per calcolare la progressione del download...
...intendo del file che sto per scaricare da internet...
in pratica mi serve per calcolare la progressione del download...
E' appunto quello che ti ho scritto prima
dim stfilelen as string
stfilelen="c:\tuofile.exe"
TotBytes = Str(FileLen(stfilelen))
TotBytes corrisponde alla grandezza in bytes del file
non ci vuole tanto gli dai il percorso di strURL
con il valore di bytes del file puoi calcolare ha quanti byte x secondo lo stai scaricando quanto manca alla fine del download il tempo stimato ecc,ecc
naturalmente con una routine del tempo trascorso meno il tempo effettivo
ciao
leadergl
26-07-2005, 07:41
Dici che basta fare:
Dim TotBytes as long
Dim Url as string
Url="http://www.leadergl.net/upgrade/italiano.lng"
TotBytes=Filelen(Url)
MsgBox TotBytes
e funziona?
dubito..anke xkè ho provato :P
sicuro che non esiste una funzione fatta apposta?
leadergl
26-07-2005, 22:20
Raga nessuno sa come farmi restituire la grandezza in byte di un file che sta in internet?... :mc:
allora ho visto che:
con il controllo inet non conosco il modo per farlo.
Conosco il modo per farlo con il controllo winsok
se ho un pò di tempo ti taglio qualcosa e posto
Sei fortunato... avevo un pò di tempo ed ecco quì:
questo è con il controllo winsok:
fai un nuovo progetto e metti una label1.caption
un controllo timer
un controllo winsock1
e un command1.button
il controllo winsock1 lo chiami (nelle proprietà) winsock (come nel codice) e setti la porta a 80
il timer lo chiami tmrUpdateProgress e setti la proprietà interval = 1
poi...............
immetti nel progetto un modulo bas e incolli questo codice
----------code x bas------------------
Global strSvrURL As String
Global URL As String
Global RESUMEFILE As Boolean
Global FilePathName As String
Global Filename As String
Global FileLength As Single
Global Sec%, Min%, Hr%
Public Function GETDATAHEAD(DATA As Variant, ToRetrieve As String)
Stop
On Error Resume Next
If DATA = "" Then Stop: Exit Function
Stop
Dim EndBYTES%, A$, LENGTHEND%, PART%, Part2%, RetrieveLength%
If InStr(DATA, ToRetrieve) > 0 Then
Stop
LENGTHEND = Len(DATA)
PART = InStr(DATA, ToRetrieve)
RetrieveLength = Len(ToRetrieve)
A = Right(DATA, LENGTHEND - PART - RetrieveLength)
LENGTHEND = Len(A)
Stop
If InStr(A, vbCrLf) > 0 Then
Part2 = InStr(A, vbCrLf)
A = Left(A, Part2 - 1)
Stop
End If
GETDATAHEAD = A
Stop
End If
End Function
----------end code-------------------
invece nel form incolli questo:
---------------code form---------------
Dim DATA, strSvrURL, FilePathName As String
Dim BytesRemaining As Single
Dim BytesAlreadySent As Single
Dim path As String
Dim bit() As Byte
Dim strURL As String
Dim RESUMEFILE As Boolean
Dim BeginTransfer As Single
Dim Header As Variant
Private Sub Command1_Click()
path = App.path & "\"
strURL = "http://www.twork.it/work/oki_tut.zip"
StartUpdate strURL
Winsock.Connect strSvrURL, 80 'strSvrURL
Stop
'bit() = Inet1.OpenURL(strURL, icByteArray)
'Stop
'Open path & "oki_tut.zip" For Binary Access Write As #1
'Put #1, , bit()
'Close #1
'Stop
End Sub
Public Function StartUpdate(strURL As String)
BytesAlreadySent = 1
Stop
If strURL = "" Then Exit Function
URL = strURL
Dim Pos%, Length%, NextPos%, LENGTH2%, POS2%, POS3%
Pos = InStr(strURL, "://")
LENGTH2 = Len("://")
Length = Len(strURL)
If InStr(strURL, "://") Then
strURL = Right(strURL, Length - LENGTH2 - Pos + 1)
End If
If InStr(strURL, "/") Then
POS2 = InStr(strURL, "/")
'-----------------prendi il file-------------
Dim StrFile$: StrFile = strURL
Do Until InStr(StrFile, "/") = 0
LENGTH2 = Len(StrFile)
POS3 = InStr(StrFile, "/")
StrFile = Right(strURL, LENGTH2 - POS3)
Loop
Filename = StrFile
'----------------fine prendi il file--------------
strSvrURL = Left(strURL, POS2 - 1)
End If
Stop
End Function
Private Sub Form_Load()
RESUMEFILE = False
End Sub
Private Sub Winsock_Connect()
'Stop
On Error Resume Next
Dim strCommand As String
strCommand = "GET " + URL + " HTTP/1.0" + vbCrLf
strCommand = strCommand + "Accept: *.*, */*" + vbCrLf
If RESUMEFILE = True Then strCommand = strCommand + "Range: bytes=" & FileLength & "-" & vbCrLf
strCommand = strCommand + "User-Agent: Elucid Software Downloader" & vbCrLf
strCommand = strCommand + "Referer: " & strSvrURL & vbCrLf
strCommand = strCommand + vbCrLf
Winsock.SendData strCommand
BeginTransfer = Timer
'Stop
End Sub
Private Sub Winsock_DataArrival(ByVal bytesTotal As Long)
Stop
Winsock.GetData DATA, vbString
If InStr(DATA, "Content-Type:") Then
If RESUMEFILE = True Then
If InStr(DATA, "HTTP/1.1 206 Partial Content") = 0 Then
MsgBox "Niente resume sul server.", vbCritical, "Resuming non supportato "
Exit Sub
CloseSocket
End If
End If
Dim Pos%, Length%, HEAD$
Pos = InStr(DATA, vbCrLf & vbCrLf)
Length = Len(DATA)
HEAD = Left(DATA, Pos - 1)
DATA = Right(DATA, Length - Pos - 3)
Header = Header & HEAD
Stop
If RESUMEFILE = True Then
BytesAlreadySent = FileLength + 1
Stop
BytesRemaining = GETDATAHEAD(Header, "Content-Length:")
BytesRemaining = BytesRemaining + FileLength
Stop
Else
Stop
BytesRemaining = GETDATAHEAD(Header, "Content-Length:")
label1.Caption = BytesRemaining
Stop
End If
txtHead = Header
Stop
End If
Stop
Open path & "oki_tut.zip" For Binary Access Write As #1
Put #1, BytesAlreadySent, DATA
BytesAlreadySent = Seek(1)
Close #1
'--------------------------------------------------
End Sub
Public Sub CloseSocket()
'Winsock.Close
Do Until Winsock.State = 0
Winsock.Close
Winsock.LocalPort = 0
Close #1
Loop
End Sub
Private Sub tmrUpdateProgress_Timer()
On Error Resume Next
If BytesAlreadySent > 0 And BytesRemaining > 0 Then
'quì il code te lo fai tu, niente pappa pronta adesso che hai capito vai.........
End If
End Sub
--------end code-----------------------
se hai problemi posta pure
ciao
vBulletin® v3.6.4, Copyright ©2000-2025, Jelsoft Enterprises Ltd.