Saludos, bueno tengo este problema que no he logrado resolver hasta los momentos, tal vez el problema sea tonto pero no logro verlo no se en que me equivoco, el programa lo que hace es capturar remotamente la pantalla del ordenador y enviarla al cliente hasta los momentos me la captura pero cuando la envia al cliente en cierto momento el cliente me tira un error llamado:
Run-Time error "9":
SubScript out of range
bueno aqui les dejo el code completo del server y cliente, sabiendo que hay que mejorarle ciertas cosas tales como la conexion, y el metodo de captura!:
Cliente
Private Sub Command1_Click()
ws.LocalPort = 1234
ws.Listen
Label1.Caption = "Escuchando..."
Timer1.Enabled = True
End Sub
Private Sub Command2_Click()
ws.Close
labe1.Caption = "Desconectado..."
Timer1.Enabled = False
End Sub
Private Sub Command3_Click()
ws.SendData "cap"
End Sub
Private Sub Timer1_Timer()
If ws.State = 7 Then
Label1.Caption = "Server Conectado"
End If
If ws.State = 0 Then
Label1.Caption = "Escuchando..."
ws.LocalPort = 1234
ws.Listen
End If
End Sub
Private Sub ws_Connect()
MsgBox ("Server Conectado con cliente"), vbInformation, "Skull Capture"
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 dato As String
Dim envio As Boolean
Dim lf() As String
Dim lenfile As String
ws.GetData dato
Select Case Left(dato, 3)
Case "Tam"
lf = Split(dato, "|")
lenfile = lf(2)
envio = True
ws.SendData "send"
Case "sen"
Dim imagen() As String
If envio = True Then
Data = dato
If Len(Data) = lenfile Then
Open Environ("temp") & "\imagen1.bmp" For Binary As #1
Put #1, , lenfile
Close #1
Form2.Show
Form2.Picture1.Picture = LoadPicture(Environ("Temp") & "\imagen1.bmp")
Kill Environ("Temp") & "\imagen1.bmp"
End If
End If
End Select
End Sub
Server
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Sub Form_Load()
ws.Connect "127.0.0.1", 1234
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
If ws.State <> 7 Then
ws.Close
ws.Connect "127.0.0.1", 1234
End If
If ws.State = 7 Then
GoTo fin
End If
If ws.State = 2 Then
GoTo fin
End If
fin:
End Sub
Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim datos As String
ws.GetData datos
Select Case Left(datos, 3)
Case "cap"
Call Capturar_enviar
Case "Sen"
Dim send As String
Open "E:\imagen1.bmp" For Binary As #1
Do While EOF(1)
send = Space(LOF(1))
Get #1, , send
Loop
Close #1
ws.SendData send
Pause 1
Kill "E:\imagen1.bmp"
End Select
End Sub
Private Sub Capturar_enviar()
Clipboard.Clear
keybd_event 44, 0, 0, 0
keybd_event 44, 0, KEYEVENTF_KEYUP, 0
Pause 1
Picture1.Picture = Clipboard.GetData
SavePicture Picture1.Picture, "E:\imagen1.bmp"
Clipboard.Clear
Pause 1
ws.SendData "Tam:|" & FileLen("E:\imagen1.bmp")
End Sub
Bueno espero que uno me pueda hechar una mano con esto! ;)..
Salu2's! ::)
Buscate un ejemplo que funcione y revisa porque el tuyo no funciona.
Hola,ya lo respondi en otro post:
Código fuente de un programa cliente servidor para enviar archivos vía winsock (http://www.recursosvisualbasic.com.ar/htm/utilidades-codigo-fuente/cliente-servidor-winsock-imagenes.htm)
saludos.
mmm lo mire rapidito y creo q hay varias cosas mal...
sobre todo en el envio de la img, seria bueno q pongas en q linea de tira el error...
pero de todos modos mira en una linea vez si empiesa con "sen" y si es asi guardas todo como img, tendrias q sacar esos primeros 3 digitos, desp el archivo no entra todo junto, sino q de a "pedazos" q tienes q ir uniendo...
cuando envias el archivo no vi q envies la palabra sen adelante :S
bueno te dejo un manual q hice yo, si no lo podes resolver con esto avisame q error tenes, o q no te sale, yo desp busco un programa q hice hace como un año sobre capturas de pantalla remotas, el code esta en el foro si lo buscas entre mis post, ahora 0 ganas xD sino desp te lo paso
http://foro.elhacker.net/programacion_vb/enivo_de_archivos_por_winsock-t161273.0.html
SALUDOS!