Bueno aca dejo un código que saqué de planet source code y me pareció muy interesante, ya que no tenía idea de que vb tenía funciones para descargar...
Esta hecho exclusivamente con vb sin ningun componente ni nada externo...
En un control de usuario (*.clt):
Código:
Option Explicit
' This component doesn't require any external calls/apis/references
' Obtains an url to a byte array using native VB6 calls
' Asyncronous - no need to wait for data to arrive
' Multiple downloads are accepted at the same time (different URL's, etc)
' If you like this code, please VOTE for it
' You may use this code freely in your projects, but whenever possible,
' include my name 'Filipe Lage' on the 'Help->About' or something ;)
' Cheers :)
'
' Filipe Lage
' fclage@ezlinkng.com
'
Public Event Progress(x As AsyncProperty, percent As Single)
Public Event Finished(x As AsyncProperty)
Public CurrentDownloads As New Collection
Public Function Download(xurl As String) As Boolean
On Error Resume Next
UserControl.AsyncRead xurl, vbAsyncTypeByteArray, xurl, vbAsyncReadForceUpdate
CurrentDownloads.Add xurl, xurl
RefreshStatus
End Function
Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
RaiseEvent Finished(AsyncProp)
On Error Resume Next
CurrentDownloads.Remove AsyncProp.PropertyName
RefreshStatus
On Error GoTo 0
End Sub
Private Sub UserControl_AsyncReadProgress(AsyncProp As AsyncProperty)
Dim p As Single
If AsyncProp.BytesMax > 0 Then p = 100 * (AsyncProp.BytesRead / AsyncProp.BytesMax) Else p = 0
RaiseEvent Progress(AsyncProp, p)
End Sub
Private Sub UserControl_Resize()
UserControl.Width = 960
UserControl.Height = 960
End Sub
Public Sub CancelDownload(xurl As String)
On Error Resume Next
UserControl.CancelAsyncRead CurrentDownloads(xurl)
CurrentDownloads.Remove xurl
On Error GoTo 0
End Sub
Private Sub UserControl_Show()
If UIMode = True Then
Else
UserControl.Extender.Visible = False
End If
End Sub
Private Sub UserControl_Terminate()
Do Until CurrentDownloads.Count = 0
CancelDownload CurrentDownloads(1)
Loop
End Sub
Private Sub RefreshStatus()
UserControl.Cls
UserControl.CurrentX = 0
UserControl.CurrentY = 0
UserControl.Print CurrentDownloads.Count
End Sub
Private Function UIMode() As Boolean
On Error Resume Next
Err.Clear
Debug.Print 1 / 0
UIMode = (Err.Number <> 0)
On Error GoTo 0
End Function
Si quieren probar, agregar a un form:
<ul>[*]1 listview (myDownloads)[*]1 command (Command1)[*]1 cltDownloads (el código anterior) (x)[/list]Y este código:
Código:
Private Sub Command1_Click()
For Each n In Me.myDownloads.ListItems
x.Download n.Text
Next
End Sub
Private Sub Form_Activate()
Label2.Visible = x.Visible
End Sub
Private Sub Form_Load()
xurl = "http://www.google.com/"
Set n = myDownloads.ListItems.Add(, xurl, xurl, , "default")
xurl = "http://www.microsoft.com/"
Set n = myDownloads.ListItems.Add(, xurl, xurl, , "default")
xurl = "http://www.theinquirer.net/inquirer.rss"
Set n = myDownloads.ListItems.Add(, xurl, xurl, , "default")
xurl = "http://www.yahoo.com/"
Set n = myDownloads.ListItems.Add(, xurl, xurl, , "default")
xurl = "ftp://ftp.unb.br/pub/capes/Coleta63/coleta63.exe"
Set n = myDownloads.ListItems.Add(, xurl, xurl, , "default")
End Sub
Private Sub Form_Resize()
On Error Resume Next
Frame1.Move 0, ScaleHeight - Frame1.Height, ScaleWidth, Frame1.Height
Me.myDownloads.Move 0, 0, ScaleWidth, ScaleHeight - Frame1.Height
End Sub
Private Sub myDownloads_DblClick()
If myDownloads.SelectedItem Is Nothing Then Exit Sub
MsgBox myDownloads.SelectedItem.Tag, vbInformation, myDownloads.SelectedItem.Text
End Sub
Private Sub x_Finished(x As AsyncProperty)
Dim n As ListItem
Set n = myDownloads.ListItems(x.PropertyName)
If x.StatusCode = vbAsyncStatusCodeEndDownloadData Then
n.SmallIcon = "downloaded"
n.SubItems(1) = x.BytesRead & " bytes"
n.SubItems(2) = "Downloaded"
n.Tag = StrConv(x.Value, vbUnicode)
Else
n.SmallIcon = "failed"
n.SubItems(2) = "Failed"
n.Tag = ""
End If
End Sub
Private Sub x_Progress(x As AsyncProperty, percent As Single)
Dim n As ListItem
Set n = myDownloads.ListItems(x.PropertyName)
n.SubItems(2) = "Downloading " & Format(percent, "0.0") & "%"
n.SmallIcon = "downloading"
n.SubItems(1) = x.BytesRead & " / " & x.BytesMax
End Sub
Y para descargar el original:
http://www.Planet-Source-Code.com/vb...howCode.asp?tx tCodeId=64750&lngWId=1
Saludos
Edited by: Post-Newbie