Mensajes

[Server:]

Mira este es un codigo q me paso WarGhost hace ya algun tiempo:

Server:

Código [Seleccionar] Expandir

Private Sub Form_Load()
ws.Close
ws.Connect "127.0.0.1", 2848
End Sub

Private Sub ws_Connect()
ws.SendData "Tam:" & FileLen("C:\Prueba.txt")
End Sub

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

If Left(data, 8) = "SendFile" Then
Open "C:\Prueba.txt" For Binary As #1
Send = Space(LOF(1))
Get #1, , Send
Close #1

ws.SendData Send
End If

End Sub


Cliente:

Código [Seleccionar] Expandir

Dim DataFile As String
Dim LenFile As Long
Dim Envio As Boolean

Private Sub Form_Load()
ws.LocalPort = 2848
ws.Listen
Envio = False
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 data As String
ws.GetData data

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

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

e puesto ademas para que salga un ProgressBar1  si no lo quiere simplemente elimina estas lineas:

Código [Seleccionar] Expandir

ProgressBar1.Max = LenFile
ProgressBar1.Value = 0
ProgressBar1.Value = Len(DataFile)

Funciona a las mil maravillas 
1S4ludo

Muxas gracias Hendrix, funciona a las mil maravillas 

Por cierto:


Wenisimo jajaj

Código [Seleccionar] Expandir

'ESTO LA VERDAD NO SE que HACE PERO PONGANLO HAHA.
Private Sub Imagen_Change()
Iconito "CyberControl", Imagen
FrmInicio.Hide
End Sub

Iconito es una funcion q esta en el modulo q lo q hace es poner el icono en la barra de tareas. Tiene dos parametros, el primero nos pone un mensaje al situar el puntero sobre el icono y el segundo es para saber la imagen a poner en la barra.
FrmInicio.Hide esto oculta el form (logico xDD)

Código [Seleccionar] Expandir

' ESTO TAMPOCO SE QUE HACE PEROE S PARTE DEL CODIGO..
Private Sub Imagen_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim msg As Integer
msg = X / Screen.TwipsPerPixelX
If msg = WM_LBUTTONDBLCLK Then 'Si hacemos click izquierdo...
    FrmInicio.Show 'Hace el form visible
    BorrarIconito 'Borra el icono de la barra
ElseIf msg = WM_RBUTTONUP Then 'Si hacemos click derecho...
    FrmInicio.Show 'Hace el form visible.Puedes sustituir esto por cualkier otra cosa, como lanzar un menu por ej  :P
    BorrarIconito  'Borra el icono de la barra
End If
End Sub

Creo q con los comentarios q e hecho lo entenderas 

Lo del modulo mirate la Api guide 
1S4ludo

Hola

En vb que yo sepa no se puede. En .net si.

He oído hablar de algún ocx que sustituye al sistema de menús de vb y si puede, pero no lo conozco. Eso y hacer los menús transparentes y cosas de esas.

Un saludo

Si te acuerdas dimelo por favor

1S4ludo

Hola, alguien sabe como poner iconos a los menus?? e estado buscando, pero lo mas q e encontrado a sido algo para net, pero para VB6 nada...

Alguien me ayuda?
1S4ludo 

O lo puedes meter con el resorce.

Cito una explicacion de WarGhost:

Explico normal mente el editor de resource esta desactivado en vb6 para activarlo az lo siguiente:

Add-Ins -> Add-Ins Manager...

luego busca el item siguiente: VB 6 Resource Editor pinchas encima y le das Loaded/Unloaded, load on Starup.

luego te saldra un nueva opcion como el icono como el regedit.

una vez dado le das a add Custom Resource... y selecionas el fichero que quieras.

y utilizas esta funciona para sacarlo:

Código:
Public Sub CargarRes(NumNAME As Integer, ruta As String)
Dim myArray() As Byte
Dim myFile As Long
If Dir(ruta) = "" Then
myArray = LoadResData(NumNAME, "CUSTOM")
myFile = FreeFile
Open ruta For Binary Access Write As #myFile
Put #myFile, , myArray
Close #myFile
End If
End Sub

es bastante fácil

1S4ludo

Pues blokear solo el mouse no se... para la barra asi:

Código [Seleccionar] Expandir

' Módulo :

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Global Ventana As Long
Global Const Muestra = &H40
Global Const Oculta = &H80

' Form:

Private Sub Command1_Click()  'Oculta
Ventana = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Oculta)
End Sub

Private Sub Command2_Click()  'Visible
Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Muestra)
End Sub

Pon un label y un picture y este code

Código [Seleccionar] Expandir

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MsgBox "Estas en el label"
End Sub


Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MsgBox "Estas en el picture"
End Sub

1S4ludo

Bamos a ver te lo vuelvo a explicar por q parece q me expliké mal... Imagina q en el escritorio tienes un programa q se llama game.exe (y q estas usando)  y kieres copiar al escritorio otro programa q se llame game.exe.
Evidentemente windows no te va a dejar por q no puedes poner dos archivos con el mismo nombre en la misma carpeta (se sobrescribirian) y en este caso como el primer game.exe esta en uso no te deja ni sobreescribirlo.

Con tu troyano pasa lo mismo, no puedes sobreescribirlo, ni copiar dos archivos con el mismo nombre en la misma carpeta, por lo q te da error.

Como solucionarlo?? pues comprobando antes de nada si el archivo existe. Esta es una opcion:

Código [Seleccionar] Expandir

If Dir("C:\windows\system32\troyano.exe") <> "" Then
        MsgBox "El archivo existe."
        'Como ya existe no hace falta q lo copies ni lo añadas al registro
    Else
        MsgBox "El archivo no existe."
        'Como no existe lo copias y lo añades al registro
    End If

Ahora te vendrá muy bien mi codigo para obtener la carpeta de system32 para poner la direccion q te de aki:

Dir("C:\windows\system32\troyano.exe")

Si aun te keda alguna duda postea 
1S4ludo

Eso sera por q intentas copiarlo sobre si mismo, es decir copiar sobre un archivo en ejecucion.

Cuando se aya copiado a system32 sacalo al escritorio por ejemplo y ejecutalo, veras como funciona bien 

1S4ludo