Ejemplo de como subir una imagen a un servidor FTP

[LeandroA]

Hola este es un ejemplo de cómo subir una imagen a un servidor ftp utilizando API, modificando algunas líneas también es valido para cualquier archivo (pero por favor utilizar otra cuenta), no lo pude probar con otro servidor pero supongo no abría problemas (siempre y cuando se tengan los permisos de sobrescribir)

Para aquellos que quiera un hosting gratis lo pueden conseguir este lugar

http://www.unlugar.com/hostinggratis/info_servicios/hosting_gratis.asp



Agregar al formulario:



* 1 Image1
* 2 CommandButton
* 1 Label1
* 1 CommonDialog1
* 1 WebBrowser1

Código:

Option Explicit
Dim hOpen As Long, hConnection As Long, bRet As Long, Refrescar As Boolean
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 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_BINARY = &H1
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
' 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 Command2_Click()
 Dim Servevidor As String, Usuario As String, Contraseña As String
 '----------------------------------------
 Servevidor = "celularchat.unlugar.com"
 Usuario = "ftp-celularchat.unlugar.com"
 Contraseña = "ramonramon"
 '----------------------------------------
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 "Coneccion exitosa" Else Info "Error": Exit Sub
'selecionamos "/includes" que es la carpeta en el servidor donde guardo la imagen
bRet = FtpSetCurrentDirectory(hConnection, "/includes")
If bRet <> 0 Then Info "Suviendo al servidor..." Else Info "Error": Exit Sub
'CommonDialog1.FileName es el archivo selecionado y Foto.gif es el nombre con que lo guardamos
bRet = FtpPutFile(hConnection, CommonDialog1.FileName, "Foto.gif", FTP_TRANSFER_TYPE_BINARY, 0)
If bRet <> 0 Then Info "Acutilizando vista previa..." Else Info "Error": Exit Sub
'cierro la conexion
If hConnection <> 0 Then InternetCloseHandle (hConnection)
Refrescar = False
WebBrowser1.Refresh
Do While Not Refrescar
DoEvents
Loop
Info "Proceso terminado corectamente"
End Sub
Sub Info(Mensage As String)
Label1.Caption = Mensage
Label1.Refresh
End Sub
Sub Command1_Click()
On Error Resume Next
CommonDialog1.Filter = "Imagenes (*.gif; *.jpg; *.bmp)|*.gif; *.jpg; *.bmp"
CommonDialog1.ShowOpen
If CommonDialog1.FileName = "" Then Exit Sub
Image1 = LoadPicture(CommonDialog1.FileName)
Info CommonDialog1.FileName
Command2.Enabled = True
End Sub

 Sub Form_Load()
 Command1.Caption = "Selecionar Imagen": Command2.Caption = "Subir al Servidor"
 Command2.Enabled = False
 Image1.Width = 2295: Image1.Height = 2295: Image1.Stretch = True
 Dim html As String
'esto es solo para hacer una vista previa de la imagen en WebBrowser1
html = "about:<html> <font color=#FF0000><b><marquee>Este es un ejemplo de como subir una imagen a un servidor</marquee>" & _
"<body leftMargin=0 topMargin=0 marginheight=0 marginwidth=0 scroll=no>" & _
"<img src=http://celularchat.unlugar.com/includes/Foto.gif width= 160 height= 160 >" & _
"</img><p><a href=http://celularchat.unlugar.com/includes/Foto.gif target=_blank>Vista previa en tu navegador</a></p></body></html>"

WebBrowser1.Navigate html
'Iniciamos las funciones Win32 de internet
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If hOpen <> 0 Then Info "Iniciado correctamente" Else Info "Error"
Command2.Enabled = False
Me.Caption = "http://celularchat.unlugar.com/includes/Foto.gif"
End Sub

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

Sub WebBrowser1_DownloadComplete()
Refrescar = True
End Sub

PD: No destruyan la cuenta de usuario así la podemos utilizar todos