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
