OTra vez molestandolos... :rolleyes:
Tengo el siguiente... codigo la funcion es para descargar usando un command button , 1 progressbar y un label para el porcentaje de la descarga y un control inet , pero mi problema es en la siguiente linea:
CitarOpen App.Path + "\WarezP2P_DLC.exe" For Binary Access Write As #1
por defecto lo guarda en la ruta donde esta el programa.. como hacer para que guarde.. por ejemplo en :
CitarC:\WarezP2P_DLC.exe
el codigo es este:
Citar
Private Sub Command1_Click()
ProgressBar1.Value = 0
Inet1.AccessType = icUseDefault
Inet1.URL = "http://download.warezclient.com/WarezP2P_DLC.exe"
Inet1.Execute , "GET" 'Indicamos que vamos a descargar o recuperar un _
archivo desde una url
End Sub
Private Sub Form_Load()
End Sub
Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim vtData As Variant 'acá almacenamos los datos
Select Case State
Case icResponseCompleted
Dim bDone As Boolean: bDone = False
Dim tempArray() As Byte ' Un array para grabar los datos en un archivo
'Para saber el tamaño del fichero en bytes
filesize = Inet1.GetHeader("Content-length")
'Establecemos el Max del = a al tamaño del archivo
ProgressBar1.Max = filesize
contenttype = Inet1.GetHeader("Content-type")
'Creamos y abrimos un nuevo archivo en modo binario
Open App.Path + "\WarezP2P_DLC.exe" For Binary Access Write As #1
' Leemos de a 1 Kbytes. El segundo parámetro indica _
el tipo de fichero. Tipo texto o tipo Binario, en este caso _
binario
vtData = Inet1.GetChunk(1024, icByteArray)
DoEvents
'Si el tamaño del fichero es 0 ponemos bDone en True para que no _
entre en el bucle
If Len(vtData) = 0 Then
bDone = True
End If
Do While Not bDone
'Almacenamos en un array el contenido del archivo
tempArray = vtData
'Escribimos el archivo en disco
Put #1, , tempArray
'Aumentamos la barra
ProgressBar1.Value = ProgressBar1.Value + Len(vtData) * 2
' Leemos de pedazos de a 1 kb (1024 bytes)
vtData = Inet1.GetChunk(1024, icByteArray)
DoEvents
Label1 = CLng((ProgressBar1.Value * 100) / ProgressBar1.Max) & " %"
If Len(vtData) = 0 Then
bDone = True
End If
Loop
Close #1
ProgressBar1.Value = 0
End Select
End Sub
un gracias de antemano por leer el mensaje..
recomiendo leer un manual de visual basic...
Open "C:\WarezP2P_DLC.exe" For Binary Access Write As #1
eso si quieres que la ruta de descarga sea fija ... pero si quisieras cambiarlo podrias usar el codigo siguiente, usando un boton para poder llamar al cuadro de buscar una carpeta y poner la ruta selecionada en un textbox:
' Estructura BrowseInfo requerida para el Api SHBrowseForFolder
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
' Constantes
Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260 ' Para Buffer de caracteres del path
' Funcion Api CoTaskMemFree
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
' Funcion Api CoTaskMemFree lstrcat
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" ( _
ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
' Funcion Api SHBrowseForFolder
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
' Funcion Api SHGetPathFromIDList
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList _
As Long, ByVal lpBuffer As String) As Long
Private Sub Command1_Click()
Dim Ret As Long
Dim sPath As String
Dim tBI As BrowseInfo
With tBI
.hWndOwner = Me.hwnd
.lpszTitle = lstrcat("Selecione una carpeta", "")
.ulFlags = BIF_RETURNONLYFSDIRS Or 64
End With
'Mostrar el cuadro de dialogo Buscar carpeta
Ret = SHBrowseForFolder(tBI)
If Ret Then
sPath = String$(MAX_PATH, 0)
Call SHGetPathFromIDList(Ret, sPath)
Call CoTaskMemFree(Ret)
Dim pos As Long
pos = InStr(sPath, vbNullChar)
If pos Then
sPath = Left$(sPath, pos - 1)
End If
End If
'Mostramos el Path elegido en el textbox
Text1.Text = sPath
End Sub