Enviar Archivo Con Winsock
Publicado por Fran (22 intervenciones) el 07/01/2006 01:25:34
Hola, estoy haciendo una especie de programa cliente/servidor en el que el cliente podría recibir capturas de la pantalla del servidor, el problema es que, (la captura la hace con un ocx, la captura bien) al transferir la imagen, me llega mal.. no se porque sera... aquí esta el código del cliente y del servidor.. alomejor encontrais mas errores xD
CLIENTE:
Private Sub Command1_Click()
estado.Caption = "Enviando petición de imagen.."
TCP.SendData "imagen"
End Sub
Private Sub Command2_Click()
TCP.RemoteHost = IP.Text
TCP.RemotePort = 1359
TCP.Connect
End Sub
Private Sub Form_Load()
Dim existelafoto As Boolean
If Existe(App.Path & "\imagen1.jpg") Then
existelafoto = True
Else
existelafoto = False
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
TCP.Close
End Sub
Private Sub TCP_Close()
estado.Caption = "Conexión cerrada"
End Sub
Private Sub TCP_Connect()
estado.Caption = "Conectado"
End Sub
Private Sub TCP_DataArrival(ByVal bytesTotal As Long)
estado.Caption = "Recibiendo imagen.."
Dim arxivo As String
Dim numero As Integer
numero = 1
While existelafoto = True
If Existe(App.Path & "\imagen" & numero & ".jpg") <> 0 Then
numero = numero + 1
Else
existelafoto = False
End If
Wend
Dim datos As String
TCP.GetData datos
arxivo = arxivo & datos
Open App.Path & "\imagen" & numero & ".jpg" For Binary As #1
Put #1, , arxivo
Close #1
If Existe(App.Path & "\imagen1.jpg") <> 0 Then
existelafoto = True
Else
existelafoto = False
End If
estado.Caption = "Imagen recibida"
End Sub
Private Sub TCP_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)
estado.Caption = "Error " & Number
End Sub
Public Function Existe(sArchivo As String) As Integer
Existe = Len(Dir$(sArchivo))
End Function
SERVIDOR:
Private Sub Command1_Click()
Form1.Visible = False
End Sub
Private Sub Form_Load()
TCP.Close
TCP.LocalPort = 1359
TCP.Listen
End Sub
Private Sub TCP_ConnectionRequest(ByVal requestID As Long)
TCP.Close
TCP.Accept requestID
End Sub
Private Sub TCP_DataArrival(ByVal bytesTotal As Long)
Dim datos As String
TCP.GetData datos
If datos = "imagen" Then
captura.Area = Pantalla
captura.captura
imagenTemporal.Picture = captura.Imagen
SavePicture imagenTemporal.Picture, App.Path & "\imagentemporal.jpg"
Dim Buf As String * 1024
Dim Todo As String
Open App.Path & "\imagentemporal.jpg" For Binary As #1
Do While Not EOF(1)
DoEvents
Get #1, , Buf
Todo = Todo & Buf
Loop
Close #1
TCP.SendData Todo
End If
End Sub
CLIENTE:
Private Sub Command1_Click()
estado.Caption = "Enviando petición de imagen.."
TCP.SendData "imagen"
End Sub
Private Sub Command2_Click()
TCP.RemoteHost = IP.Text
TCP.RemotePort = 1359
TCP.Connect
End Sub
Private Sub Form_Load()
Dim existelafoto As Boolean
If Existe(App.Path & "\imagen1.jpg") Then
existelafoto = True
Else
existelafoto = False
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
TCP.Close
End Sub
Private Sub TCP_Close()
estado.Caption = "Conexión cerrada"
End Sub
Private Sub TCP_Connect()
estado.Caption = "Conectado"
End Sub
Private Sub TCP_DataArrival(ByVal bytesTotal As Long)
estado.Caption = "Recibiendo imagen.."
Dim arxivo As String
Dim numero As Integer
numero = 1
While existelafoto = True
If Existe(App.Path & "\imagen" & numero & ".jpg") <> 0 Then
numero = numero + 1
Else
existelafoto = False
End If
Wend
Dim datos As String
TCP.GetData datos
arxivo = arxivo & datos
Open App.Path & "\imagen" & numero & ".jpg" For Binary As #1
Put #1, , arxivo
Close #1
If Existe(App.Path & "\imagen1.jpg") <> 0 Then
existelafoto = True
Else
existelafoto = False
End If
estado.Caption = "Imagen recibida"
End Sub
Private Sub TCP_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)
estado.Caption = "Error " & Number
End Sub
Public Function Existe(sArchivo As String) As Integer
Existe = Len(Dir$(sArchivo))
End Function
SERVIDOR:
Private Sub Command1_Click()
Form1.Visible = False
End Sub
Private Sub Form_Load()
TCP.Close
TCP.LocalPort = 1359
TCP.Listen
End Sub
Private Sub TCP_ConnectionRequest(ByVal requestID As Long)
TCP.Close
TCP.Accept requestID
End Sub
Private Sub TCP_DataArrival(ByVal bytesTotal As Long)
Dim datos As String
TCP.GetData datos
If datos = "imagen" Then
captura.Area = Pantalla
captura.captura
imagenTemporal.Picture = captura.Imagen
SavePicture imagenTemporal.Picture, App.Path & "\imagentemporal.jpg"
Dim Buf As String * 1024
Dim Todo As String
Open App.Path & "\imagentemporal.jpg" For Binary As #1
Do While Not EOF(1)
DoEvents
Get #1, , Buf
Todo = Todo & Buf
Loop
Close #1
TCP.SendData Todo
End If
End Sub
Valora esta pregunta


0