Autor
de Cliente a Cliente.
Que haga la siiguiente funcion Cliente <-> Servido <-> Cliente
Tengo este codigo que encontre de una web pero solo envia una imagen pero quiero que envie porlomenos 5 o 6 imagenes de cliente a cliente.
Código:
'Función Api Sleep Para generar una espera o retardo de tiempo
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'Array de bytes para el gráfico
Dim imagen() As Byte
'Estas dos variables son 2 flags
Dim flag As Boolean
Dim progreso As Boolean
'Este Command es para conectarse al servidor
'*********************************************************************
Private Sub Command1_Click()
'Conectamos a la Ip y puerto
Winsock1.Connect Text1, CInt(Text2)
'Mostramos la Ip de conexión en el caption del Formulario
Me.Caption = "Estado de la conexion: Conectado a la IP: " + Text1
'Esto deshabilita y habilita controles
Command3.Enabled = True: Command1.Enabled = False: Command2.Enabled = True
End Sub
'Este Command es para desconectarse del servidor
'*********************************************************************
Private Sub Command2_Click()
'habilitamos y deshabilitamos los command
Command2.Enabled = False: Command1.Enabled = True
'cerramos la conexión
Winsock1.Close
End Sub
'Este Command es el que abre el cuadro de diálogo para seleccionar la imágen
'*********************************************************************
Private Sub Command3_Click()
On Error GoTo mensaje
With CommonDialog1
.DialogTitle = "Seleccionà el archivo de imagen"
.ShowOpen
If .FileName = "" Or .CancelError = True Then Exit Sub 'salimos si cancelamos
If MsgBox("¿Seleccionaste el archivo correcto??", vbInformation + vbYesNo, _
"Enviar archivo de imagen") = vbNo Then Exit Sub
Winsock1.SendData .FileName 'enviamos la ruta
Picture1 = LoadPicture(.FileName) 'Cargamos la imagen en el Picture1
End With
Command4.Enabled = True
Command3.Enabled = False
Exit Sub
mensaje:
If Err.Number = 40006 Then MsgBox Err.Description, vbInformation, _
"Error en la conexion": Command2_Click: Me.Cls
End Sub
'Este Command es el que envía la imágen al servidor
'*********************************************************************
Private Sub Command4_Click()
Dim tamaño As Long
progreso = True
'abrimos el archivo en modo binario de lectura
Open CommonDialog1.FileName For Binary Access Read As #1
tamaño = LOF(1) 'Tamaño en bytes de la imagen
'Redimensionamos el Array
ReDim imagen(tamaño - 1)
'Leemos todo el archivo y lo almacenamos en el array imagen
Get #1, , imagen
Close
flag = True
'Enviamos el array al servidor
Winsock1.SendData imagen
'Para el progreso del envio
ProgressBar1.Max = tamaño + 1
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)
MsgBox "Error: " + Description
End Sub
'Este evento se dispara cuando se terminó de enviar completamente _
todos los datos
'*****************************************************************
Private Sub Winsock1_SendComplete()
'Hacemos una pausa
Sleep 1500
If flag Then Command4.Enabled = True
If flag Then Winsock1.SendData 1: flag = False
Command4.Enabled = False
Command3.Enabled = True
If progreso Then
ProgressBar1.Value = 0
progreso = False
End If
End Sub
'Muestra mediante el evento SendProgress en la barra de progreso
'*****************************************************************
Private Sub Winsock1_SendProgress(ByVal bytesSent As Long, ByVal _
bytesRemaining As Long)
If progreso Then
ProgressBar1 = ProgressBar1 + bytesSent ' bytesSent son los bytes enviados
End If
End Sub
Private Sub Form_Load()
Dim ancho As Integer
Me.ScaleMode = vbPixels: Me.ForeColor = vbBlue
Text1 = "127.0.0.1": Text2 = 1000
Command1.Caption = "conectar": Command2.Caption = "desconectar": _
Command3.Caption = "-->> Buscar archivo de imagen para enviar al servidor": _
Command4.Caption = "Enviar"
ancho = TextWidth(Command3.Caption)
Command3.Width = ancho + ancho / 10
Command2.Enabled = False: Command4.Enabled = False: Command3.Enabled = False
Label1.Caption = "Direccion ip"
Label2.Caption = "Puerto"
Label1.AutoSize = True: Label2.AutoSize = True
Me.Caption = "No conectado"
End Sub
Private Sub Form_Resize()
On Error Resume Next
Label1.Left = 10: Text1.Left = Label1.Width + 20: Label2.Left = Text1.Left + _
Text1.Width + 20: Text2.Left = Label2.Left + Label2.Width + 10
Label1.Top = 20: Label2.Top = 20: Text1.Top = 20: Text2.Top = 20
Command3.Left = 20: Command3.Top = Text1.Top + Text1.Height + 20
Command1.Left = Me.ScaleWidth - Command1.Width - 20
Command2.Left = Me.ScaleWidth - Command2.Width - 20
Command4.Left = Me.ScaleWidth - Command4.Width - 20
Command1.Top = 20: Command2.Top = 20 + Command1.Height: Command4.Top = 50 + _
Command2.Top
ProgressBar1.Left = 20: ProgressBar1.Width = Me.ScaleWidth - 40
ProgressBar1.Top = Me.ScaleHeight - ProgressBar1.Height - 10
Picture1.Left = 20: Picture1.Top = Command3.Top + 30: Picture1.Height = _
Me.ScaleHeight - ProgressBar1.Height - Command3.Height - Text1.Height - 60
Picture1.Width = Me.ScaleWidth - Command2.Width - 50
End Sub
Código:
Dim flag As Boolean, nombre As String
Private Sub Command1_Click()
'Ponemos a la escucha el Winsock
Winsock1.Listen
Command1.Enabled = False
Command2.Enabled = True
End Sub
Private Sub Command2_Click()
'Desconectamos el Winsock
Winsock1.Close
Command1.Enabled = True
Command2.Enabled = False
End Sub
Private Sub Command3_Click()
End
End Sub
'Esto le asigna los caption y demás a los controles
Private Sub Form_Load()
Me.ScaleMode = vbPixels
Winsock1.LocalPort = 1000 'Le establecemos el puerto
Command1.Caption = "poner a la escucha"
Command2.Caption = "Desconectar"
Command3.Caption = "salir"
Check1.Caption = "Eliminar las imagenes temporales del directorio"
Me.Caption = "puerto determinado de comunicacon: 1000"
End Sub
'Redimensionar controles
Private Sub Form_Resize()
On Error Resume Next
Command1.Top = Me.ScaleHeight - Command1.Height
Command2.Top = Me.ScaleHeight - Command2.Height
Command3.Top = Me.ScaleHeight - Command3.Height
Command1.Left = 10: Command2.Left = Command1.Width + 10: _
Command3.Left = Me.ScaleWidth - Command3.Width - 10
Picture1.Width = Me.ScaleWidth - 20
Picture1.Left = 10
Me.Height = Screen.Height / 2
Check1.Left = 10
Check1.Top = Me.ScaleHeight - Command1.Height - Check1.Height
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
Winsock1.Close
Winsock1.Accept requestID
End Sub
'Procedimiento que recibe los datos del cliente
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'Array dinámico para almacenar el archivo
Dim imagen() As Byte
Select Case flag
Case False
'Esto se encarga de obtener el nombre del fichero
Winsock1.GetData nombre
nombre = Right(nombre, Len(nombre) - InStrRev(nombre, "\"))
Open App.Path + "\" & nombre For Binary As #1
flag = True
Case True
'Esto escribe en el disco el archivo de imagen
Winsock1.GetData imagen
If UBound(imagen) = 1 Then
Close
Picture1 = LoadPicture(App.Path + "\" + nombre)
'Si está chequeado el chek eliminamos el archivo cuando finaliza
If Check1 Then Kill App.Path + "\" + nombre
flag = False
Exit Sub
End If
'Escribimos en disco la imagen con Put pasandole el Array
Put #1, , imagen
End Select
End Sub
Si alguien puede ayudarme!
En línea
