Que tal compañeros, acudo a ustedes porque tengo problemas, veran, tengo un equipo que es desatendido (sin teclado, mouse ni monitor), vamos, un servidor casero que cicla una determinada secuencia de tareas, pero como me era mucho trabajo estar conectado el vnc desde equipos que no tengo instalado el vnc estoy desarrollando una pequeña aplicacion para tomar una screenshot del escritorio del servidor y mandarla a una aplicacion cliente cada determinado tiempo y asi poder verificar el estado del equipod desde una pagina en internet, ahora, ya tengo "casi" todo, mi problema es que cuando manda la imagen al cliente esta llega incompleta (no llegan todos los bytes...) y no entiendo que es lo que estoy haciendo mal, si alguien es tan amable de checar el codigo y ver que problema hay se lo agradeceria mucho
Este es el codigo del cliente (el que envia la imagen)
Código vb:
Ver originalPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Buffer As String
Winsock1.GetData Buffer
estado.Text = estado.Text + vbCrLf + "Comando: " + Buffer
estado.SelStart = Len(estado.Text)
comandos (Buffer)
End Sub
Public Function comandos(comando As String)
If comando = "screenshot" Then
Picture1.Picture = CaptureScreen()
SavePicture Picture1.Picture, "c:\screenshot.bmp"
urlFile.Text = "C:\screenshot.bmp"
Open urlFile.Text For Binary As #1
Winsock1.SendData "EMA" & urlFile.Text & "LAR" & LOF(1)
peso.Text = LOF(1)
Close #1
On Error GoTo ema
Dim Buf As String * 1024
Dim Todo As String
Open urlFile.Text For Binary As #1
barra.Min = 0
barra.Max = LOF(1)
Do While Not EOF(1)
DoEvents
Get #1, , Buf
Todo = Todo & Buf
If Len(Todo) <= barra.Max Then barra.Value = Len(Todo)
Loop
Close
Winsock1.SendData Todo
estado.Text = estado.Text & vbCrLf & "Enviando archivo " & Len(Todo) & " bytes..."
estado.SelStart = Len(estado.Text)
Exit Function
ema:
MsgBox Err.Description
End If
End Function
Public Function sendfile(txt As String)
On Error GoTo ema
Dim Buf As String * 1024
Dim Todo As String
Open urlFile.Text For Binary As #1
barra.Min = 0
barra.Max = LOF(1)
Do While Not EOF(1)
DoEvents
Get #1, , Buf
Todo = Todo & Buf
If Len(Todo) <= barra.Max Then barra.Value = Len(Todo)
Loop
Close
Winsock1.SendData Todo
Exit Function
ema:
MsgBox Err.Description
End Function
Y este es el codigo del servidor (el que recibe la imagen)
Código vb:
Ver originalPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Texto As String
Winsock1.GetData Texto
If Mid(Texto, 1, 3) = "EMA" Then
infoarchivo (Texto)
Exit Sub
End If
If Mid(Texto, 1, 3) = "LAR" Then
'Frame1.Caption = "Archivo : " & Mid(Texto, 4, Len(Texto) - 3) & " bytes."
Largo = CLng(Mid(Texto, 4, Len(Texto) - 3))
Exit Sub
End If
Archivo = Archivo & Texto
If Len(Archivo) >= Largo Then
Common.DialogTitle = "Guardar archivo..."
Common.FileName = nameFile.Caption
Common.ShowSave
Open Common.FileName For Binary As #1
Put #1, , Archivo
Largo = 0
Archivo = ""
Close #1
End If
End Sub
Public Function infoarchivo(txt As String)
Dim i As Long
Dim Nom As String
txt = Mid(txt, 4, Len(txt) - 3)
For i = 1 To Len(txt)
If Mid(txt, i, 3) = "LAR" Then
Nom = Left(txt, i - 1)
Largo = CLng(Mid(txt, i + 3, Len(txt) - i))
nameFile.Caption = Nom
sizeFile.Caption = Largo
estado.Text = estado.Text & vbCrLf & "Archivo : " & Largo & " bytes..."
End If
Next i
End Function
De antemano les agradesco todo la ayuda que me puedan brindar