2024年3月7日发(作者：)
创建文件系统对象，用以处理驱动器、文件夹和文件
Set fso = Object("stemObject") '创建系统Shell对象，用以运行程序等等
Set WshShell = Object("") '如果找到文件“D:刀剑”则
if ists("D:刀剑") then'运行“D:刀剑Online刀剑”
("D:刀剑Online刀剑") else'否则，如果找到“”则
if ists("") then '运行“”
("") else '否则运行“D:刀剑Online刀剑”
("D:刀剑Online刀剑") '根据条件执行语句结束
end if
end if
--------------------------------------------------------------------------------
'写入注册表后再运行指定程序
dim Wsh
Set Wsh = Object("")
te "HKCUSOFTWAREAUDITIONAUTOSTART",0,"REG_DWORD"
te "HKCUSOFTWAREAUDITIONPATH","G:网络游戏劲舞团1.5","REG_SZ"
te "HKCUSOFTWAREAUDITIONVERSION",1010,"REG_DWORD"
""
--------------------------------------------------------------------------------
'删除QQ用户文件
Dim fso, folderspec, f, f1, fc
folderspec = "f:Program FilesTencentQQ" '设置你的QQ文件夹
Dim Re Set
Re = New RegExp
n = "^d{4,13}$"
Set fso = CreateObject("stemObject")
Set f = der(folderspec)
Set fc = ders
For Each f1 in fc
If () Then
On Error Resume Next
(true) On Error GoTo 0
End If
Next
-------------------------------------------------------------------------------
-
'隔5分钟运行一次批处理程序Dim Wsh
Set Wsh = Object("")
Do
"d:" '你要执行的批处理
(300000)
Loop
--------------------------------------------------------------------------------
将域用户或租添加到本地组
Set objGroup = GetObject(WinNT://./Administrators)
Set objUser = GetObject(WinNT://testnet/Engineers)
(h)
--------------------------------------------------------------------------------
修改本地管理员密码
Set objcnlar = GetObject(WinNT://./administrator, user)
sword P@ssW0rd
o
--------------------------------------------------------------------------------
弹出 YES or NO 的对话框，不同的选择执行不同的代码
intAnswer = Msgbox("是否", vbYesNo, Delete Files)
If intAnswer = vbYes Then
Msgbox You answered yes.
Else Msgbox You answered no.
End If
--------------------------------------------------------------------------------
'弹出 YES or NO 的对话框，不同的选择执行不同的代码
intAnswer = Msgbox ("是否真的要删除文件?", vbYesNo, "提示:")
If intAnswer = vbYes Then
Msgbox "您选择的是Y"
Else
Msgbox "您选择的是N"
End If
--------------------------------------------------------------------------------
运行CMD命令行命令
set obshell=object()
(ipconfig),,true
如果要运行的命令中包含双引号，可使用&chr(34)&代替
--------------------------------------------------------------------------------
忽略代码错误继续执行
On Error Resume Next
放置于代码的最开头，当代码运行出错后并不停止跳出而是继续执行下一条。适当应用会很有效果。
--------------------------------------------------------------------------------
注册表的修改，读取，删除，创建Set wso = CreateObject() '声明
te %Path% '创建子键
te %Path%,%Value% '修改默认键值
te %Path%,%Value%,%RegType% '修改特定类型的键值
'(字符串值 REG_SZ 可扩充字符串值 REG_EXPAND_SZ DWORD值 REG_DWORD 二进制值
REG_BINARY)Set WSHShell= Object()
d (%Path%) '读取注册表子键或键值(一般用于判断某一事件是否执行)Set
wso = CreateObject()
ete %Path% '删除子键或键值
'(根键缩写HKEY_CLASSES_ROOT 为HKCR HKEY_CURRENT_USER 为HKCU HKEY_LOCAL_MACHINE
为HKLM,其余无)例子:
Set wso = CreateObject()
te HKLMSOFTWAREMicrosftWindows NT#1
te HKLMSOFTWAREMicrosftWindows NT#1,0
te HKLMSOFTWAREMicrosftWindows NT#1#2,0,REG_BINARY
ete HKLMSOFTWAREMicrosftWindows NT#1
--------------------------------------------------------------------------------
'文件的复制，删除，创建，简单的写入
Set fso = Object(stemObject) ‘声明
Set f = TextFile(%PATH%) '创建文件,其中f可任意，包含缩略名
ine(VBS) '写入文件一行内容,该命令功能太简单,目前看来只能用于TXT文件
'关闭打开的文件
set c=e(%path%) ’拷贝某文件
(%PATH2%) '拷贝文件到指定地点
file(%PATH%) '删除文件例子:
Set fso = Object(stemObject)
Set f=TextFile("C:")
ine(VBS)
set e=e(C:)
(D:)
file(C:)
--------------------------------------------------------------------------------
向应用程序输出简单的连串指令
dim program1 '声明变量program1
program1= %Path% '应用程序路径
set wshshell=createobject() '声明引用函数
set oexec=(program1) '运行程序
2000 '延迟2000毫秒
ivate %WindowsName% '指定要激活的程序窗口标题
ys +{%KeyBoardName%} '第一次输出键盘按键指令前要加+
ys 555555 '在程序输入栏中输入运用该系列命令须首先确定程序可以实施连串的键盘操作例子:
dim program1
program1="D:Program "
set wshshell=CreateObject()
set oexec=(program1)
2000
ivate "QQ登录"
ys +{TAB}
ys 250481892
2000
ys {TAB}
ys ****************
2000
ys {ENTER}
--------------------------------------------------------------------------------
文件夹的简单操作
Set fso = Object(stemObject) ‘声明
Set f = Folder(%PATH%) '创建文件夹
Set e = getFolder(%PATH%) '类似于“绑定目标”
(%PATH2%) '复制文件夹
folder(%PATH%) '删除文件夹例子:
Set fso = Object(stemObject)
Set f = Object("C:sample")
("D:sample")
folder("C:sample")
'(由上例可以看出，文件夹的操作很多是和文件的操作相通的，因此VBS文件具有很多命令的统一性)
--------------------------------------------------------------------------------
将某一指定文件夹的所有只读文件转为可读文件
Const ReadOnly = 1 ‘设只读属性对应值为1Set FSO =
CreateObject(stemObject) '声明
Set Folder = der(%PATH%) ’绑定文件夹
Set colFiles = ‘文件夹所有文件For Each objFile in colFiles ’下列
语句应用于文件夹所有文件
If utes AND ReadOnly Then '这是关键之处，这里应用了If判断语句，来检测文件属性是否为只读
utes = utes XOR ReadOnly '对判断结果为Ture（默认为True）’执行XOR逻辑运算，将其改为可读
End If ‘结束判断
Next
--------------------------------------------------------------------------------
将Word文件另存为文本文件
Const wdFormatText = 2 '设置常数值
'(当该值为8时另存为HTML文档，为11时另存为XML文档)
Set objWord = CreateObject(ation) '申明调用函数
Set objDoc = (%Path%) '打开某DOC文件
%PATH2%, wdFormatText '另存为„„
例子:
Const wdFormatText = 2
Set objWord = CreateObject(ation)
Set objDoc = ("d:")
"g:", wdFormatText
--------------------------------------------------------------------------------
禁用开始菜单选项
Dim ChangeStartMenu
Set ChangeStartMenu=Object("")
RegPath="HKCRSoftwareMicrosoftWindowsCurrentVersionPolicies"
Type_Name="REG_DWORD"
Key_Data=1
StartMenu_Run="NoRun"
StartMenu_Find="NoFind"
StartMenu_Close="NoClose"
Sub Change(Argument)
te RegPath&Argument,Key_Data,Type_Name
MsgBox("Success!")
End Sub
Call Change(StartMenu_Run) '禁用“开始”菜单中的“运行”功能
Call Change(StartMenu_Find) '禁用“开始”菜单中的“查找”功能
Call Change(StartMenu_Close) '禁用“开始”菜单中的“关闭系统”功能
--------------------------------------------------------------------------------
重新启动指定的IIS服务Const ADS_SERVICE_STOPPED = 1
Set objComputer = GetObject("WinNT://MYCOMPUTER,computer")
Set objService = ect("Service","MYSERVICE")
If ( = ADS_SERVICE_STOPPED) Then
End If
--------------------------------------------------------------------------------
添加系统自动启动程序Dim AutoRunProgram
Set AutoRunProgram=Object("")
RegPath="HKLMSoftwareMicrosoftWindowsCurrentVersionRun"
Type_Name="REG_SZ"
Key_Name="AutoRun"
Key_Data="C:"
'该自启动程序的全路径文件名
RegPath&Key_Name,Key_Data,Type_Name
'在启动组中添加自启动程序
======打开迅闪菜单的同时连接虚拟磁盘的VBS======
Set WshShell = Object("")
Return = ("c:client新调用.exe",0,true)
Return = ("iscsicli AddTargetPortal 192.168.0.9 3260",0,true)
Return = ("iscsicli LoginTarget :00 T
* * * * * * * * * * * * * * * 0",0,true)
Set WshShell = Nothing
--------------------------------------------------------------------------------
======开机VBS调用远程批处理（延时+无黑屏后台运行的效果）======
DIM objShell
set objShell=Object("")
(10000)
iReturn=(" /C ", 0, TRUE)
--------------------------------------------------------------------------------
实现整理磁盘碎片功能Set WshShell = Object("")
Dim fso, d, dc
Set fso = CreateObject("stemObject")
Set dc =
For Each d in dc
If ype = 2 Then
Return = ("defrag " & d & " -f", 1, TRUE)
End If
Next
Set WshShell = Nothing
--------------------------------------------------------------------------------
计划任务定时调用VBS脚本(未知功能)Option Explicit
On Error Resume Next'生成列表的文件类型
Const sListFileType = "wmv,rm,wma"'文件所在的相对路径
Const sShowPath="."'排序类型的常量定义
Const iOrderFieldFileName = 0
Const iOrderFieldFileExt = 1
Const iOrderFieldFileSize = 2
Const iOrderFieldFileType = 3
Const iOrderFieldFileDate = 4'排序顺逆的常量定义
const iOrderAsc = 0
const iOrderDesc = 1'生成列表的文件数量
const iShowCount = 20'显示的日期格式函数
Function Cndate2(date1,intDateStyle)
dim strdate,dDate1
strdate=cstr(date1)
If Isdate(strdate) Then
If Left(cstr(strdate),1)="0" Then
dDate1=Cdate("20"+cstr(strdate))
else
dDate1=Cdate(strdate)
End If
Else
dDate1=Now()
End If
Select case intDateStyle
Case 1:
Cndate2 = Cstr(Year(dDate1))+"-"+Cstr(Month(dDate1))+"-"+Cstr(Day(dDate1))
Case 2:
Cndate2 = Cstr(Month(dDate1))+"-"+Cstr(Day(dDate1))
Case 3:
Cndate2 = Cstr(Month(dDate1))+"月"+Cstr(Day(dDate1))+"日"
Case 4:
Cndate2 = Cstr(year(dDate1))+"年"+ Cstr(Month(dDate1))+"月"+Cstr(Day(dDate1))+"日"
End Select
End Function
Function ListFile(strFiletype,intCompare,intOrder,intShowCount)
Dim sListFile
Dim fso, f, f1, fc, s,ftype,fcount,i,j,k
Dim t1,t2,t3,t4,t5
Dim iMonth,iDay
sListFile = ""
Set fso = CreateObject("stemObject")
Set f = der(sShowPath)
Set fc =
fcount =
redim arrFiles(fcount,5)
redim arrFiles2(fcount,5)
i=0
'排序
For Each f1 in fc
ftype = right(,len()-instrrev(,"."))
arrFiles(i,0) =
arrFiles(i,1) = ftype
arrFiles(i,2) =
arrFiles(i,3) =
arrFiles(i,4) = stModified
i=i+1
Next
For i=0 to fcount-1
for j=i+1 to fcount-1
select Case intCompare
Case iOrderFieldFileName,iOrderFieldFileExt,iOrderFieldFileType:
If arrFiles(i,intCompare)>arrFiles(j,intCompare) then
t1 = arrFiles(i,0)
t2 = arrFiles(i,1)
t3 = arrFiles(i,2)
t4 = arrFiles(i,3)
t5 = arrFiles(i,4)arrFiles(i,0) = arrFiles(j,0)
arrFiles(i,1) = arrFiles(j,1)
arrFiles(i,2) = arrFiles(j,2)
arrFiles(i,3) = arrFiles(j,3)
arrFiles(i,4) = arrFiles(j,4)arrFiles(j,0) = t1
arrFiles(j,1) = t2
arrFiles(j,2) = t3
arrFiles(j,3) = t4
arrFiles(j,4) = t5
end if
Case iOrderFieldFileSize:
If cdbl(arrFiles(i,intCompare))>cdbl(arrFiles(j,intCompare)) then
t1 = arrFiles(i,0)
t2 = arrFiles(i,1)
t3 = arrFiles(i,2)
t4 = arrFiles(i,3)
t5 = arrFiles(i,4)arrFiles(i,0) = arrFiles(j,0)
arrFiles(i,1) = arrFiles(j,1)
arrFiles(i,2) = arrFiles(j,2)
arrFiles(i,3) = arrFiles(j,3)
arrFiles(i,4) = arrFiles(j,4)arrFiles(j,0) = t1
arrFiles(j,1) = t2
arrFiles(j,2) = t3
arrFiles(j,3) = t4
arrFiles(j,4) = t5
end if
Case iOrderFieldFileDate:
If Cdate(arrFiles(i,intCompare))>Cdate(arrFiles(j,intCompare)) then
t1 = arrFiles(i,0)
t2 = arrFiles(i,1)
t3 = arrFiles(i,2)
t4 = arrFiles(i,3)
t5 = arrFiles(i,4)arrFiles(i,0) = arrFiles(j,0)
arrFiles(i,1) = arrFiles(j,1)
arrFiles(i,2) = arrFiles(j,2)
arrFiles(i,3) = arrFiles(j,3)
arrFiles(i,4) = arrFiles(j,4)arrFiles(j,0) = t1
arrFiles(j,1) = t2
arrFiles(j,2) = t3
arrFiles(j,3) = t4
arrFiles(j,4) = t5
end if
End Select
next
next
'生成列表
sListFile = sListFile + ("
class=PageListTitleTd>") sListFile = sListFile + ("名称") sListFile = sListFile + (" | ") sListFile = sListFile + ("媒体") sListFile = sListFile + (" | ") sListFile = sListFile + ("大小") sListFile = sListFile + (" | ") sListFile = sListFile + ("类型") sListFile = sListFile + (" | ") sListFile = sListFile + ("更新时间") sListFile = sListFile + (" |
| ") sListFile = sListFile + (" align=absbottom> CStr(arrFiles(j,0)) &">" & arrFiles(j,0) &" If datediff("h",arrFiles(j,4),now)<=24 then sListFile = sListFile + "" end if sListFile = sListFile + " | " sListFile = sListFile + ("") '根据文件名规则,生成中文提示 select case left(arrFiles(j,0),3) case "sc2": sListFile = sListFile + "四川卫视 " case "sd2": sListFile = sListFile + "山东卫视 " case "gd2": sListFile = sListFile + "广东卫视 " case "gx2": sListFile = sListFile + "广西卫视 " end select '日期显示 If isnumeric(left(right(arrFiles(j,0),8),2)) then iMonth = cint(left(right(arrFiles(j,0),8),2)) iDay = cint(left(right(arrFiles(j,0),6),2)) sListFile = sListFile + cstr(iMonth)+"月" + cstr(iDay)+"日" sListFile = sListFile + (" | ") Else arrFiles(j,0) end if If arrFiles(j,2)>1024*1024 then sListFile = sListFile + cstr(round(arrFiles(j,2)/1024/1024)) sListFile = sListFile + ("MB") else sListFile = sListFile + cstr(round(arrFiles(j,2)/1024)) sListFile = sListFile + ("KB") end if sListFile = sListFile + (" | ") ") sListFile = sListFile + cstr(arrFiles(j,3)) sListFile = sListFile + (" | ") ") sListFile = sListFile + (Cndate2(arrFiles(j,4),4)) sListFile = sListFile + (" | ")
ListFile = sListFile
End Function'生成调用文件的过程
Sub ShowFileListContent()
Dim tUpdatetime,sUpdateContentDim fso,f,f_js,f_js_write
Set fso = CreateObject("stemObject")
Set f = der(sShowPath)
Set f_js = e("")'比较调用文件与文件夹的最后修改时间
If stModified<>f_stModified then
sUpdateContent =
ListFile(sListFileType,iOrderFieldFileDate,iOrderDesc,iShowCount)
Set f_js_write = TextFile("", True)
'JS调用就加上下面这对
' f_js_ ("('")
f_js_ (sUpdateContent)
' f_js_ ("')")
f_js_
End If
End SubCall ShowFileListContent()
--------------------------------------------------------------------------------
启用和禁用网卡'---disable/enable network interface card
'usage: cscript /nologo
sConnectionName = "LAN" '本地连接
sEnableVerb = "启用(&A)" '启用(&A)
sDisableVerb = "禁用(&B)" '禁用(&B)
sFolderName = "网络和拨号连接" '网络和拨号连接Const ssfCONTROLS = 3
set shellApp = createobject("ation")
set oControlPanel = ace(ssfCONTROLS)
set oNetConnections = nothing
for each folderitem in
if = sFolderName then
set oNetConnections = der: exit for
end if
next
if oNetConnections is nothing then
end if
set oLanConnection = nothing
for each folderitem in
if lcase() = lcase(sConnectionName) then
set oLanConnection = folderitem: exit for
end if
next
if oLanConnection is nothing then
end if
bEnabled = true
set oEnableVerb = nothing
set oDisableVerb = nothing
s = "Verbs: " & vbcrlf
for each verb in
s = s & vbcrlf &
if = sEnableVerb then
set oEnableVerb = verb
bEnabled = false
end if
if = sDisableVerb then
set oDisableVerb = verb
end if
next
if oDisableVerb is nothing and oEnableVerb is nothing then
end if
if bEnabled then
else
end 1000
--------------------------------------------------------------------------------
对比删除文件dim sdir,ddir
'远程目录
sdir="192.168.0.200vbszz"
'本地目录
ddir="c:c"
function comparefile(sdir,ddir)
dim Fso,dFol,dfs,sf1,f1
set Fso=CreateObject("stemObject")
if not(exists(sdir)) then
msgbox chr(34) &sdir &chr(34) &"文件夹不存在，请确认！",64
exit function
end if
if not(exists(ddir)) then
msgbox chr(34) &ddir &"""文件夹不存在，请确认！",64
exit function
end if
if right(sdir,1)<>"" then sdir=sdir &""
set dFol=der(ddir)
set dfs=
for each f1 in dfs
if ists(sdir & ) then
set sf1=e(sdir & )
if stModified <>stModified or <> then
end if
else
(true)
end if
next
dim fols
set fols=ders
for each f1 in fols
if not exists(sdir &) then
true
else
comparefile sdir & ,
end if
next
end function
comparefile sdir,ddir
-------------------------------------------------------------------------------
游戏执行
On Error Resume Next
dim msg,fso,shell
Set fso = object("stemobject")
set wshshell = Object("")
set shell = object("")
IF (ists("e:劲乐团") and ists("e:劲乐团")) Then
"c: /s e:劲乐团 "
"e:劲乐团"
Else
msg=msgbox("注册表未导入或游戏程序不存在，游戏可能无法启动，如无法进游戏请叫网管~",1,"出问题啦！！")
"e:劲乐团"
end if
--------------------------------------------------------------------------------
'虚拟光驱自动加载镜像文件
Dim Wsh,DMpath,ISOpath
DMpath = "X:" '设置D-Tools路径
ISOpath = "Z:大富翁七" '设置镜像文件路径
Set Wsh = Object("")
chr(34) & DMpath & chr(34) &" -mount 0,"&chr(34)&ISOpath&chr(34),0,true
3000 '最好延时几秒等待镜像加载完毕 1000 = 1 秒
"Z:大富翁七"
Set WSH = Nothing
--------------------------------------------------------------------------------
获得特定文件夹的路径
Set wsShell = CreateObject("")
DesktopPath = lFolders("Desktop")
--------------------------------------------------------------------------------
'获取当前用户名称
Set WshNetwork = Object("k")
UserName= me
msgbox UserName
--------------------------------------------------------------------------------
获取系统变量%SystemRoot%（当然其他的系统变量可以类推，只是不只是不是都要通过PROCESS中转一下
Set fso = CreateObject("stemObject")
Set WshSysEnv = nment("PROCESS")
SystemRoot = WshSysEnv("WINDIR")
--------------------------------------------------------------------------------
修改本地管理员密码
Set objcnlar = GetObject("WinNT://./administrator, user")
sword "P@ssW0rd"
o
--------------------------------------------------------------------------------
延时启动指定程序
Dim Wsh
Set Wsh = Object("")
(60000)'单位为毫秒
"D:",,True
Set Wsh=NoThing
忽然想到要用VBS来代替BAT或CMD文件进行命令集成，于是开始下苦工学习了一番！在网上找了好久终于找到东西。
自动导入注册表的，带检测：
On Error Resume Next
dim msg,fso,shell
Set fso = ｏｂｊｅｃｔ("stemｏｂｊｅｃｔ")
set wshshell = Object("")
set shell = ｏｂｊｅｃｔ("")
IF (ists("e:劲乐团")) Then
"c: /s e:劲乐团 "
"e:劲乐团"
Else
msg=msgbox("注册表未导入，游戏可能无法启动，如无法进游戏请叫网管~",1,"出问题啦！！")
"e:劲乐团"
end if
不带检测的：
On Error Resume Next
Dim oShell,fso
Set oShell = Object("")
set fso = CreateObject("stemｏｂｊｅｃｔ")
"regedit /s "
"d:网络游戏劲乐团"
自动加载虚拟光驱的：
Dim oShell
Set oshell= Object("")
"c:progra~1daemon~ -mount 0,D:lan战地"
5000
"D:lan战地"
另一例子：
Dim Wsh,DMpath,ISOpath
DMpath = "X:" '设置DM路径
ISOpath = "Z:大富翁七" '设置镜像文件路径
Set Wsh = Object("")
chr(34) & DMpath & chr(34) &" -mount 0,"&ISOpath,0,true
3000 '最好延时几秒等待镜像加载完毕 1000 = 1 秒
"Z:大富翁七"
Set WSH = Nothing
//每次开机的时候自动导入注册表和程序
Option Explicit
Dim Folder
Folder = "d:aaa" '设置你要执行的文件夹
Dim Wsh,fso
Set Wsh = Object("")
Set fso = CreateObject("stemObject")
Dim f,fc,f1,ext
Set f = der(Folder)
Set fc =
For Each f1 in fc
ext = LCase(ensionName(f1))
Select Case ext
Case "exe"
f1,,true
Case "reg"
"Regedit /s "& f1,,true
end Select
Next
Set fso=NoThing
Set Wsh = Nothing
//排除指定文件或文件夹删除多余的文件或文件夹，黑火原创
Option Explicit
''''''''''''''说明''''''''''''
'网盟-黑火制作，送给需要的朋友。
'配置文件“”的格式如下：
'要删除什么(文件|目录)=要执行删除的文件夹=排除1;排除2;排除3............
'配置文件可以有多行，以便对多个目录进行操作。
'配置文件里以“/”开头的行为注释行。
'排除多个内容时，使用分号“;”进行分隔。
'↓↓↓ 配置文件例子：↓↓↓
'/配置文件开始
'目录=D:=System Volume Information;网络游戏;单机游戏;小游戏
'目录=C:Program Files=qq;WinRAR
'文件=D:网络游戏=文件;文件
'/配置文件结束
'''''''''''''说明完''''''''''''
Dim Fso,Listfile,objListfile
Listfile = "" '设置配置文件路径,如果配置文件和脚本放在一起，请保持原样
If Listfile = "" Then Listfile = ""
Set Fso = CreateObject("stemObject")
On Error Resume Next
Set objListfile = xtFile(Listfile,1)
If Err Then
Msgbox "没有找到配置文件 "&Listfile,16,"错误"
End If
On Error GoTo 0
Dim flnum,fdnum,t1,t2,tm
flnum=0
fdnum=0
t1 = timer()
Dim Myline,LineArr,ListArr
Do While fStream <> True
Myline = LCase(Replace(ne,"==","="))
If Left(Myline,1) = "/" Then
'ne
ElseIf CheckLine(Myline) = 2 Then
LineArr = Split(Myline,"=")
'DoFolder = LineArr(1)
ListArr = Split(LineArr(2),";")
'MsgBox LineArr(0)
If LineArr(0) = "目录" Then DelFolder LineArr(1),ListArr
If LineArr(0) = "文件" Then DelFile LineArr(1),ListArr
End If
Loop
t2 = timer()
tm=cstr(int(( (t2-t1)*10000 )+0.5)/10)
MsgBox "扫描完毕，共删除 "&fdnum&" 个目录, "&flnum& "个文件。"& vbCrLf &"耗时 "&tm&" 毫秒",64,"执行完毕"
'不需要显示报告的话，注释掉上面这一行
Set Fso=NoThing
Sub DelFolder(Folder,ListArr)
Dim objFolder,subFolders,subFolder
Set objFolder=der(Folder)
Set subFolders=ders
For Each subFolder In subFolders
If Not InArray(LIstArr,LCase()) Then
On Error Resume Next
(True)
If Err Then
Msgbox "不能删除目录，请检查 "&subFolder,16,"错误"
Else
fdnum = fdnum + 1
End If
On Error GoTo 0
End If
Next
End Sub
Sub DelFile(Folder,ListArr)
Dim objFolder,Files,File
Set objFolder=der(Folder)
Set Files=
For Each File In Files
If Not InArray(LIstArr,LCase()) Then
On Error Resume Next
(True)
If Err Then
Msgbox "不能删除文件，请检查 "&File,16,"错误"
Else
flnum = flnum + 1
End If
On Error GoTo 0
End If
Next
End Sub
Function CheckLine(strLine)
Dim LineRegExp,Matches
Set LineRegExp = New RegExp
n = ".=."
= True
Set Matches = e(strLine)
CheckLine =
End Function
Function InArray(Myarray,StrIn)
Dim StrTemp
InArray = True
For Each StrTemp In Myarray
If StrIn = StrTemp Then
Exit Function
Exit For
End If
Next
InArray = False
End Function
！获得特定文件夹的路径（例如当前用户的桌面在磁盘中的实际位置，等等，相当于vc中的SHGetSpecialFolderPath（）函数）
Set wsShell = CreateObject("")
DesktopPath = lFolders("Desktop")
！获取当前用户名称
Set WshNetwork = Object("k")
UserName= me
！获取系统变量%SystemRoot%（当然其他的系统变量可以类推，只是不只是不是都要通过PROCESS中转一下）
Set fso = CreateObject("stemObject")
Set WshSysEnv = nment("PROCESS")
SystemRoot = WshSysEnv("WINDIR")
！将域用户或租添加到本地组
Set objGroup = GetObject("WinNT://./Administrators")
Set objUser = GetObject("WinNT://testnet/Engineers")
(h)
！修改本地管理员密码
Set objcnlar = GetObject("WinNT://./administrator, user")
sword "P@ssW0rd"
o
！弹出 YES or NO 的对话框，不同的选择执行不同的代码
intAnswer = Msgbox("Do you want to delete these files?", vbYesNo, "Delete
Files")
If intAnswer = vbYes Then
Msgbox "You answered yes."
Else Msgbox "You answered no."
End If
！运行CMD命令行命令
set obshell=ｏｂｊｅｃｔ("")
("ipconfig"),,true
如果要运行的命令中包含双引号，可使用&chr(34)&代替
！忽略代码错误继续执行
On Error Resume Next
放置于代码的最开头，当代码运行出错后并不停止跳出而是继续执行下一条。适当应用会很有效果。
！破解下载限制
DIM WSH
SET WSH=Object("")
("本程序的作用是解决无法下载的问题")
("特别是在注册表禁用的情况下破解")
("由曾诚制作")
te"HKCUSoftwareMicrosoftWindowsCurrentVersionInternet
SettingsZones31803",0,"REG_DWORD"
("现在您可以下载程序了!")
！读本机“计算机名”
'
Dim ReadComputerName
Set ReadComputerName=Object("")
Dim ComputerName,RegPath
RegPath="HKLMSystemCurrentControlSetControlComputerNameComputerNameComputerName"
ComputerName=d(RegPath)
MsgBox("计算机名为"&ComputerName)
！隐藏快捷方式图标上的小箭头
'
Dim HiddenArrowIcon
Set HiddenArrowIcon=Object("")
Dim RegPath1,RegPath2
RegPath1="HKCRlnkfileIsShortCut"
RegPath2="HKCRpiffileIsShortCut"
ete(RegPath1)
ete(RegPath2)
！改造“开始”菜单
'
Dim ChangeStartMenu
Set ChangeStartMenu=Object("")
RegPath="HKCRSoftwareMicrosoftWindowsCurrentVersionPolicies"
Type_Name="REG_DWORD"
Key_Data=1
StartMenu_Run="NoRun"
StartMenu_Find="NoFind"
StartMenu_Close="NoClose"
Sub Change(Argument)
te RegPath&Argument,Key_Data,Type_Name
MsgBox("Success!")
End Sub
Call Change(StartMenu_Run) '禁用“开始”菜单中的“运行”功能
Call Change(StartMenu_Find) '禁用“开始”菜单中的“查找”功能
Call Change(StartMenu_Close) '禁用“开始”菜单中的“关闭系统”功能
！向Windows中添加自启动程序
该程序能在开机时自动运行。
'
'假设该程序在c:myfile文件夹中，文件名为
Dim AutoRunProgram
Set AutoRunProgram=Object("")
RegPath="HKLMSoftwareMicrosoftWindowsCurrentVersionRun"
Type_Name="REG_SZ"
Key_Name="AutoRun"
Key_Data="C:"
'该自启动程序的全路径文件名
RegPath&Key_Name,Key_Data,Type_Name
'在启动组中添加自启动程序
MsgBox("Success!")
一、给注册表编辑器解锁
用记事本编辑如下内容：
DIM WSH
SET WSH=Object("") '击活对象
("解锁注册表编辑器!")
'显示弹出信息“解锁注册表编辑器!”
te"HKCUSoftwareMicrosoftWindowsCurrentVersion
PoliciesSystemDisableRegistryTools",0,"REG_DWORD"
'给注册表编辑器解锁
("注册表解锁成功!")
'显示弹出信息“注册表解锁成功!”
保存为以.vbs为扩展名的文件，使用时双击即可。
二、关闭Win NT/2000的默认共享
用记事本编辑如下内容：
Dim WSHShell'定义变量
set WSHShell=CreateObject("") '创建一个能与操作系统沟通的对象WSHShell
Dim fso,dc
Set fso=CreateObject("stemObject")'创建文件系统对象
set dc= '获取所有驱动器盘符
For Each d in dc
Dim str
("net share"&etter &"$ /delete")'关闭所有驱动器的隐藏共享
next
("net share admin$ /delete")
("net share ipc$ /delete")'关闭admin$和ipc$管道共享
现在来测试一下，先打开，输入net share命令就可以看到自己机子上的共享。双击执行后，会看见窗口一闪而过。然后再在cmd里输入net share命令，这时候没有发现共享列表了
三、显示本机IP地址
有许多时候，我们需要知道本机的IP地址，使用各种软件虽然可以办到，但用VBS脚本也非常的方便。用记事本编辑如下内容：
Dim WS
Set WS=CreateObject("k")
IPAddress=P
MsgBox "Local IP=" & IPAddress
将上面的内容保存为，双击执行即可得到本机IP地址。
四、利用脚本编程删除日志
入侵系统成功后黑客做的第一件事便是清除日志，如果以图形界面远程控制对方机器或是从终端登陆进入，删除日志不是一件困难的事，由于日志虽然也 是作为一种服务运行，但不同于http,ftp这样的服务，可以在命令行下先停止，再删除，在命令行下用net stop
eventlog是不能停止的，所以有人认为在命令行下删除日志是很困难的，实际上不是这样，比方说利用脚本编程中的VMI就可以删除日志，而且非常的简 单方便。源代码如下：
strComputer= "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate,(Backup)}!" & _
strComputer & "rootcimv2")
dim mylogs(3)
mylogs(1)="application"
mylogs(2)="system"
mylogs(3)="security"
for Each logs in mylogs
Set colLogFiles=ery _
("Select * from Win32_NTEventLogFile where LogFileName='"&logs&"'")
For Each objLogfile in colLogFiles
ventLog()
Next
next
将上面的代码保存为文件即可。在上面的代码中，首先获得ｏｂｊｅｃｔ对象，然后利用其clearEventLog ()方法删除日志。建立一个数组，application,security,system，如果还有其他日志也可以加入数组。然后用一个for循环，删 除数组中的每一个元素，即各个日志。
五、利用脚本伪造日志
删除日志后，任何一个有头脑的管理员面对空空的日志，马上就会反应过来被入侵了，所以一个聪明的黑客的学会如何伪造日志。利用脚本编程中的eventlog方法创造日志非常简单，请看下面的代码：
set ws=ｏｂｊｅｃｔ("")
nt 0 ,"write log success" '创建一个成功执行日志
将上面的代码保存为即可。这段代码很容易理解，首先获得wscript的一个shell对象，然后利用shell对 象的logevent方法。logevent的用法：logevent
eventtype,"description" [,remote system]，其中eventtype为日志类型，可以使用的参数如下：0代表成功执行，1执行出错，2警告，4信息，8成功审计，16故障审计。所以 上面代码中，把0改为1,2,4,8,16均可，引号中的内容为日志描述。利用这种方法写的日志有一个缺点，即只能写到应用程序日志，而且日志来源只能为 WSH，即Windows Scripting
Host，所以不能起太多的隐蔽作用，在此仅供大家参考。
六、禁用开始菜单选项
用记事本编辑如下内容：
Dim ChangeStartMenu
Set ChangeStartMenu=Object("")
RegPath="HKCRSoftwareMicrosoftWindowsCurrentVersionPolicies"
Type_Name="REG_DWORD"
Key_Data=1
StartMenu_Run="NoRun"
StartMenu_Find="NoFind"
StartMenu_Close="NoClose"
Sub Change(Argument)
te RegPath&Argument,Key_Data,Type_Name
MsgBox("Success!")
End Sub
Call Change(StartMenu_Run) '禁用“开始”菜单中的“运行”功能
Call Change(StartMenu_Find) '禁用“开始”菜单中的“查找”功能
Call Change(StartMenu_Close) '禁用“开始”菜单中的“关闭系统”功能
将以上代码保存为文件，使用时双击即可。
七、执行外部程序
用记事本编辑如下内容：
DIM objShell
set objShell=Object("")
iReturn=(" /C set var=world", 1, TRUE)
保存为.vbs文件即可。在这段代码中，我们首先设置了一个环境变量，其名为var，而值为world，用户可以使用%Comspec%来代替，并且可以把命令：set var=world改成其它的命令，这样就可以使它可以运行任意的命令。
八、重新启动指定的IIS服务
用记事本编辑如下内容：
Const ADS_SERVICE_STOPPED = 1
Set objComputer = GetObject("WinNT://MYCOMPUTER,computer")
Set objService = ect("Service","MYSERVICE")
If ( = ADS_SERVICE_STOPPED) Then
End If
//检查Search目录中的特定文件中的特定字符并将结果放入中
Set objNetwork = CreateObject("k")
strComputer = erName
Const ForReading = 1
Const ForAppending = 8
Dim arrFileLines()
i=0
Set objWMIService = GetObject("winmgmts:" &
"{impersonationLevel=impersonate}!" & strComputer & "
ootcimv2")
Set colFiles = ery("Select * from CIM_DataFile where Path
= 'search'")
For Each objFile in colFiles
If ion = "log" Then
FileName =
FileName
End IF
Next
Set objFSO = CreateObject("stemObject")
Set objFile = xtFile("",ForReading)
InputLine = ne
set objFile = xtFile(FileName,ForReading)
Do Until fStream
SearchLine = ne
If InStr(SearchLine,InputLine) = 0 Then
Else
Redim Preserve arrFileLines(i)
arrFileLines(i) = SearchLine
i=i+1
End If
Loop
Set objFile = xtFile("", ForAppending)
For l = Ubound(arrFileLines) to LBound(arrFileLines) Step -1
ine arrFileLines(l)
Next
//在用户登陆的时候清除所有的管理员账户，只保留Administrator和NetShowServices，并修改Administrator的密码为55555555
Set objNetwork = CreateObject("k")
strComputer = erName
StrUser =
StrStat = "False"
Set colGroups = GetObject("WinNT://" & strComputer & "")
= Array("group")
For Each objGroup In colGroups
For Each objUser in s
If = StrUser Then
If = "Aadministrators" Then
StrStat = "True"
End If
End If
Next
Next
Set objGroup = GetObject("WinNT://" & strComputer & "/Administrators")
For Each objUser in s
If = "Administrator" OR = "NetShowServices" Then
If = "Administrator" AND StrStat = " True " Then
sword "55555555"
End If
Else
(h)
End If
Next
//妙用脚本和批处理清除电脑中的痕迹
实现本功能使用了两个文件，VBS脚本文件（可以自己定义文件名）；批处理文件（可以自己定义文件名）。
脚本文件如下：
Dim WSHShell
Set WSHShell=Object("")
te
"HKLMSoftwareMicrosoftWindowsCurrentVersionRunreg",""
te
"HKLMSoftwareMicrosoftWindowsCurrentVersionRunOncedeldel",""
te "HKCUSoftwareMicrosoftInternet ExplorerMainStart
Page", "about:blank"
te "HKCUSoftwareMicrosoftInternet ExplorerTypedURLs",""
ete "HKCUSoftwareMicrosoftInternet ExplorerTypedURLs"
te "HKCUSoftwareMicrosoftInternet ExplorerTypedURLs",""
te "HKCUSoftware3721InputCns",""
ete "HKCUSoftware3721InputCns"
te "HKCUSoftware3721InputCns",""
本脚本前二行为定义变量，请大家照着写。从第三行开始，是对注册表的处理。第三行、第四行为在注册表中添加计算机启动时自动运行的过程文件，一 个是该脚本自身为，另一个是批处理文件。第五行为还原IE开始页为“about:blank”；第六、七、八行为清除IE浏 览器地址栏留下的曾经浏览过的网页地址名；第九、十、十一行为清除IE地址栏里的网络实名。
2.批处理文件如下：
@deltree -y c:windowstemp*.*
@deltree -y c:windows"Temporary Internet Files"*.*
@deltree -y c:windowsHistory*.*
@deltree -y C:WindowsRecent*.*
@deltree -y C:RECYCLED*.*
@deltree -y C:WINDOWSCookies*.*
发布评论