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 título de 2 formularios que utilizan el control Winsock de visual basic para poder enviar un archivo.

El envío se realiza de la siguiente forma: Primero el cliente selecciona el archivo, y este se carga en un array de bytes. Luego el servidor lee ese array de bytes y lo escribe en disco.

Código del formulario para el Cliente:

Iniciar un nuevo proyecto, y dentro de un formulario colocar los siguientes controles

Un control Winsock.
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 para el cuadro de diálogo de seleccionar archivo

código en el formulario:

Option Explicit 'Declaración del Api GetFileTitle Private Declare Function GetFileTitle _ Lib "comdlg32.dll" _ Alias "GetFileTitleA" ( _ ByVal lpszFile As String, _ ByVal lpszTitle As String, _ ByVal cbBuf As Integer) As Integer 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() Dim sFileName As String 'Comprobamos que hay un archivo a enviar If Trim(Text3) = "" Then MsgBox "Debe elegir un archivo" Exit Sub End If If Dir(Text3) <> "" Then sFileName = GetFileName(Text3) 'Enviamos los datos (El tamaño, y el nombre) Winsock1.SendData "|Archivo|" & FileLen(Text3) & "|" & sFileName Else MsgBox "El archivo no existe" End If End Sub Private Sub Command3_Click() With CommonDialog1 .FileName = vbNullString .ShowOpen If .FileName <> "" Then Text3 = .FileName End If End With End Sub Private Sub Form_Load() 'Ip del formulario servidor Text1 = "127.0.0.1" 'Puerto Text2 = "3000" Text3.Enabled = False Command1.Caption = "Conectar" Command2.Caption = "Enviar" Command3.Caption = " ..." Me.Caption = "Cliente" 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", vbInformation 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) Dim sData As String Winsock1.GetData sData, vbString If sData = "|Ok|" Then Call Enviar_Archivo 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 al cerrar la conexion" End Sub Private Sub Enviar_Archivo() Dim Size As Long Dim arrData() 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 arrData(Size - 1) 'Leemos y almacenamos todo el fichero en el array Get #1, , arrData 'Cerramos Close 'Enviamos el archivo Winsock1.SendData arrData End Sub Private Function GetFileName(sPath As String) Dim sBuffer As String * 255 Dim sTemp As String GetFileTitle sPath, sBuffer, Len(sBuffer) GetFileName = Left(sBuffer, InStr(1, sBuffer, Chr(0)) - 1) End Function

Controles para el formulario servidor

Un control Winsock
Un TextBox. Para el Puerto
1 Control Command Button ( para poner a la escucha y poder recibir una petición de conexión

Código en el formulario:

Option Explicit '********************************************************** Dim Flag As Boolean Dim lBytes As Long Dim lFileSize As Long Private Sub Command1_Click() On Error GoTo error_handler With Winsock1 'Le asignanmos el número de puerto .LocalPort = Text1 'Ponemos a la escucha .Listen End With Command1.Enabled = False Exit Sub error_handler: MsgBox Err.Description End Sub Private Sub Form_Load() Text1 = "3000" Command1.Caption = "Poner a la escucha" Me.Caption = "servidor" End Sub Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long) On Error GoTo error_handler Command1.Enabled = False With Winsock1 'Cerramos el Winsock .Close .Accept requestID End With MsgBox "Conexion recibida" Exit Sub error_handler: MsgBox Err.Description, vbCritical, "Winsock1_ConnectionRequest" End Sub Private Sub Winsock1_Close() On Error GoTo error_handler Command1.Enabled = True Winsock1.Close MsgBox "Conexion cerrada" Exit Sub error_handler: MsgBox Err.Description, vbCritical, "Winsock_Close" End Sub Private Sub Winsock1_Connect() MsgBox "Conexion aceptada", vbInformation End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) 'On Error GoTo error_handler 'Array de Bytes para escribir el archivo en disco Dim arrData() As Byte Dim vData As Variant If Flag = False Then Winsock1.GetData vData, vbString If Mid(vData, 1, 9) = "|Archivo|" Then Flag = True lBytes = 0 vData = Split(vData, "|") lFileSize = vData(2) ' Le enviamos como mensaje al cliente que comienze el envio del archivo Winsock1.SendData "|Ok|" 'Creamos un archivo en modo binario Open App.Path & "\" & vData(3) For Binary Access Write As #1 End If End If If Flag Then ' Aumentamos lBytes con los datos que van llegando lBytes = lBytes + bytesTotal 'Recibimos los datos y lo almacenamos en el arry de bytes Winsock1.GetData arrData 'Escribimos en disco el array de bytes, es decir lo que va llegando Put #1, , arrData ' Si lo recibido es mayor o igual al tamaño entonces se terminó y cerramos 'el archivo abierto If lBytes >= lFileSize Then 'Cerramos el archivo Close #1 'Reestablecemos el flag y la variable lBytes por si se intenta enviar otro archivo Flag = False lBytes = 0 'Mostrar mensaje de finalización MsgBox "El archivo se ha recibido por completo" End If End If ' Exit Sub 'error_handler: 'MsgBox Err.Description 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 'Cerramos el Winsock Winsock1.Close 'Mostramos el aviso de que se cerró la conexión MsgBox "La Conexion se ha cerrado", vbInformation End Sub

Enlaces relacionados

Buscar en Recursos vb