Sección de código fuente Visual basic

Enviar archivos desde un formulario cliente a un formulario servidor con el control Winsock

El siguiente código fuente consta como está dicho en el title de 2 formularios que utilizan el control Winsock de visual basic para poder enviar cualquier tipo de archivo.

El envío se realiza de la siguiente forma: Primero el cliente selecciona el archivo, este archivo a enviar se carga en un array de bytes. El servidor lee ese array de bytes y lo escribe. Esto obviamente solo se puede realizar si se accede en modo binario, es decir el formulario cliente lee mediante Get y el servidor escribe mediante la instrucción Put, accediendo a los ficheros en modo For Binary.

Una cosa importante es que antes de enviar el archivo, primero se le envía al servidor una serie extra de datos necesarios, estos datos son: el nombre del archivo (para que el servidor al escribir el fichero en disco sepa el nombre) y también el tamaño del mismo, para poder verificar cuando se ha finalizado y también para poder redimensionar el array.

Nota: El cliente y el servidor al conectarse deben hacerlo al mismo número de puerto

Para probar el ejemplo comenzamos con el Cliente:

Coloca en un nuevo proyecto dentro de un formulario los siguientes controles

Un control Winsock1.
3 Controles TextBox: El Text1 es para la dirección Ip, el Text2 es para el puerto y el Text3 es para la ruta del archivo.
3 controles CommandButton. El Command1 es para conectar al servidor. El command2 es para enviar el archivo. El Command3 es para abrir el cuadro de diálogo "Seleccionar archivo"
Por último Un control CommonDialog1

Colocalo mas o menos como está en la imagen:

vista previa del formulario cliente que enviará archivos al form servidor

Ahora pega el siguiente código en el formulario:

Private Sub Command1_Click()
On Error Resume Next
'conectamos al servidor. El Text1 es la dirección IP y el Text2 es el puerto
Winsock1.Connect Text1, Text2

Command1.Enabled = False

End Sub

Private Sub Command2_Click()
'Comprobamos que hay un archivo a enviar
If Trim(Text3) = "" Then
MsgBox "Debe elegir un archivo"
Exit Sub
End If

If Dir(Text3) <> "" Then
' Separar el nombre del archivo para solo tomar su nombre (sin la ruta)
Datos = Split(Text3, "\")

'Datos(UBound(Datos)) es el nombre del archivo, que sería Datos(3)

'Datos(2) es el tamaño en bytes del archivo. Esta información se la enviamos
'antes de enviar el fichero

'enviamos los datos
Winsock1.SendData "|Archivo|" & FileLen(Text3) & "|" & Datos(UBound(Datos))
Else
MsgBox "El archivo no existe"
End If
End Sub

Private Sub Command3_Click()
Common1.ShowOpen

If Common1.FileName <> "" Then
Text3 = Common1.FileName
End If
End Sub

Private Sub Form_Load()
'Ip del formulario servidor
Text1 = "127.0.0.1"
'Puerto
Text2 = "3000"
Text3.Enabled = False
End Sub

Private Sub Winsock1_Close()
On Error Resume Next

Command1.Enabled = True
Command2.Enabled = False
'Cerramos el winsock
Winsock1.Close

MsgBox "La Conexion se ha cerradado"
End Sub

Private Sub Winsock1_Connect()
Command1.Enabled = False
Command2.Enabled = True

MsgBox "Conectado correctamente al servidor"
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Datos, vbString

If Datos = "|Ok|" Then
Enviar_Archivo
End If
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
On Error Resume Next

Command1.Enabled = True
Command2.Enabled = False
'Cerramos el winsock
Winsock1.Close
MsgBox "Error en la conexion"
End Sub

Private Sub Enviar_Archivo()
Dim Size As Long
Dim Archivo() As Byte

Open Text3 For Binary Access Read As #1
'Obtenemos el tamaño exacto en bytes del archivo para poder redimensionar el array de bytes
Size = LOF(1)
ReDim Archivo(Size - 1)
'Leemos y almacenamos todo el fichero en el array
Get #1, , Archivo
'Cerramos
Close

'Enviamos el archivo
Winsock1.SendData Archivo
End Sub

Ahora para el formulario servidor colocar los siguientes controles:

2 Controles TextBox. El Text1 es para el Puerto y el Text2 es para la ruta donde se guardará el fichero.
Un control ProgressBar para mostrar el progreso llamado Progressbar1
2 Controles Command. El Command1 es para poner a la escucha (poder recibir una petición de conexión) El Command2 es para seleccionar la ruta donde guardar el archivo

Vista previa del formulario servidor

Código en el formulario:

'Para el cuadro de diálogo Seleccionar carpeta de windows
'*********************************************************
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

'**********************************************************

Dim Flag As Boolean
Dim sizeFileRecibido As Long
Dim sizeFile As Long

Private Sub Command1_Click()
On Error Resume Next
'Le asignanmos el número de puerto
Winsock1.LocalPort = Text1
'Ponemos a la escucha
Winsock1.Listen

Command1.Enabled = False
End Sub

Private Sub Command2_Click()
'Mostramos en el Text2 la ruta donde se guardará el archivo
Text2 = Ruta(Me)
End Sub

Private Sub Form_Load()
Text1 = "3000"
Text2.Enabled = False
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
On Error Resume Next

Command1.Enabled = False
'Cerramos el Winsock
Winsock1.Close
'Aceptamos la conexión del Winsock2
Winsock2.Accept requestID

MsgBox "Conexion recibida"
End Sub

Private Sub Winsock2_Close()
On Error Resume Next

Command1.Enabled = True

Winsock2.Close

MsgBox "Conexion cerrada"
End Sub

Private Sub Winsock2_Connect()
MsgBox "Conexion aceptada"
End Sub

Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next

'Array de Bytes para escribir el archivo en disco
Dim Archivo() As Byte

If Flag = False Then
Winsock2.GetData Datos, vbString
If Mid(Datos, 1, 9) = "|Archivo|" Then
' Flag
Flag = True
'Ponemos en 0
sizeFileRecibido = 0
' Separamos los datos
Datos = Split(Datos, "|")

sizeFile = Datos(2)
'Ponemos el ProgressBar en 0
ProgressBar1.Value = 0
'Establecemos el Max del ProgressBar pasandole comomáximo el tamaño del archivo
ProgressBar1.Max = sizeFile
' Le enviamos como mensaje al cliente que comienze el envio del archivo
Winsock2.SendData "|Ok|"

'Creamos un archivo en modo binario pasandole la ruta del text2
Open Text2 & "\" & Datos(3) For Binary Access Write As #1
End If
End If

If Flag = True Then

' Aumentamos sizeFileRecibido con los datos que van llegando
sizeFileRecibido = sizeFileRecibido + bytesTotal

'Recibimos los datos y lo almacenamos en el arry de bytes
Winsock2.GetData Archivo

'Colocamos en el valor de lo recibido en el Value del progressbar
ProgressBar1.Value = sizeFileRecibido

'Escribimos en disco el array de bytes, es decir lo que va llegando
Put #1, , Archivo

' Si lo recibido es mayor o igual al tamaño entonces se terminó y cerramos
'el archivo abierto
If sizeFileRecibido >= sizeFile Then
'Cerramos el archivo
Close #1
'Reestablecemos el flag y la variable sizeFileRecibido por si se intenta enviar otro archivo
Flag = False
sizeFileRecibido = 0
'Actualizar dato del ProgressBar
ProgressBar1.Value = ProgressBar1.Max
'Mostrar mensaje de finalización
MsgBox "Archivo se ha recibido por completo"
End If
End If

End Sub

Private Sub Winsock2_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
On Error Resume Next

Command1.Enabled = True
'Cerramos el Winsock
Winsock2.Close
'Mostramos el aviso de que se cerró la conexión
MsgBox "La Conexion se ha cerrado", vbInformation
End Sub

'Función para abrir el cuadro de dialogo de windows y retornar el path que
'se visualiza en el text2
'***********************************************************************
Private Function Ruta(f As Form) As String

Dim iNull As Integer, lpIDList As Long, lResult As Long
Dim sPath As String, udtBI As BrowseInfo

With udtBI

.hWndOwner = f.hWnd
.lpszTitle = lstrcat("C:\", "")

.ulFlags = BIF_RETURNONLYFSDIRS
End With

'Mostramos el cuadro de diálogo "Buscar carpeta de windows"
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)
'Get the path from the IDList
SHGetPathFromIDList lpIDList, sPath

CoTaskMemFree lpIDList
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
End If
'Retornamos el Path a la función que luego se muestra en el text2
Ruta = sPath
End Function

Enlaces relacionados

Buscar en Recursos vb