Problemas con múltiples descargas

Iniciado por aaronduran2, 18 Agosto 2009, 21:53 PM

0 Miembros y 2 Visitantes están viendo este tema.

aaronduran2

Hola. Estoy haciendo un downloader de archivos, y hasta ahora, las descargas iban una por una (desde un ListView).
Pero quería mejorarlo y que se descargasen múltiples archivos, por lo que intenté crear una colección, pero no me salió.

Este es el código que tengo hasta ahora:

Código (vb) [Seleccionar]
Dim cDescarga As clsDescarga
Dim cColeccionDescargas As New Collection

Dim s_NombreArchivo As String, s_URLDescarga As String, s_RutaDestino As String

Private Sub cmdAgregarDescarga_Click()
        Set cDescarga = New clsDescarga

       With lvwDescargas.ListItems.Add(, , s_NombreArchivo)
           .SubItems(1) = s_URLDescarga
       End With

       cDescarga.URL = s_URLDescarga
       cDescarga.Fichero = s_RutaDestino
       cDescarga.Descargar
       cItemDescarga.Add cDescarga
End Sub

Private Sub tmrEstado_Timer()
   For i = 1 To cColeccionDescargas.Count
       With lvwDescargas.ListItems(i)
           .SubItems(2) = cColeccionDescargas(i).BytesRecibidos & "/" & cColeccionDescargas(i).BytesTotales
       End With
   Next
End Sub


Y este es el módulo de clase:

Código (vb) [Seleccionar]
Option Explicit
Private Protocolo As String, Servidor As String, Objeto As String, Servicio As Long
Private URLCorrecta As Boolean, TipoConexion As Long
Private hInternetSession As Long, hInternetConnect As Long, hHttpOpenRequest As Long


Public Enum jrDownTipoAccion
   jrDownSoloInformacion = 0
   jrDownDescargar = 1
End Enum

'constantes de error
Private Const ERROR_URL As Long = 1
Private Const ERROR_INTERNETOPEN = 2
Private Const ERROR_INTERNETCONNECT = 3
Private Const ERROR_INTERNETOPENREQUEST = 4
Private Const ERROR_INTERNETSENDREQUEST = 5
Private Const ERROR_INTERNETQUERYINFO = 6
Private Const ERROR_INTERNETREADFILE = 7
Private Const ERROR_FICHERO = 8
Private Const ERROR_DESCARGA = 999
Private Const ERROR_CANCELADO = 998


'declaraciones del API
Const scUserAgent = "jrDownload"
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_FLAG_RELOAD = &H80000000
Const HTTP_QUERY_CONTENT_TYPE = 1
Const HTTP_QUERY_CONTENT_LENGTH = 5
Const HTTP_QUERY_EXPIRES = 10
Const HTTP_QUERY_LAST_MODIFIED = 11
Const HTTP_QUERY_PRAGMA = 17
Const HTTP_QUERY_VERSION = 18
Const HTTP_QUERY_STATUS_CODE = 19
Const HTTP_QUERY_STATUS_TEXT = 20
Const HTTP_QUERY_RAW_HEADERS = 21
Const HTTP_QUERY_RAW_HEADERS_CRLF = 22
Const HTTP_QUERY_FORWARDED = 30
Const HTTP_QUERY_SERVER = 37
Const HTTP_QUERY_USER_AGENT = 39
Const HTTP_QUERY_SET_COOKIE = 43
Const HTTP_QUERY_REQUEST_METHOD = 45
Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000
'Puertos por defecto
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_DEFAULT_GOPHER_PORT = 70
Const INTERNET_DEFAULT_HTTP_PORT = 80
Const INTERNET_DEFAULT_HTTPS_PORT = 443
Const INTERNET_DEFAULT_SOCKS_PORT = 1080
' Tipos de servicios
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_SERVICE_GOPHER = 2
Const INTERNET_SERVICE_HTTP = 3
'funciones del API para internet
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetConnect Lib "wininet.dll" Alias _
       "InternetConnectA" (ByVal InternetSession As Long, _
       ByVal sServerName As String, ByVal nServerPort As Integer, _
       ByVal sUsername As String, ByVal sPassword As String, _
       ByVal lService As Long, ByVal lFlags As Long, _
       ByVal lContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias _
       "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As _
       String, ByVal sObjectName As String, ByVal sVersion As String, _
       ByVal sReferer As String, ByVal something As Long, ByVal lFlags _
       As Long, ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias _
       "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders _
       As String, ByVal lHeadersLength As Long, sOptional As Any, _
       ByVal lOptionalLength As Long) As Integer
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" _
       (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, _
       ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
'para crear un nombre de fichero temporal y único
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
'para obtener descripción de errores del sistema
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
   (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _
   ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _
   Arguments As Long) As Long
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
'para obtener el tiempo de descarga
Private Declare Function GetTickCount Lib "kernel32" () As Long
'variables locales para almacenar los valores de las propiedades
Private mvarURL As String 'copia local
Private mvarHuboError As Boolean 'copia local
Private mvarStatusCode As String 'copia local
Private mvarStatusText As String 'copia local
Private mvarUsarProxy As String 'copia local
Private mvarNoUsarProxy As String 'copia local
Private mvarUsuario As String 'copia local
Private mvarPassword As String 'copia local
Private mvarFichero As String 'copia local
Private mvarContenidoDescargado As String 'copia local
Private mvarPuerto As Long 'copia local
Private mvarQContentType As Boolean 'copia local
Private mvarQContentLength As Boolean 'copia local
Private mvarQLastModified As Boolean 'copia local
Private mvarQVersion As Boolean 'copia local
Private mvarQRawHeaders As Boolean 'copia local
Private mvarQRawHeadersCrLf As Boolean 'copia local
Private mvarQForwarded As Boolean 'copia local
Private mvarQServer As Boolean 'copia local
Private mvarQRequestMethod As Boolean 'copia local
Private mvarQPragma As Boolean 'copia local
Private mvarQContentLengthStr As String 'copia local
Private mvarQContentTypeStr As String 'copia local
Private mvarQForwardedStr As String 'copia local
Private mvarQLastModifiedStr As String 'copia local
Private mvarQPragmaStr As String 'copia local
Private mvarQRawHeadersStr As String 'copia local
Private mvarQRequestMethodStr As String 'copia local
Private mvarQServerStr As String 'copia local
Private mvarQVersionStr As String 'copia local
Private mvarQRawHeadersCrLfStr As String 'copia local
Private mvarQExpires As Boolean 'copia local
Private mvarQExpiresStr As String 'copia local
Private mvarBytesBloqueDescarga As Long 'copia local

'Para activar este evento, use RaiseEvent con la siguiente sintaxis:
'RaiseEvent Progreso[(arg1, arg2, ... , argn)]
Public BytesTotales As Long, BytesRecibidos As Long, Porcentaje As Double, SegundosTranscurridos As Long, SegundosRestantes As Double, BytesPorSegundo As Long, Cancelar As Boolean
Public Property Let BytesBloqueDescarga(ByVal vData As Long)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.BytesBloqueDescarga = 5
   mvarBytesBloqueDescarga = vData
End Property


Public Property Get BytesBloqueDescarga() As Long
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.BytesBloqueDescarga
   BytesBloqueDescarga = mvarBytesBloqueDescarga
End Property




Private Function LastSystemError() As String
Dim sError As String * 500, lErrNum As Long, lErrMsg As Long

lErrNum = GetLastError()
lErrMsg = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, _
 ByVal 0&, lErrNum, 0, sError, Len(sError), 0)
LastSystemError = left(sError, InStr(sError, Chr(0) - 1))
End Function

Private Sub CierraConexiones()
If hHttpOpenRequest <> 0 Then InternetCloseHandle hHttpOpenRequest
If hInternetConnect <> 0 Then InternetCloseHandle hInternetConnect
If hInternetSession <> 0 Then InternetCloseHandle hInternetSession
End Sub

Public Property Let QExpiresStr(ByVal vData As String)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.QExpiresStr = 5
   mvarQExpiresStr = vData
End Property


Public Property Get QExpiresStr() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QExpiresStr
   QExpiresStr = mvarQExpiresStr
End Property



Public Property Let QExpires(ByVal vData As Boolean)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.QExpires = 5
   mvarQExpires = vData
End Property


Public Property Get QExpires() As Boolean
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QExpires
   QExpires = mvarQExpires
End Property




Public Property Let QRawHeadersCrLfStr(ByVal vData As String)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.QRawHeadersCrLfStr = 5
   mvarQRawHeadersCrLfStr = vData
End Property


Public Property Get QRawHeadersCrLfStr() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QRawHeadersCrLfStr
   QRawHeadersCrLfStr = mvarQRawHeadersCrLfStr
End Property




Private Sub InicializaCabecerasStr()
mvarQContentLengthStr = ""
mvarQContentTypeStr = ""
mvarQForwardedStr = ""
mvarQLastModifiedStr = ""
mvarQPragmaStr = ""
mvarQRawHeadersStr = ""
mvarQRequestMethodStr = ""
mvarQServerStr = ""
mvarQVersionStr = ""
mvarQRawHeadersCrLfStr = ""
End Sub


Public Property Get QVersionStr() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QVersionStr
   QVersionStr = mvarQVersionStr
End Property





Public Property Get QServerStr() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QServerStr
   QServerStr = mvarQServerStr
End Property





Public Property Get QRequestMethodStr() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QRequestMethodStr
   QRequestMethodStr = mvarQRequestMethodStr
End Property





Public Property Get QRawHeadersStr() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QRawHeadersStr
   QRawHeadersStr = mvarQRawHeadersStr
End Property





Public Property Get QPragmaStr() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QPragmaStr
   QPragmaStr = mvarQPragmaStr
End Property





Public Property Get QLastModifiedStr() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QLastModifiedStr
   QLastModifiedStr = mvarQLastModifiedStr
End Property





Public Property Get QForwardedStr() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QForwardedStr
   QForwardedStr = mvarQForwardedStr
End Property





Public Property Get QContentTypeStr() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QContentTypeStr
   QContentTypeStr = mvarQContentTypeStr
End Property





Public Property Get QContentLengthStr() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QContentLengthStr
   QContentLengthStr = mvarQContentLengthStr
End Property



Public Property Let QPragma(ByVal vData As Boolean)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.QPragma = 5
   mvarQPragma = vData
End Property


Public Property Get QPragma() As Boolean
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QPragma
   QPragma = mvarQPragma
End Property



Public Property Let QRequestMethod(ByVal vData As Boolean)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.QRequestMethod = 5
   mvarQRequestMethod = vData
End Property


Public Property Get QRequestMethod() As Boolean
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QRequestMethod
   QRequestMethod = mvarQRequestMethod
End Property



Public Property Let QServer(ByVal vData As Boolean)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.QServer = 5
   mvarQServer = vData
End Property


Public Property Get QServer() As Boolean
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QServer
   QServer = mvarQServer
End Property



Public Property Let QForwarded(ByVal vData As Boolean)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.QForwarded = 5
   mvarQForwarded = vData
End Property


Public Property Get QForwarded() As Boolean
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QForwarded
   QForwarded = mvarQForwarded
End Property



Public Property Let QRawHeadersCrLf(ByVal vData As Boolean)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.QRawHeadersCrLf = 5
   mvarQRawHeadersCrLf = vData
End Property


Public Property Get QRawHeadersCrLf() As Boolean
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QRawHeadersCrLf
   QRawHeadersCrLf = mvarQRawHeadersCrLf
End Property



Public Property Let QRawHeaders(ByVal vData As Boolean)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.QRawHeaders = 5
   mvarQRawHeaders = vData
End Property


Public Property Get QRawHeaders() As Boolean
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QRawHeaders
   QRawHeaders = mvarQRawHeaders
End Property



Public Property Let QVersion(ByVal vData As Boolean)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.QVersion = 5
   mvarQVersion = vData
End Property


Public Property Get QVersion() As Boolean
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QVersion
   QVersion = mvarQVersion
End Property



Public Property Let QLastModified(ByVal vData As Boolean)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.QLastModified = 5
   mvarQLastModified = vData
End Property


Public Property Get QLastModified() As Boolean
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QLastModified
   QLastModified = mvarQLastModified
End Property



Public Property Let QContentLength(ByVal vData As Boolean)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.QContentLength = 5
   mvarQContentLength = vData
End Property


Public Property Get QContentLength() As Boolean
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QContentLength
   QContentLength = mvarQContentLength
End Property



Public Property Let QContentType(ByVal vData As Boolean)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.QContentType = 5
   mvarQContentType = vData
End Property


Public Property Get QContentType() As Boolean
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.QContentType
   QContentType = mvarQContentType
End Property



Public Sub Descargar(Optional TipoAccion As jrDownTipoAccion = jrDownDescargar)
Dim BytesTotales As Long, BytesRecibidos As Long, BytesRecibidosTotales As Long, Porcentaje As Double
Dim sBuffer As String, Res As Integer, UsarPuerto As Long, NumBloques As Long
Dim FileName As String, Fich As Long, Contenido As String, aux As String
Dim Cancelar As Boolean
Dim TiempoTranscurrido As Long, TiempoRestante As Double, TiempoInicio As Long, BytesSegundo As Double

On Error Resume Next

Dim ChunkSize As Long

ChunkSize = mvarBytesBloqueDescarga

'inicializo propiedades
InicializaCabecerasStr
mvarHuboError = False
mvarStatusCode = ""
mvarStatusText = ""
mvarContenidoDescargado = ""
Cancelar = False

'compruebo que la URL esté introdocida y sea sintácticamente correcta
URLCorrecta = ProcesaURL()
If Not URLCorrecta Then
   mvarHuboError = True
   Exit Sub
End If
'Creo buffer para recibir el fichero
sBuffer = Space(ChunkSize)
'Creo una conexión a internet
If TipoConexion = INTERNET_OPEN_TYPE_PROXY Then
   hInternetSession = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PROXY, mvarUsarProxy, mvarNoUsarProxy, 0)
Else
   hInternetSession = InternetOpen(scUserAgent, TipoConexion, vbNullString, vbNullString, 0)
End If
If hInternetSession = 0 Then
   ProcesaError ERROR_INTERNETOPEN
   Exit Sub
End If
'me conecto con el servidor
UsarPuerto = Puerto
hInternetConnect = InternetConnect(hInternetSession, Servidor, UsarPuerto, mvarUsuario, mvarPassword, Servicio, 0, 0)
If hInternetConnect = 0 Then
   ProcesaError ERROR_INTERNETCONNECT
   Exit Sub
End If
'abro una petición para el fichero solicitado
hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "GET", Objeto, "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
If hHttpOpenRequest = 0 Then
   ProcesaError ERROR_INTERNETOPENREQUEST
   Exit Sub
End If
'envío la petición
Res = HttpSendRequest(hHttpOpenRequest, vbNullString, 0, 0, 0)
If Res = 0 Then
   ProcesaError ERROR_INTERNETSENDREQUEST
   Exit Sub
End If
'miro la cabecera para ver si el fichero existe
If GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_STATUS_TEXT, sBuffer) Then
   mvarStatusText = sBuffer
Else
   ProcesaError ERROR_INTERNETQUERYINFO
   Exit Sub
End If
If GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_STATUS_CODE, sBuffer) Then
   mvarStatusCode = sBuffer
   If left(sBuffer, 1) <> "2" Then
       ProcesaError CLng(mvarStatusCode)
       Exit Sub
   End If
Else
   ProcesaError ERROR_INTERNETQUERYINFO
   Exit Sub
End If
'miro la longitud del contenido a descargar
If GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_CONTENT_LENGTH, sBuffer) Then
   If IsNumeric(sBuffer) Then
       BytesTotales = CLng(sBuffer)
   Else
       BytesTotales = -1
   End If
   If mvarQContentLength Then mvarQContentLengthStr = sBuffer
Else
   BytesTotales = -1
End If
'busco el resto de valores de la cabecera, si lo ha solicitado el usuario
If mvarQContentType Then
   If GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_CONTENT_TYPE, sBuffer) Then mvarQContentTypeStr = sBuffer
End If
If mvarQExpires Then
   If GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_EXPIRES, sBuffer) Then mvarQExpiresStr = sBuffer
End If
If mvarQLastModified Then
   If GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_LAST_MODIFIED, sBuffer) Then mvarQLastModifiedStr = sBuffer
End If
If mvarQPragma Then
   If GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_PRAGMA + HTTP_QUERY_FLAG_REQUEST_HEADERS, sBuffer) Then mvarQPragmaStr = sBuffer
End If
If mvarQVersion Then
   If GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_VERSION, sBuffer) Then mvarQVersionStr = sBuffer
End If
If mvarQRawHeaders Then
   If GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_RAW_HEADERS, sBuffer) Then mvarQRawHeadersStr = sBuffer
End If
If mvarQRawHeadersCrLf Then
   If GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_RAW_HEADERS_CRLF, sBuffer) Then mvarQRawHeadersCrLfStr = sBuffer
End If
If mvarQForwarded Then
   If GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_FORWARDED, sBuffer) Then mvarQForwardedStr = sBuffer
End If
If mvarQServer Then
   If GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_SERVER, sBuffer) Then mvarQServerStr = sBuffer
End If
If mvarQRequestMethod Then
   If GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_FLAG_REQUEST_HEADERS + HTTP_QUERY_REQUEST_METHOD, sBuffer) Then mvarQRequestMethodStr = sBuffer
End If
'si sólo queríamos información del archivo, ya acabamos
If TipoAccion = jrDownSoloInformacion Then
   CierraConexiones
   Exit Sub
End If
'si tengo que grabar un fichero
If mvarFichero <> "" Then
   'obtengo un nombre de fichero temporal para guardar lo que descargue
   FileName = Space(260)
   GetTempFileName DameDirectorio(mvarFichero), "jrD", 0, FileName
   FileName = left(FileName, InStr(FileName, Chr$(0)) - 1)
   'abro el fichero
   Fich = FreeFile()
   Open FileName For Binary As Fich
Else
   'si conozco la longitud del archivo dimensiono el string porque se gana mucho en velocidad
   If BytesTotales <> -1 Then mvarContenidoDescargado = Space(BytesTotales)
End If
'leo el archivo de internet
'inicio el contador de tiempo
TiempoInicio = GetTickCount()
'inicio los bytes recibidos y el espacio a leer de cada vez
BytesRecibidosTotales = 0
Res = 1: BytesRecibidos = ChunkSize
sBuffer = Space(ChunkSize): NumBloques = 0
While Res <> 0 And BytesRecibidos <> 0 And Not Cancelar
   Res = InternetReadFile(hHttpOpenRequest, sBuffer, ChunkSize, BytesRecibidos)
   If Res = 0 Then
       mvarStatusText = LastSystemError()
       mvarStatusCode = "999"
   Else
       If BytesRecibidos > 0 Then
           aux = left(sBuffer, BytesRecibidos)
           'si estoy grabando un fichero...
           If mvarFichero <> "" Then
               Put Fich, , aux
           Else
               'si conozco el tamaño del archivo
               If BytesTotales <> -1 Then
                   Mid(mvarContenidoDescargado, (NumBloques * ChunkSize) + 1, BytesRecibidos) = aux
                   NumBloques = NumBloques + 1
               Else
                   mvarContenidoDescargado = mvarContenidoDescargado + aux
               End If
           End If
           BytesRecibidosTotales = BytesRecibidosTotales + BytesRecibidos
           TiempoTranscurrido = GetTickCount() - TiempoInicio
           BytesSegundo = BytesRecibidosTotales / (TiempoTranscurrido / 1000)
           'calcular el porcentaje descargado y lanzar el evento progreso
           If BytesTotales <> -1 Then
               Porcentaje = (BytesRecibidosTotales * 100) / BytesTotales
               TiempoRestante = (BytesTotales / BytesSegundo) - (TiempoTranscurrido / 1000)
           Else
               Porcentaje = 0
               TiempoRestante = 0
           End If
           If TiempoRestante < 0 Then TiempoRestante = 0
           'RaiseEvent Progreso(BytesTotales, BytesRecibidosTotales, Porcentaje, CLng(TiempoTranscurrido / 1000), CLng(TiempoRestante), CLng(BytesSegundo), Cancelar)
           DoEvents
       End If
   End If
Wend
'cierro el fichero
If mvarFichero <> "" Then Close Fich
'si el usuario canceló borro el fichero
If Cancelar Then
   If mvarFichero <> "" Then
       If Dir(FileName) <> "" Then Kill FileName
   End If
   ProcesaError ERROR_CANCELADO
   Exit Sub
Else
   'si acabó por un error borro el fichero (dejo la variable por si el contenido sirviera para algo)
   If Res = 0 Then
       If mvarFichero <> "" Then
           If Dir(FileName) <> "" Then Kill FileName
       End If
       ProcesaError ERROR_DESCARGA
       Exit Sub
   Else
       'cambio el nombre al fichero
       If mvarFichero <> "" Then
           If Dir(mvarFichero) <> "" Then Kill mvarFichero
       End If
       Name FileName As mvarFichero
   End If
End If
CierraConexiones
End Sub

Private Function DameDirectorio(Archivo As String) As String
Dim i As Long

'busco la última barra
i = InStrRev(Archivo, "\")
If i = 0 Then
   DameDirectorio = CurDir()
Else
   DameDirectorio = left(Archivo, i - 1)
End If
End Function

Private Function GetQueryInfo(ByVal hHttpRequest As Long, ByVal iInfoLevel As Long, Valor As String) As Boolean
Dim sBuffer As String * 1024, lBufferLength As Long

lBufferLength = Len(sBuffer)
GetQueryInfo = CBool(HttpQueryInfo(hHttpRequest, iInfoLevel, ByVal sBuffer, lBufferLength, 0))
lBufferLength = InStr(sBuffer, Chr(0))
Valor = left(sBuffer, lBufferLength - 1)
End Function



Public Property Let Puerto(ByVal vData As Long)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.Puerto = 5
   mvarPuerto = vData
End Property


Public Property Get Puerto() As Long
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.Puerto
If mvarPuerto = 0 Then
   Select Case Protocolo
       Case "http": Puerto = INTERNET_DEFAULT_HTTP_PORT
       Case "https": Puerto = INTERNET_DEFAULT_HTTPS_PORT
   End Select
Else
   Puerto = mvarPuerto
End If
End Property






Public Property Get ContenidoDescargado() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.ContenidoDescargado
   ContenidoDescargado = mvarContenidoDescargado
End Property



Public Property Let Fichero(ByVal vData As String)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.Fichero = 5
   mvarFichero = vData
End Property


Public Property Get Fichero() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.Fichero
   Fichero = Trim(mvarFichero)
End Property



Public Property Let Password(ByVal vData As String)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.Password = 5
   mvarPassword = vData
End Property


Public Property Get Password() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.Password
   Password = mvarPassword
End Property



Public Property Let Usuario(ByVal vData As String)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.Usuario = 5
   mvarUsuario = vData
End Property


Public Property Get Usuario() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.Usuario
   Usuario = mvarUsuario
End Property




Public Property Let NoUsarProxy(ByVal vData As String)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.NoUsarProxy = 5
   mvarNoUsarProxy = vData
   If mvarUsarProxy = "" And mvarNoUsarProxy = "" Then
       TipoConexion = INTERNET_OPEN_TYPE_PRECONFIG
   Else
       TipoConexion = INTERNET_OPEN_TYPE_PROXY
   End If
End Property


Public Property Get NoUsarProxy() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.NoUsarProxy
   NoUsarProxy = mvarNoUsarProxy
End Property



Public Property Let UsarProxy(ByVal vData As String)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.UsarProxy = 5
   mvarUsarProxy = vData
   If mvarUsarProxy = "" And mvarNoUsarProxy = "" Then
       TipoConexion = INTERNET_OPEN_TYPE_PRECONFIG
   Else
       TipoConexion = INTERNET_OPEN_TYPE_PROXY
   End If

End Property


Public Property Get UsarProxy() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.UsarProxy
   UsarProxy = mvarUsarProxy
End Property




Private Sub ProcesaError(Numero As Long)

mvarStatusCode = Format(Numero, "000")

Select Case Numero
   Case ERROR_URL: mvarStatusText = "URL incorrecta."
   Case ERROR_INTERNETOPEN: mvarStatusText = "Error en InternetOpen."
   Case ERROR_INTERNETCONNECT: mvarStatusText = "Error en InternetConnect."
   Case ERROR_INTERNETOPENREQUEST: mvarStatusText = "Error en InternetOpenRequest."
   Case ERROR_INTERNETSENDREQUEST: mvarStatusText = "Error en InternetSendRequest."
   Case ERROR_INTERNETQUERYINFO: mvarStatusText = "Error en InternetQueryInfo."
   Case ERROR_INTERNETREADFILE: mvarStatusText = "Error en InternetReadFile."
   Case ERROR_FICHERO: mvarStatusText = "No se ha podido crear el fichero de destino."
   Case ERROR_DESCARGA: mvarStatusText = "Ha ocurrido un error durante la descarga."
   Case ERROR_CANCELADO: mvarStatusText = "Descarga cancelada por el usuario."
End Select
CierraConexiones
mvarHuboError = True
End Sub

Public Property Get StatusText() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.StatusText
   StatusText = mvarStatusText
End Property





Public Property Get StatusCode() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.StatusCode
   StatusCode = mvarStatusCode
End Property





Public Property Get HuboError() As Boolean
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.HuboError
   HuboError = mvarHuboError
End Property



Public Property Let URL(ByVal vData As String)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.URL = 5
Dim i As Long, j As Long

mvarURL = vData
URLCorrecta = ProcesaURL()
       
End Property

Public Property Get URL() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.URL
   URL = mvarURL
End Property



Private Function ProcesaURL() As Boolean
Dim i As Long, j As Long

On Error GoTo ProcesaURL_Err

ProcesaURL = False
'descomponemos la url en protocolo, servidor y objeto
'busco el protocolo
i = InStr(mvarURL, "://")
If i = 0 Then
   'si no existe asumimos que es http
   Protocolo = "http"
   i = 1
Else
   Protocolo = LCase(Mid(mvarURL, 1, i - 1))
   i = i + 3
End If
'sólo permitimos http
Select Case Protocolo
   Case "http":
   Case "https":
   Case Else: ProcesaError ERROR_URL
End Select
'busco el servidor
j = InStr(i, mvarURL, "/")
If j = 0 Then j = Len(mvarURL) + 1
Servidor = Mid(mvarURL, i, j - i)
i = j + 1
'busco el objeto a descargar
If i > Len(mvarURL) Then
   Objeto = vbNullString
Else
   Objeto = "/" & Mid(mvarURL, i)
End If
ProcesaURL = True

ProcesaURL_End:
   Exit Function

ProcesaURL_Err:
   ProcesaError ERROR_URL
   Resume ProcesaURL_End

End Function

Private Sub Class_Initialize()
TipoConexion = INTERNET_OPEN_TYPE_PRECONFIG
mvarQContentLength = True
Servicio = INTERNET_SERVICE_HTTP
mvarBytesBloqueDescarga = 512
End Sub


Private Sub Class_Terminate()
CierraConexiones
End Sub


¿Alguien podría darme alguna idea? Si existe otra forma de hacer las múltiples descargas con este módulo, etc...

Saludos, y gracias de antemano.

LeandroA

Hola a como yo lo veo es imposible hacer lo que queres, cuando trabajas con bucles cortas todo tipo de hilo, y que es lo que hace visual basic en ese sentido, recorre un solo camino. vos podes poner a descargar 3 archivos, pero que es lo que pasa

suponete que le das tres click seguidos al boton, todo bien comienzan las tres descargas pero en realidad primero descargara es la ultima, luego la penultima y por ultimo la primera, es como que lleva a puntero a la clase  que se llamo ultimo

una solucion algo fea es poder remplazar este bucle
While Res <> 0 And pBytesRecibidos <> 0 And Not Cancelar
por algun pulso de un timer, pero no es lo mas efeciente.

te preguntars porque con el metodo que use yo funciona, sensillamente porque la clase no intenta leer datos, sino los datos le llegan a este (AddressOf)

te lo digo por experiencia yo renegue mucho con este tema utilizando winsock.ocx

Consejo: las apis wininet no te van a servir para esto.

Saludos

aaronduran2

Vale, muchas gracias por los consejos. Intentaré modificarlo, pero sino no pasa nada.

Gracias y saludos  ;)

HaX991

Cita de: aaronduran2 en 19 Agosto 2009, 23:30 PM
aaronduran2 lo k intentas acer (multiple downloader) si es posible hacerlo solo tienes k adaptar el codigo en un modulo de clase y crear un array como l k ace la clase cSocketPlus pues igual.