Página 1 de 1

[Solucionado] Subir un .txt a una FTP sin OCX ni modulos

Publicado: 01 Sep 2009, 01:06
por Mr.White
Hola amigo anteriormenteise un post donde pedia ayuda para subir un txt a una FTP pero ya lo solucione kisiera dar gracias a Skyweb por pasarme un modulo pero lo veia mas complicado este metodo que encontre es mucho mas facil

Crear:
*3 commandbutton
*1 Label1
*1 Text1 con la propiedad Multiline = True

bueno sin mas que decir aca les dejo el code espero q les ayude como me ayudo ami

Código: Seleccionar todo

Dim hOpen As Long, hConnection As Long, bRet As Long, Refrescar As Boolean
Option Explicit
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
 ByVal lpszRemoteFile As String, _
 ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
 
 
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 Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
 (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
' Initializes an application's use of the Win32 Internet functions
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

' User agent constant.
Private Const scUserAgent = "vb wininet"

' Use registry access settings.
Private Const INTERNET_INVALID_PORT_NUMBER = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
Private Const INTERNET_FLAG_PASSIVE = &H8000000

' Opens a HTTP session for a given site.
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
   
' Number of the TCP/IP port on the server to connect to.
Private Const INTERNET_OPTION_USERNAME = 28
Private Const INTERNET_OPTION_PASSWORD = 29
Private Const INTERNET_OPTION_PROXY_USERNAME = 43
Private Const INTERNET_FLAG_RELOAD = &H80000000
' Type of service to access.
Private Const INTERNET_SERVICE_FTP = 1

' Closes a single Internet handle or a subtree of Internet handles.
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer


Sub Command1_Click()
'Guardamos en App.Path & "\" & "Prueva.txt"
Close #1
Open App.Path & "\" & "Prueva.txt" For Output As #1
Print #1, Text1.Text
Close #1
Info "Guardando en el servidor..."
'App.Path & "\" & "Prueva.txt" es el archivo selecionado y Prueva.txt es el nombre con que lo guardamos
bRet = FtpPutFile(hConnection, App.Path & "\" & "Prueva.txt", "Prueva.txt", FTP_TRANSFER_TYPE_ASCII, 0)
If bRet <> 0 Then Info "Proceso terminado corectamente" Else Info "Error": Exit Sub
End Sub
Sub Info(Mensage As String)
Label1.Caption = Mensage
Label1.Refresh
End Sub
Sub Command2_Click()
Dim file_data As String
Info "Descargando..."
bRet = FtpGetFile(hConnection, "Prueva.txt", App.Path & "\" & "Prueva.txt", False, _
 INTERNET_FLAG_RELOAD, FTP_TRANSFER_TYPE_ASCII, 0)
If bRet <> 0 Then Info "Archivo descargado correctamente" Else Info "Error": Exit Sub
Text1.Text = ""
Close #1
Open App.Path & "\" & "Prueva.txt" For Input As #1
While Not EOF(1)
Line Input #1, file_data
Text1.Text = Text1.Text & file_data & vbCrLf
Wend
Close #1
End Sub

Private Sub Command3_Click()
If Command3.Caption = "Conectar" Then
Conectar
Else
If hConnection <> 0 Then InternetCloseHandle (hConnection)
Command3.Caption = "Conectar"
Command1.Enabled = False
Command2.Enabled = False
Info "Coneción cerrada"
End If
End Sub

Sub Form_Load()
Text1.Text = ""
Command1.Caption = "Subir al Servidor"
Command2.Caption = "Descargar del Servidor"
Command3.Caption = "Conectar"
Command1.Enabled = False
Command2.Enabled = False
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If hOpen <> 0 Then Info "Iniciado correctamente" Else Info "Error"
Me.Caption = "http://www.indetectables.net"
End Sub

Sub Form_Unload(Cancel As Integer)
If hConnection <> 0 Then InternetCloseHandle (hConnection)
If hOpen <> 0 Then InternetCloseHandle (hOpen)
End Sub

Sub Conectar()
Dim Servevidor As String, Usuario As String, Contraseña As String, Carpeta As String
'----------------------------------------
Servevidor = "Aqui la FTP de tu host"
Usuario = "Aqui tu USERNAME"
Contraseña = "Aqui tu password"
Carpeta = "/includes"
'----------------------------------------
Info "Conectando..."
'hacemos la conexion
hConnection = InternetConnect(hOpen, Servevidor, INTERNET_INVALID_PORT_NUMBER, _
Usuario, Contraseña, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
If hConnection <> 0 Then Info "Buscando Directorio" Else Info "Error": Exit Sub
'selecionamos "/includes" que es la carpeta en el servidor donde guardo el archivo
bRet = FtpSetCurrentDirectory(hConnection, Carpeta)
If bRet <> 0 Then Info "Coneccion exitosa!!!" Else Info "Error": Exit Sub
Command1.Enabled = True
Command2.Enabled = True
Command3.Caption = "Desconectar"
End Sub

Re: [Solucionado] Subir un .txt a una FTP sin OCX ni modulos

Publicado: 01 Sep 2009, 01:18
por R-007
el código que te iba a pasar yo es muy parecido pero el tuyo me ha gustado más (mucho más simple la verdad).. gracias por compartir amigo.
compartir ees vivir

Un saludo. R-007

Re: [Solucionado] Subir un .txt a una FTP sin OCX ni modulos

Publicado: 21 Sep 2009, 19:04
por oriol414
pues mira, yo buscaba hace nada uno como esto. Muchas Gracias.