Duda problema para guardar archivo

Iniciado por musicaward, 18 Enero 2009, 23:41 PM

0 Miembros y 1 Visitante están viendo este tema.

musicaward

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..

seba123neo

recomiendo leer un manual de visual basic...

Código (vb) [Seleccionar]
Open "C:\WarezP2P_DLC.exe" For Binary Access Write As #1
La característica extraordinaria de las leyes de la física es que se aplican en todos lados, sea que tú elijas o no creer en ellas. Lo bueno de las ciencias es que siempre tienen la verdad, quieras creerla o no.

Neil deGrasse Tyson

byway

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:


Código (vb) [Seleccionar]

' 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