2009-02-11 27 views
5

Quiero descargar varios archivos (principalmente imágenes) de la aplicación VB6. Actualmente estoy usando URLDownloadToFile pero solo permite un archivo a la vez y no hay una barra de progreso. Quiero descargar varios archivos y con la barra de progreso. por favor ayuda. gracias por adelantado.¿Cómo descargar varios archivos en VB6 con barra de progreso?

mi código actual:

Dim lngRetVal As Long 
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0) 
If lngRetVal = 0 Then DownloadFile = True 

Respuesta

2

que usted está esperando una respuesta de VB, pero esto es no trivial.

La mayor parte de la siguiente proviene de http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_20571958.html

interfaz IBindStatusCallback no es directamente accesible desde VB. Debe introducirse en una biblioteca compatible de tipo .

se puede encontrar el tipo de biblioteca OLELIB.TLB en: http://www.domaindlx.com/e_morcillo/scripts/type/default.asp El nombre del archivo zip para descargar es: tl_ole.zip

También encontrará ejemplos de cómo usarlo incluido. No estoy seguro de si encontrará un ejemplo específico en IBindStatusCallback en no, pero es vale la pena intentarlo.

Usted puede escribir su propia función para obtener los datos en una cadena, que le dará un control total sobre todas las cosas:

Option Explicit 

Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0 
Public Const INTERNET_DEFAULT_HTTP_PORT = 80 
Public Const INTERNET_SERVICE_HTTP = 3 
Public Const INTERNET_FLAG_RELOAD = &H80000000 
Public Const HTTP_QUERY_STATUS_CODE = 19 
Public Const HTTP_ADDREQ_FLAG_ADD = &H20000000 

Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long 
Public Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession 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 
Public 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 
Public Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Long 
Public 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 Long 
Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer 
Public Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lModifiers As Long) As Integer 
Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumberOfBytesToRead As Long, lNumberOfBytesRead As Long) As Integer 
Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternet&, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength&, ByVal dwFlags&, ByVal dwContext&) As Long 
Public Declare Function InternetQueryDataAvailable Lib "wininet.dll" (ByVal hFile As Long, lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long 

Public Function GetHTML(strURL As String) As String 
Const BufferSize = 16384 
Dim hSession&, hURL&, lRet&, lBytesAvail& 
Dim Buffer As String * BufferSize 
Dim BufferLen&, sResult$ 
    hSession = InternetOpen(vbNullString, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0) 
    hURL = InternetOpenUrl(hSession, strURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&) 
    sResult = "" 
    Do 
     InternetReadFile hURL, Buffer, Len(Buffer), BufferLen 
     If BufferLen > 0 Then sResult = sResult & Left(Buffer, BufferLen) 
    Loop Until BufferLen = 0 
    GetHTML = sResult 
    InternetCloseHandle hURL 
    InternetCloseHandle hSession 
End Function 

Encontrará recursos adicionales para hacer el método de devolución de llamada aquí (se desplaza hacia abajo a la parte inferior):

http://www.experts-exchange.com/Programming/Languages/.NET/Visual_Basic.NET/Q_21763861.html

http://www.experts-exchange.com/Programming/Languages/.NET/Visual_Basic.NET/Q_21746456.html

Pero, sinceramente, creo que será mejor que haga su propia función de descarga si desea tener más control sobre ella. Lo de TCP/IP en VB es realmente muy fácil.

-Adam

+0

En realidad, es bastante simple en VB6, no es necesario realizar llamadas a la API. Ver mi respuesta – MarkJ

+0

Sí, soy el único votante en su respuesta. –

+0

Acabo de volver aquí - gracias por el voto positivo de Adam. – MarkJ

4

usted quiere descargar el archivo de forma asíncrona, por lo que su código VB continúa ejecutando mientras que la descarga se produce. Hay es una forma poco conocida de hacer esto con VB6 nativo, utilizando el método AsyncRead de los objetos UserControl y UserDocument, sin necesidad de llamadas API.

Aquí hay una excelente explanation and VB6 code for multiple simultaneous downloads, del reconocido gurú VB6 Karl Peterson. El evento AsyncReadProgress le ofrece BytesRead y BytesMax, que le permitirán mostrar una barra de progreso.

+0

vb.mvps.org parece estar fuera de línea. ¿Alguna idea de dónde están los proyectos de Karl ahora? Me encantaría ver el ejemplo completo si puedo encontrarlo en cualquier lugar. – Jeff

+1

Parecen estar aquí http://test.epeterson.net. No sé si esto es algo permanente. – MarkJ

+0

Parece que faltan todos los proyectos de muestra, aunque se enumeran en http://test.epeterson.net/samples/ – Jeff

Cuestiones relacionadas