Código eVB para aplicación FTP

JC,

No se si el siguiente artículo te sirva.
http://www.devbuzz.com/content/zinc...TP_pg1.asp

Avísanos si te sirvió.


Mario G. Contreras Arriaga, VB MVP


"Juan C. Santaella" wrote in message
news:u9%

Hola, alguno de ustedes conocerá donde puedo conseguir el código para una
aplicación que me permitar crear una aplicación FTP haciendo uso de

WinInet

y eVB. Microsoft tiene uno pero presenta un "BUG" con FtpPutFile y
FtpGetFile.
Muchas gracias por su ayuda.

Mario, lamentablemente el artículo no me sirve, ya que ellos usan un dll que
tiene el código compilado y lo venden por US$ 899. Yo necesito el código sin
compilar haciendo uso del WinInet API, que es la que me permite crear una
conexión con un servidor y usar FTP.
Gracias, por tu colaboración,
JC

"Mario G. Contreras Arriaga" wrote in message
news:ucQ5ky$

JC,

No se si el siguiente artículo te sirva.
http://www.devbuzz.com/content/zinc...TP_pg1.asp

Avísanos si te sirvió.


Mario G. Contreras Arriaga, VB MVP


"Juan C. Santaella" wrote in message
news:u9%
> Hola, alguno de ustedes conocerá donde puedo conseguir el código para

una

> aplicación que me permitar crear una aplicación FTP haciendo uso de
WinInet
> y eVB. Microsoft tiene uno pero presenta un "BUG" con FtpPutFile y
> FtpGetFile.
> Muchas gracias por su ayuda.
>
>
>

Mario, estoy anexando el código de Microsoft (Un formulario y un módulo
básico). Si alguien tiene idea de como hacer las modificaciones recomendadas
por Microsoft, se lo agradecería mucho, es urgente..!!
Según MS, siguiendo las instrucciones en el artículo:
http://support.microsoft.com/defaul...-US;312039
se logra que funcione correctamente la subida y descarga de archivos a un
servidor FTP.
Muchas gracias
JC

Código Microsoft FTP con eVB (Form1.ebf)

Option Explicit

Private Sub Command1_click()

On Error Resume Next
Dim blnBin As Boolean
blnBin = False
If Check1.Value = 1 Then blnBin = True

If InitializeFTP Then
MsgBox "FTP initialized"
If ConnectToFTPServer(Text1.Text, "", "") Then
MsgBox "Connected to server"
PutFileOnFTPServer Text2.Text, _
Text3.Text, blnBin
MsgBox "File transferred"
End If
CloseFTP
MsgBox "Connection closed"
End If

If Err.Number <> 0 Then MsgBox "Error in Command1_Click: " & _
Err.Number & " - " & Err.Description

End Sub

Private Sub Form_OKClick()
App.End
End Sub

Private Sub Form_Load()
Label1.Move 120, 120, 1575, 255
Label2.Move 120, 720, 1575, 255
Label3.Move 120, 1320, 1575, 255
Text1.Move 240, 360, 2895, 255
Text2.Move 240, 960, 2895, 255
Text3.Move 240, 1560, 2895, 255
Command1.Move 120, 1960, 3135, 495
Check1.Move 1560, 3120, 2775, 255
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label1.Caption = "FTP Server"
Label2.Caption = "File on Device"
Label3.Caption = "File on FTP Server"
Check1.Caption = "Binary Transfer"
Command1.Caption = "Transfer To Server"
End Sub
-
-
Código Módulo (.bas)

Option Explicit

Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const INTERNET_FLAG_RELOAD = &H80000000

Public Const FTP_TRANSFER_TYPE_UNKNOWN As Long = 0
Public Const FTP_TRANSFER_TYPE_ASCII As Long = 1
Public Const FTP_TRANSFER_TYPE_BINARY As Long = 2

Public Const INTERNET_DEFAULT_FTP_PORT As Long = 21
Public Const INTERNET_FLAG_PASSIVE As Long = &H8000000
Public Const INTERNET_SERVICE_FTP As Long = 1

Declare Function FtpPutFile Lib "wininet" Alias "FtpPutFileW" ( _
ByVal hFtp As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszNewRemoteFile As String, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long

Declare Function InternetCloseHandle Lib "wininet" ( _
ByVal hInet As Long) As Long

Declare Function InternetConnect Lib "wininet" Alias "InternetConnectW" ( _
ByVal hInet As Long, _
ByVal lpszServerName As String, _
ByVal nServerPort As Long, _
ByVal lpszUsername As String, _
ByVal lpszPassword As String, _
ByVal dwService As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long

Declare Function InternetOpen Lib "wininet" Alias "InternetOpenW" ( _
ByVal lpszAgent As String, _
ByVal dwAccessType As Long, _
ByVal lpszProxyName As String, _
ByVal lpszProxyBypass As String, _
ByVal dwFlags As Long) As Long

Declare Function GetLastError Lib "coredll" () As Long

Public lngInternetHandle As Long
Public lngFtpHandle As Long
Public hOpenUrl As Long

Public Function InitializeFTP() As Boolean

On Error Resume Next
Dim sUrl As String

lngInternetHandle = InternetOpen("eVB OpenUrl", _
INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If Err.Number <> 0 Or lngInternetHandle = 0 Then
MsgBox "Failed to initialize communications to transfer data" & _
vbCrLf & Err.Description
InitializeFTP = False
Else
InitializeFTP = True
End If

End Function

Public Function ConnectToFTPServer(ByVal strFTPServerName As String, _
ByVal strUsername As String, ByVal strPassword As String) As Boolean

On Error Resume Next

lngFtpHandle = InternetConnect(lngInternetHandle, strFTPServerName, _
INTERNET_DEFAULT_FTP_PORT, strUsername, strPassword, _
INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)

If lngFtpHandle = 0 Or Err.Number <> 0 Then
MsgBox "Failed to connect to server to transfer data. Error: " & _
CStr(GetLastError)
ConnectToFTPServer = False
Else
ConnectToFTPServer = True
End If

End Function

Public Function PutFileOnFTPServer(ByVal strSourceFilename As String, _
ByVal strDestFilename As String, _
ByVal blnBinaryFile As String) As Boolean

On Error Resume Next

Dim blnTransferredOK As Boolean
Dim lngTransferType As Long

If blnBinaryFile Then
lngTransferType = FTP_TRANSFER_TYPE_BINARY
Else
lngTransferType = FTP_TRANSFER_TYPE_ASCII
End If

blnTransferredOK = FtpPutFile(lngFtpHandle, strSourceFilename, _
strDestFilename, lngTransferType, 0)

If blnTransferredOK = 0 Then
MsgBox "Transfer of file " & strSourceFilename & _
" to server failed. Error: " & CStr(GetLastError())
Else
MsgBox "Transfer of file" & strSourceFilename & " succeeded!"
End If
PutFileOnFTPServer = blnTransferredOK

End Function

Public Sub CloseFTP()

On Error Resume Next

InternetCloseHandle lngFtpHandle
InternetCloseHandle lngInternetHandle

End Sub

"Juan C. Santaella" wrote in message
news:

Mario, lamentablemente el artículo no me sirve, ya que ellos usan un dll

que

tiene el código compilado y lo venden por US$ 899. Yo necesito el código

sin

compilar haciendo uso del WinInet API, que es la que me permite crear una
conexión con un servidor y usar FTP.
Gracias, por tu colaboración,
JC

"Mario G. Contreras Arriaga" wrote in message
news:ucQ5ky$
> JC,
>
> No se si el siguiente artículo te sirva.
> http://www.devbuzz.com/content/zinc...TP_pg1.asp
>
> Avísanos si te sirvió.
>
>
> Mario G. Contreras Arriaga, VB MVP
>
>
> "Juan C. Santaella" wrote in message
> news:u9%
> > Hola, alguno de ustedes conocerá donde puedo conseguir el código para
una
> > aplicación que me permitar crear una aplicación FTP haciendo uso de
> WinInet
> > y eVB. Microsoft tiene uno pero presenta un "BUG" con FtpPutFile y
> > FtpGetFile.
> > Muchas gracias por su ayuda.
> >
> >
> >
>
>

hola
el codigo siguiente te servira, solo presenta un problema que no he
conseguido corregir, si lo consigues notificamelo por email, el envio del
fichero se realiza correctamente pero la sesion con el ftp tarda unos
minutos en cerrarse, exactamente en InternetCloseHandle (handleFichRemoto).
Suerte. ya me contaras tus progresos.


Public Function EnviarAServidorFTP(ByVal ficheroOrigen As String, _
ByVal ficheroDestino As String) As Boolean
Dim transferenciaOk As Boolean
Dim lineaFich As String
Dim lineaEscribir
Dim bytesEscritos As Long
Dim handleFichRemoto As Long
Dim X As Boolean
Dim fich As FILECTL.File
Dim fs As FILECTL.FileSystem
Set fs = CreateObject("FileCtl.FileSystem")
Set fich = CreateObject("FileCtl.File")
On Error Resume Next
fich.Open ficheroOrigen, fsModeInput, fsAccessRead, fsLockRead
handleFichRemoto = FtpOpenFile(lngFtpHandle, ficheroDestino, GENERIC_WRITE,
_
INTERNET_FLAG_RELOAD, 0)
If handleFichRemoto <> 0 Then
While Not fich.EOF
lineaFich = fich.LineInputString
lineaEscribir = UnicodeAAnsi(lineaFich)
lineaEscribir = lineaFich & vbCrLf
X = InternetWriteFile(handleFichRemoto, lineaEscribir, _
LenB(lineaEscribir), bytesEscritos)
If (X = 0) Then
MsgBox "InternetWriteFile Error: " & Err.LastDllError
Exit Function
End If
Wend
InternetCloseHandle (handleFichRemoto)
fich.Close
EnviarAServidorFTP = True
Else
EnviarAServidorFTP = False
End If
End Function
"Juan C. Santaella" escribió en el mensaje
news:%

Mario, estoy anexando el código de Microsoft (Un formulario y un módulo
básico). Si alguien tiene idea de como hacer las modificaciones

recomendadas

por Microsoft, se lo agradecería mucho, es urgente..!!
Según MS, siguiendo las instrucciones en el artículo:
http://support.microsoft.com/defaul...-US;312039
se logra que funcione correctamente la subida y descarga de archivos a un
servidor FTP.
Muchas gracias
JC

Código Microsoft FTP con eVB (Form1.ebf)

Option Explicit

Private Sub Command1_click()

On Error Resume Next
Dim blnBin As Boolean
blnBin = False
If Check1.Value = 1 Then blnBin = True

If InitializeFTP Then
MsgBox "FTP initialized"
If ConnectToFTPServer(Text1.Text, "", "") Then
MsgBox "Connected to server"
PutFileOnFTPServer Text2.Text, _
Text3.Text, blnBin
MsgBox "File transferred"
End If
CloseFTP
MsgBox "Connection closed"
End If

If Err.Number <> 0 Then MsgBox "Error in Command1_Click: " & _
Err.Number & " - " & Err.Description

End Sub

Private Sub Form_OKClick()
App.End
End Sub

Private Sub Form_Load()
Label1.Move 120, 120, 1575, 255
Label2.Move 120, 720, 1575, 255
Label3.Move 120, 1320, 1575, 255
Text1.Move 240, 360, 2895, 255
Text2.Move 240, 960, 2895, 255
Text3.Move 240, 1560, 2895, 255
Command1.Move 120, 1960, 3135, 495
Check1.Move 1560, 3120, 2775, 255
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label1.Caption = "FTP Server"
Label2.Caption = "File on Device"
Label3.Caption = "File on FTP Server"
Check1.Caption = "Binary Transfer"
Command1.Caption = "Transfer To Server"
End Sub
-
-
Código Módulo (.bas)

Option Explicit

Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const INTERNET_FLAG_RELOAD = &H80000000

Public Const FTP_TRANSFER_TYPE_UNKNOWN As Long = 0
Public Const FTP_TRANSFER_TYPE_ASCII As Long = 1
Public Const FTP_TRANSFER_TYPE_BINARY As Long = 2

Public Const INTERNET_DEFAULT_FTP_PORT As Long = 21
Public Const INTERNET_FLAG_PASSIVE As Long = &H8000000
Public Const INTERNET_SERVICE_FTP As Long = 1

Declare Function FtpPutFile Lib "wininet" Alias "FtpPutFileW" ( _
ByVal hFtp As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszNewRemoteFile As String, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long

Declare Function InternetCloseHandle Lib "wininet" ( _
ByVal hInet As Long) As Long

Declare Function InternetConnect Lib "wininet" Alias "InternetConnectW"

( _

ByVal hInet As Long, _
ByVal lpszServerName As String, _
ByVal nServerPort As Long, _
ByVal lpszUsername As String, _
ByVal lpszPassword As String, _
ByVal dwService As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long

Declare Function InternetOpen Lib "wininet" Alias "InternetOpenW" ( _
ByVal lpszAgent As String, _
ByVal dwAccessType As Long, _
ByVal lpszProxyName As String, _
ByVal lpszProxyBypass As String, _
ByVal dwFlags As Long) As Long

Declare Function GetLastError Lib "coredll" () As Long

Public lngInternetHandle As Long
Public lngFtpHandle As Long
Public hOpenUrl As Long

Public Function InitializeFTP() As Boolean

On Error Resume Next
Dim sUrl As String

lngInternetHandle = InternetOpen("eVB OpenUrl", _
INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If Err.Number <> 0 Or lngInternetHandle = 0 Then
MsgBox "Failed to initialize communications to transfer data" & _
vbCrLf & Err.Description
InitializeFTP = False
Else
InitializeFTP = True
End If

End Function

Public Function ConnectToFTPServer(ByVal strFTPServerName As String, _
ByVal strUsername As String, ByVal strPassword As String) As Boolean

On Error Resume Next

lngFtpHandle = InternetConnect(lngInternetHandle, strFTPServerName, _
INTERNET_DEFAULT_FTP_PORT, strUsername, strPassword, _
INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)

If lngFtpHandle = 0 Or Err.Number <> 0 Then
MsgBox "Failed to connect to server to transfer data. Error: " & _
CStr(GetLastError)
ConnectToFTPServer = False
Else
ConnectToFTPServer = True
End If

End Function

Public Function PutFileOnFTPServer(ByVal strSourceFilename As String, _
ByVal strDestFilename As String, _
ByVal blnBinaryFile As String) As Boolean

On Error Resume Next

Dim blnTransferredOK As Boolean
Dim lngTransferType As Long

If blnBinaryFile Then
lngTransferType = FTP_TRANSFER_TYPE_BINARY
Else
lngTransferType = FTP_TRANSFER_TYPE_ASCII
End If

blnTransferredOK = FtpPutFile(lngFtpHandle, strSourceFilename, _
strDestFilename, lngTransferType, 0)

If blnTransferredOK = 0 Then
MsgBox "Transfer of file " & strSourceFilename & _
" to server failed. Error: " & CStr(GetLastError())
Else
MsgBox "Transfer of file" & strSourceFilename & " succeeded!"
End If
PutFileOnFTPServer = blnTransferredOK

End Function

Public Sub CloseFTP()

On Error Resume Next

InternetCloseHandle lngFtpHandle
InternetCloseHandle lngInternetHandle

End Sub

"Juan C. Santaella" wrote in message
news:
> Mario, lamentablemente el artículo no me sirve, ya que ellos usan un dll
que
> tiene el código compilado y lo venden por US$ 899. Yo necesito el código
sin
> compilar haciendo uso del WinInet API, que es la que me permite crear

una

> conexión con un servidor y usar FTP.
> Gracias, por tu colaboración,
> JC
>
> "Mario G. Contreras Arriaga" wrote in message
> news:ucQ5ky$
> > JC,
> >
> > No se si el siguiente artículo te sirva.
> > http://www.devbuzz.com/content/zinc...TP_pg1.asp
> >
> > Avísanos si te sirvió.
> >
> >
> > Mario G. Contreras Arriaga, VB MVP
> >
> >
> > "Juan C. Santaella" wrote in message
> > news:u9%
> > > Hola, alguno de ustedes conocerá donde puedo conseguir el código

para

> una
> > > aplicación que me permitar crear una aplicación FTP haciendo uso de
> > WinInet
> > > y eVB. Microsoft tiene uno pero presenta un "BUG" con FtpPutFile y
> > > FtpGetFile.
> > > Muchas gracias por su ayuda.
> > >
> > >
> > >
> >
> >
>
>