经常用到的VBS（转载)

经常用到的VBS（转载)

2008-04-06 00:21

'创建文件系统对象，用以处理驱动器、文件夹和文件
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")

'创建系统Shell对象，用以运行程序等等
Set WshShell = Wscript.CreateObject("Wscript.Shell")

'如果找到文件“D:\\刀剑Online\\alreadyexist.txt”则
if fso.fileexists("D:\\刀剑Online\\alreadyexist.txt") then

'运行“D:\\刀剑Online\\刀剑Online.exe”
WshShell.Run("D:\\刀剑Online\\刀剑Online.exe")

else

'否则，如果找到“\\\\gengxin\\update\\dj.exe”则
if fso.fileexists("") then

   '运行“\\\\gengxin\\update\\dj.exe”
    WshShell.Run("")

else

   '否则运行“D:\\刀剑Online\\刀剑Online.exe”
   WshShell.Run("D:\\刀剑Online\\刀剑Online.exe")

'根据条件执行语句结束
end if
end if

---

'写入注册表后再运行指定程序
dim Wsh
Set Wsh = WScript.CreateObject("WScript.Shell")
Wsh.RegWrite "HKCU\\SOFTWARE\\AUDITION\\AUTOSTART",0,"REG_DWORD"
Wsh.RegWrite "HKCU\\SOFTWARE\\AUDITION\\PATH","G:\\网络游戏\\劲舞团1.5","REG_SZ"
Wsh.RegWrite "HKCU\\SOFTWARE\\AUDITION\\VERSION",1010,"REG_DWORD"
Wsh.run "patcher.exe"

---

•  '删除QQ用户文件

Dim fso, folderspec, f, f1, fc
folderspec = "f:\\Program Files\\Tencent\\QQ" \'设置你的QQ文件夹
Dim Re Set
Re = New RegExp
Re.Pattern = "^\\d{4,13}$"
Set fso = CreateObject("scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.SubFolders
For Each f1 in fc
If Re.Test(f1.name) Then
    On Error Resume Next
    f1.Delete(true) On Error GoTo 0
End If
Next

---

'隔5分钟运行一次批处理程序

Dim Wsh
Set Wsh = WScript.CreateObject("WScript.Shell")
Do
Wsh.Run "d:\\aaa.bat" '你要执行的批处理
WScript.Sleep(300000)
Loop

---

将域用户或租添加到本地组
Set objGroup = GetObject(WinNT://./Administrators)
Set objUser = GetObject(WinNT://testnet/Engineers)
objGroup.Add(objUser.ADsPath)

---

修改本地管理员密码
Set objcnlar = GetObject(WinNT://./administrator, user)
objcnla.SetPassword P@ssW0rd
objcnla.SetInfo

---

弹出 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=wscript.createobject(wscript.shell)
obshell.run (ipconfig),,true
如果要运行的命令中包含双引号，可使用&chr(34)&代替

---

忽略代码错误继续执行
On Error Resume Next
放置于代码的最开头，当代码运行出错后并不停止跳出而是继续执行下一条。适当应用会很有效果。

---

注册表的修改，读取，删除，创建

Set wso = CreateObject(WScript.Shell) '声明
wso.RegWrite %Path% '创建子键
wso.RegWrite %Path%,%Value% '修改默认键值
wso.RegWrite %Path%,%Value%,%RegType% '修改特定类型的键值
'(字符串值 REG_SZ 可扩充字符串值 REG_EXPAND_SZ DWORD值 REG_DWORD 二进制值 REG_BINARY)

Set WSHShell= Wscript.CreateObject(Wscript.Shell)
WSHShell.RegRead (%Path%) '读取注册表子键或键值(一般用于判断某一事件是否执行)

Set wso = CreateObject(WScript.Shell)
wso.RegDelete %Path% '删除子键或键值
'(根键缩写HKEY_CLASSES_ROOT 为HKCR HKEY_CURRENT_USER 为HKCU HKEY_LOCAL_MACHINE 为HKLM,其余无)

例子:
Set wso = CreateObject(Wscript.Shell)
wso.RegWrite HKLM\\SOFTWARE\\Microsft\\Windows NT\\#1
wso.RegWrite HKLM\\SOFTWARE\\Microsft\\Windows NT\\#1,0
wso.RegWrite HKLM\\SOFTWARE\\Microsft\\Windows NT\\#1\\#2,0,REG_BINARY
wso.RegDelete HKLM\\SOFTWARE\\Microsft\\Windows NT\\#1
Wscript.quit

---

'文件的复制，删除，创建，简单的写入
Set fso = Wscript.CreateObject(Scripting.FileSystemObject) ‘声明
Set f = fso.CreateTextFile(%PATH%) '创建文件,其中f可任意，包含缩略名
f.WriteLine(VBS) '写入文件一行内容,该命令功能太简单,目前看来只能用于TXT文件
f.Close '关闭打开的文件
set c=fso.getfile(%path%) ’拷贝某文件
c.copy(%PATH2%) \'拷贝文件到指定地点
fso.deletefile(%PATH%) \'删除文件

例子:
Set fso = Wscript.CreateObject(Scripting.FileSystemObject)
Set f=fso.CreateTextFile("C:\\Sample.txt")
f.WriteLine(VBS)
f.close
set e=fso.getfile(C:\\Sample.txt)
e.copy(D:\\Sample.txt)
fso.deletefile(C:\\Sample.txt)
Wscript.quit

---

向应用程序输出简单的连串指令
dim program1 '声明变量program1
program1= %Path% '应用程序路径
set wshshell=createobject(wscript.shell) '声明引用函数
set oexec=wshshell.exec(program1) '运行程序
wscript.sleep 2000 '延迟2000毫秒
wshshell.appactivate %WindowsName% '指定要激活的程序窗口标题
wshshell.sendkeys +{%KeyBoardName%} '第一次输出键盘按键指令前要加+
wshshell.sendkeys 555555 '在程序输入栏中输入运用该系列命令须首先确定程序可以实施连串的键盘操作

例子:
dim program1
program1="D:\\Program Files\\Tencent\\coralQQ.exe"
set wshshell=CreateObject(wscript.shell)
set oexec=wshshell.exec(program1)
wscript.sleep 2000
wshshell.appactivate "QQ登录"
wshshell.sendkeys +{TAB}
wshshell.sendkeys 250481892
wscript.sleep 2000
wshshell.sendkeys {TAB}
wshshell.sendkeys ****************
wscript.sleep 2000
wshshell.sendkeys {ENTER}
Wscript.quit

---

文件夹的简单操作
Set fso = Wscript.CreateObject(Scripting.FileSystemObject) ‘声明
Set f = fso.CreateFolder(%PATH%) '创建文件夹
Set e = getFolder(%PATH%) '类似于“绑定目标”
e.copy(%PATH2%) '复制文件夹
fso.deletefolder(%PATH%) '删除文件夹

例子:
Set fso = Wscript.CreateObject(Scripting.FileSystemObject)
Set f = fso.CreateObject("C:\\sample")
f.copy("D:\\sample")
fso.deletefolder("C:\\sample")
'(由上例可以看出，文件夹的操作很多是和文件的操作相通的，因此VBS文件具有很多命令的统一性)

---

将某一指定文件夹的所有只读文件转为可读文件
Const ReadOnly = 1 ‘设只读属性对应值为1

Set FSO = CreateObject(Scripting.FileSystemObject) \'声明
Set Folder = FSO.GetFolder(%PATH%) ’绑定文件夹
Set colFiles = Folder.Files ‘文件夹所有文件

For Each objFile in colFiles ’下列语句应用于文件夹所有文件
If File.Attributes AND ReadOnly Then '这是关键之处，这里应用了If判断语句，来检测文件属性是否为只读
   File.Attributes = File.Attributes XOR ReadOnly '对判断结果为Ture（默认为True）’执行XOR逻辑运算，将其改为可读
End If ‘结束判断
Next

---

将Word文件另存为文本文件
Const wdFormatText = 2 '设置常数值
'(当该值为8时另存为HTML文档，为11时另存为XML文档)
Set objWord = CreateObject(Word.Application) '申明调用函数
Set objDoc = objWord.Documents.Open(%Path%) '打开某DOC文件
objDoc.SaveAs %PATH2%, wdFormatText '另存为……
objWord.Quit

例子:
Const wdFormatText = 2
Set objWord = CreateObject(Word.Application)
Set objDoc = objWord.Documents.Open("d:\\doc1.doc")
objDoc.SaveAs "g:\\doc1.txt", wdFormatText
objWord.Quit

---

禁用开始菜单选项
Dim ChangeStartMenu
Set ChangeStartMenu=WScript.CreateObject("WScript.Shell")
RegPath="HKCR\\Software\\Microsoft\\Windows\\CurrentVersion\\Policies\\"
Type_Name="REG_DWORD"
Key_Data=1
　  
StartMenu_Run="NoRun"
StartMenu_Find="NoFind"
StartMenu_Close="NoClose"
　  
Sub Change(Argument)
ChangeStartMenu.RegWrite 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 = objComputer.GetObject("Service","MYSERVICE")
If (objService.Status = ADS_SERVICE_STOPPED) Then
objService.Start
End If

---

添加系统自动启动程序

Dim AutoRunProgram
Set AutoRunProgram=WScript.CreateObject("WScript.Shell")
RegPath="HKLM\\Software\\Microsoft\\Windows\\CurrentVersion\\Run\\"
Type_Name="REG_SZ"
Key_Name="AutoRun"
Key_Data="C:\\Myfile\\autorun.exe"
'该自启动程序的全路径文件名
AutoRunProgram.Write RegPath&Key_Name,Key_Data,Type_Name
'在启动组中添加自启动程序autorun.exe

======打开迅闪菜单的同时连接虚拟磁盘的VBS======
Set WshShell = WScript.CreateObject("WScript.Shell")
Return = WshShell.Run ("c:\client\新调用.exe",0,true)
Return = WshShell.Run ("iscsicli AddTargetPortal 192.168.0.9 3260",0,true)
Return = WshShell.Run ("iscsicli LoginTarget iqn.2005-02.com.ricecake.iscsi:00 T * * * * * * * * * * * * * * * 0",0,true)
Set WshShell = Nothing

---

======开机VBS调用远程批处理（延时+无黑屏后台运行的效果）======
DIM objShell
set objShell=wscript.createObject("wscript.shell")
WScript.Sleep(10000)
iReturn=objShell.Run("cmd.exe /C \\server\E\123.bat", 0, TRUE)

---

实现整理磁盘碎片功能

Set WshShell = WScript.CreateObject("WScript.Shell")

Dim fso, d, dc
Set fso = CreateObject("Scripting.FileSystemObject")
Set dc = fso.Drives
For Each d in dc
If d.DriveType = 2 Then
Return = WshShell.Run("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("Scripting.FileSystemObject")
Set f = fso.GetFolder(sShowPath)
Set fc = f.Files
fcount = fc.count
redim arrFiles(fcount,5)
redim arrFiles2(fcount,5)
i=0
'排序
For Each f1 in fc
ftype = right(f1.name,len(f1.name)-instrrev(f1.name,"."))
arrFiles(i,0) = f1.name
arrFiles(i,1) = ftype
arrFiles(i,2) = f1.size
arrFiles(i,3) = f1.type
arrFiles(i,4) = f1.DateLastModified
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 + ("")
sListFile = sListFile + ("")
dim iLoopStart,iLoofEnd,iLoopStep
If intOrder = 0 then
iLoopStart = 0
iLoofEnd = fcount-1
iLoopStep = 1
Else
iLoopStart = fcount-1
iLoofEnd = 0
iLoopStep = -1
End if
dim iCount,sTDStyleClass
iCount = 1
For j=iLoopStart to iLoofEnd Step iLoopStep
If instr(strFiletype,arrFiles(j,1))>0 and iCount<=intShowCount then
sTDStyleClass = "PageListTd"+Cstr((iCount mod 2)+1)
sListFile = sListFile + ("")
sListFile = sListFile + ("")
sListFile = sListFile + ("")
sListFile = sListFile + ("")
iCount = iCount+1
end if
next
sListFile = sListFile + "

") sListFile = sListFile + ("名称") sListFile = sListFile + ("	") sListFile = sListFile + ("媒体") sListFile = sListFile + ("	") sListFile = sListFile + ("大小") sListFile = sListFile + ("	") sListFile = sListFile + ("类型") sListFile = sListFile + ("	") sListFile = sListFile + ("更新时间") sListFile = sListFile + ("
") sListFile = sListFile + ("" & 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 response.write 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,sUpdateContent

Dim fso,f,f_js,f_js_write
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(sShowPath)
Set f_js = fso.GetFile("list.js")

'比较调用文件与文件夹的最后修改时间
If f.DateLastModified<>f_js.DateLastModified then
sUpdateContent = ListFile(sListFileType,iOrderFieldFileDate,iOrderDesc,iShowCount)
Set f_js_write = fso.CreateTextFile("list.js", True)
'JS调用就加上下面这对document.write
' f_js_write.Write ("document.write('")
f_js_write.Write (sUpdateContent)
' f_js_write.Write ("')")
f_js_write.Close
End If
End Sub

Call ShowFileListContent()

---

启用和禁用网卡

'this.vbs---disable/enable network interface card
'usage: cscript /nologo this.vbs
sConnectionName = "LAN"          '本地连接
sEnableVerb = "启用(&A)"   '启用(&A)
sDisableVerb = "禁用(&B)" '禁用(&B)
sFolderName = "网络和拨号连接" '网络和拨号连接

Const ssfCONTROLS = 3
set shellApp = createobject("shell.application")
set oControlPanel = shellApp.Namespace(ssfCONTROLS)
set oNetConnections = nothing
for each folderitem in oControlPanel.items
    if folderitem.name = sFolderName then
        set oNetConnections = folderitem.getfolder: exit for
    end if
next
if oNetConnections is nothing then
    wscript.quit
end if
set oLanConnection = nothing
for each folderitem in oNetConnections.items
    if lcase(folderitem.name) = lcase(sConnectionName) then
        set oLanConnection = folderitem: exit for
    end if
next
if oLanConnection is nothing then
    wscript.quit
end if
bEnabled = true
set oEnableVerb = nothing
set oDisableVerb = nothing
s = "Verbs: " & vbcrlf
for each verb in oLanConnection.verbs
    s = s & vbcrlf & verb.name
    if verb.name = sEnableVerb then
        set oEnableVerb = verb
        bEnabled = false
    end if
    if verb.name = sDisableVerb then
        set oDisableVerb = verb
    end if
next
if oDisableVerb is nothing and oEnableVerb is nothing then
    wscript.quit
end if
if bEnabled then
    oDisableVerb.DoIt
else
    oEnableVerb.DoIt
end if

wscript.sleep 1000

---

对比删除文件

dim sdir,ddir
\'远程目录
sdir="\\\\192.168.0.200\\vbs\\zz\\"
\'本地目录
ddir="c:\\c"
function comparefile(sdir,ddir)
dim Fso,dFol,dfs,sf1,f1
set Fso=CreateObject("Scripting.FileSystemObject")
if not(Fso.folderexists(sdir)) then
msgbox chr(34) &sdir &chr(34) &"文件夹不存在，请确认！",64
exit function
end if
if not(Fso.folderexists(ddir)) then
msgbox chr(34) &ddir &"""文件夹不存在，请确认！",64
exit function
end if
if right(sdir,1)<>"\\" then sdir=sdir &"\\"

set dFol=fso.getfolder(ddir)
set dfs=dfol.files

for each f1 in dfs
if fso.fileexists(sdir & f1.name) then
set sf1=fso.GetFile(sdir & f1.name)
if f1.DateLastModified <>sf1.DateLastModified or f1.size<>sf1.size then
f1.delete
end if
else
f1.Delete(true)
end if
next
dim fols
set fols=dfol.subfolders
for each f1 in fols
if not fso.folderexists(sdir &f1.name) then
f1.delete true
else
comparefile sdir & f1.name,f1.path
end if
next
end function
comparefile sdir,ddir

---

游戏执行

On Error Resume Next
dim msg,fso,shell
Set fso = Wscript.createobject("scripting.filesystemobject")
set wshshell = wscript.CreateObject("wscript.shell")
set shell = wscript.createobject("wscript.shell")
IF (fso.FileExists("e:\劲乐团\reg.reg") and fso.FileExists("e:\劲乐团\O2Jam.exe")) Then
shell.run "c:\windows\Regedit.exe /s e:\劲乐团\reg.reg "
shell.run "e:\劲乐团\O2Jam.exe"
Else
msg=msgbox("注册表未导入或游戏程序不存在，游戏可能无法启动，如无法进游戏请叫网管~",1,"出问题啦！！")
shell.run "e:\劲乐团\O2Jam.exe"
end if

---

'虚拟光驱自动加载镜像文件
Dim Wsh,DMpath,ISOpath
DMpath = "X:\Y\daemon.exe" '设置D-Tools路径
ISOpath = "Z:\大富翁七\RICH7B.mds" '设置镜像文件路径
Set Wsh = WScript.CreateObject("WScript.Shell")
Wsh.run chr(34) & DMpath & chr(34) &" -mount 0,"&chr(34)&ISOpath&chr(34),0,true
Wscript.Sleep 3000 '最好延时几秒等待镜像加载完毕 1000 = 1 秒
Wsh.run "Z:\大富翁七\rich7.exe"
Set WSH = Nothing
WScript.quit

---

获得特定文件夹的路径

Set wsShell = CreateObject("WScript.Shell")
DesktopPath = wsShell.SpecialFolders("Desktop")

---

'获取当前用户名称
Set WshNetwork = WScript.CreateObject("WScript.Network")

UserName= WshNetwork.UserName
msgbox UserName

---

获取系统变量%SystemRoot%（当然其他的系统变量可以类推，只是不只是不是都要通过PROCESS中转一下

Set fso = CreateObject("Scripting.FileSystemObject")
Set WshSysEnv = wsShell.Environment("PROCESS")
SystemRoot = WshSysEnv("WINDIR")

---

修改本地管理员密码

Set objcnlar = GetObject("WinNT://./administrator, user")
objcnla.SetPassword "P@ssW0rd"
objcnla.SetInfo

---

延时启动指定程序

Dim Wsh
Set Wsh = WScript.CreateObject("WScript.Shell")
WScript.Sleep(60000)'单位为毫秒
Wsh.Run "D:\bat.bat",,True
Set Wsh=NoThing
WScript.quit