mira espero q te sirva, yo lo utilizo para enviar a un sitio y lo mismo se hace para tomar de ese sitio
nota el sitio debe de tener un directorio compartido en el cual puedas depositar o estraer info ok.
a mi me lo envio un chico de iran, regreso el favor, suerte!!!
Nota ya te lo de mas depurado heeeeee
Private Sub TransferFTP()
vm_ErrorFTP = False
ConectaFTP
If vm_ErrorFTP = False Then EnvioFTP
If vm_ErrorFTP = False Then DesconectaFTP
End Sub
Private Sub ConectaFTP()
StatusBar.Panels(1).Text = "Conectandose con Matriz..."
Inet1.Protocol = icFTP
Inet1.URL = vm_URL
Inet1.UserName = vm_Username
Inet1.Password = vm_Password
' if you change the order of assigning the URL,
' USERNAME,PASSWORD this will cause an error
' Donot change the order
'frmInet.Inet1.Execute , "DIR"
Exec "DIR"
End Sub
Private Sub EnvioFTP()
If vm_TransFac Then
StatusBar.Panels(1).Text = "Transmitiendo tabla: " & vm_Dbf(0) & ".DBF..."
UploadFTP vm_DirUpLoad & "\" & vm_Dbf(0) & ".DBF", vm_DirRemote
StatusBar.Panels(1).Text = "Transmitiendo tabla: " & vm_Dbf(1) & ".DBF..."
UploadFTP vm_DirUpLoad & "\" & vm_Dbf(1) & ".DBF", vm_DirRemote
End If
If vm_TransCli Then
StatusBar.Panels(1).Text = "Transmitiendo tabla: " & vm_Dbf(2) & ".DBF..."
UploadFTP vm_DirUpLoad & "\" & vm_Dbf(2) & ".DBF", vm_DirRemote
End If
If vm_TransTarif Then
StatusBar.Panels(1).Text = "Transmitiendo tabla: " & vm_Dbf(3) & ".DBF..."
UploadFTP vm_DirUpLoad & "\" & vm_Dbf(3) & ".DBF", vm_DirRemote
End If
If vm_TransRutas Then
StatusBar.Panels(1).Text = "Transmitiendo tabla: " & vm_Dbf(4) & ".DBF..."
UploadFTP vm_DirUpLoad & "\" & vm_Dbf(4) & ".DBF", vm_DirRemote
End If
End Sub
Function UploadFTP(vl_FileLocal As String, vm_DirRemote As String)
Dim Shortname As String
If Not ExisFile(vl_FileLocal) Then
txtlog.Text = "No Existe el archivo: " + vl_FileLocal + vbNewLine + txtlog.Text
Exit Function
End If
If Inet1.StillExecuting Then Exit Function
Shortname = Fsys.GetFile(vl_FileLocal).Shortname ' getting the short path of the filename
Exec "PUT " & vl_FileLocal & " " & vm_DirRemote & Shortname
End Function
Function Exec(Oper As String)
On Error GoTo handler
If Inet1.StillExecuting Then Exit Function
Inet1.Execute , Oper
Do While Inet1.StillExecuting ' This will wait until the inet execution completes
DoEvents
Loop
' In FTP operations through inet we are concerned with
' Execute Method of inet
' Inet1.execute Url,Operation,InputData,InputHdrs
' Dont panic with Execute statement we are only
' concerned with the Operation parameter of the execute
' method of inet
' basic syntaxes of inet FTP operations are:
' inet1.execute ,"PUT localfilename remotefilename" ' this is for Uploading
' inet1.execute ,"GET remotefilename localfilename" ' this is for downloading
' inet1.execute ,"DIR" 'for the directory
' inet1.execute ,"CD dirname" ' for changing DIrectory
' inet1.execute ,"MKDIR newdir" ' for creating Directory
' inet1.execute ,"RMDIR dirname" ' for removing the directory
' inet1.execute ,"RENAME filename newfilename" ' for renaming the files
' inet1.execute ,"DELETE filename" ' for deleting files
' inet1.execute ,"CDUP" ' for levelup
' inet1.execute ,"CLOSE" ' for closing the connection
' See how easy the FTP operations through inet are
' only one thing that is to be noticed is that
' the localfilename/remotefilename/newdir/dirname/filename
' /newfilename they must not have spaces in between them
' EXAMPLE:
' inet1.execute ,"PUT C:\my documents\mypic.jpg mypic.jpg" ' this execution makes an error due to space in localfilename
' inet1.execute ,"PUT c:\mydocu~1\mypic.jpg mypic.jpg" ' this execution will not make any error because localfilename havent got any space
' inet1.execute ,"MKDIR new dir" ' this execution makes an error
' inet1.execute ,"MKDIR newdir" ' this execution is OK
' see how easy with inet control FTP operations are
' if we take care of the execute statement
' a single activex can handle all your FTP Uploading easy
' Email:
[email protected]
' Web: www.farooq.5u.com
Pause 1000
If f = True Then
f = False
DIR
'Inet1.Execute , "DIR"
'Do While Inet1.StillExecuting ' This will wait until the inet execution completes
'DoEvents
'Loop
End If
Exit Function
handler:
txtlog.Text = Err.Description + vbNewLine + txtlog.Text
vm_ErrorFTP = True
End Function
Function DIR()
If Inet1.StillExecuting Then Exit Function
Exec "DIR"
End Function
Function DesconectaFTP()
If Inet1.StillExecuting Then Exit Function
Exec "CLOSE"
End Function
Sub Pause(HowLong As Long)
Dim u%, tick As Long
tick = GetTickCount()
Do
u% = DoEvents
Loop Until tick + HowLong < GetTickCount
End Sub
Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim data1 As String, data2 As String
Dim Label1 As String
Select Case State
Case 0
Label1 = " "
Case 1
Label1 = "Buscando Host..."
Case 2
Label1 = "Host Encontrado..."
Case 3
Label1 = "Conectando..."
Case 4
Label1 = "En Linea..."
Case 5
Label1 = "Requesting"
Case 6
Label1 = "Request Sent"
Case 7
Label1 = "Recieviendo Respuesta..."
Case 8
Label1 = "Respuesta Devuelta..."
Case 9
Label1 = "Desconectando..."
Case 10
Label1 = "Fuera de linea..."
Case 11
Label1 = "No se realizó la conexión. " & IIf(Err.Number > 0, Err.Description & " Error No.:" & Err.Number, " ")
Case 12
Label1 = "Transferencia Completa..."
Dim col As New Collection
Do While True
'Change datatype to icByteArray to receive data in binary
data1 = Inet1.GetChunk(512, icString)
If Len(data1) = 0 Then Exit Do
DoEvents 'Transfer control to operating system
data2 = data2 & data1
Loop
' TotalData = data2 ' the Totaldata Contains All the directories u can also programe Text1.Text=TotalData for viewing Directories
' AddNamesToList data2, List1
' List1.AddItem data2
' txtDir.Text = data2
End Select
txtlog.Text = Label1 + vbNewLine + txtlog.Text
End Sub
