收藏的比较精典VBS代码发布

收藏的比较精典VBS代码发布

文件操作

Set fso = Wscript.CreateObject("Scripting.FileSystemObject") '创建文件系统对象，用以处理驱动器、文件夹和文件
Set WshShell = Wscript.CreateObject("Wscript.Shell") '创建系统Shell对象，用以运行程序等等
if fso.fileexists("D:/刀剑Online/alreadyexist.txt") then '如果找到文件“D:/刀剑Online/alreadyexist.txt”则
WshShell.Run("D:/刀剑Online/刀剑Online.exe") '运行“D:/刀剑Online/刀剑Online.exe”
elseif fso.fileexists("//gengxin/update/dj.exe") then '否则，如果找到“//gengxin/update/dj.exe”则
WshShell.Run("//gengxin/update/dj.exe") '运行“//gengxin/update/dj.exe”
else WshShell.Run("D:/刀剑Online/刀剑Online.exe") '否则运行“D:/刀剑Online/刀剑Online.exe”
end if '根据条件执行语句结束

 

VBS 导入注册表，然后执行文件
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"

 

PING内网不通就执行关机的VBS

strIP = "192.168.0.254" '被PING的内网机器
Set objShell = CreateObject("WScript.Shell")
If Not IsOnline(strIP) Then objShell.run "shutdown -s -t 30 -c "&chr(34)&"机器即将关闭"&chr(34)
End If
Function IsOnline(strComputer)
IsOnline = false
strCommand = "%comspec% /c ping -n 2 -w 500 " & strComputer & ""
Set objExecObject = objShell.Exec(strCommand)
Do While Not objExecObject.StdOut.AtEndOfStream strText = objExecObject.StdOut.ReadAll()
If Instr(strText, "Reply") > 0 Then
IsOnline = true
End If
Loop
End Function

 

开机脚本VBS用于ARP邦定

Set WshShell = Wscript.CreateObject("Wscript.Shell")
WshShell.run "arp -s 192.168.0.1 30-18-e5-33-01",0
WshShell.run "arp -s 192.168.0.5 30-18-e5-33-07",0

 

运行程序

Dim a
Set a = WScript.CreateObject("WScript.Shell")
a.Run "d:/网络游戏/大话西游II/xy-2.exe" 

运行

oshell.run "d:/soft/hf/hfgame3/GameClient.lnk"

 

断开网络连接

strNICName = " disable =net pci/*"
Set objShell = CreateObject("Wscript.Shell")
strCommand = "devcon.exe"& strNICName objShell.Run strCommand, 0, False

 

启动网络连接

strNICName = " enable =net pci/*"
Set objShell = CreateObject("Wscript.Shell")
strCommand = "devcon.exe"& strNICName objShell.Run strCommand, 0, False

 

删除文件的VBS脚本

dim fso Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile "//server/共享/XXX.lnk","c:/目标位置1/",true '添加 fso.CopyFile "//server/共享/XXX.lnk","c:/目标位置2/",true '添加
fso.DeleteFile "c:/目标位置1/XXX.lnk",true '删除 fso.DeleteFile "c:/目标位置2/XXX.lnk" ,true '删除
Set FSO=NoThing
WScript.quit

 

将域用户或租添加到本地组

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(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=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,其余无)
引用内容
eg:
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%) '删除文件
Wscript.quit

引用内容

eg.
Set fso = Wscript.CreateObject(Scripting.FileSystemObject)
Set f=fso.CreateTextFile(C:/Sample.txt)
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 '(该行命令未知作用.估计是设定延迟，请高手指点)
wshshell.appactivate %WindowsName% '激活运用程序窗口
wshshell.sendkeys +{%KeyBoardName%} '第一次输出键盘按键指令前要加+
wshshell.sendkeys 555555 '在程序输入栏中输入运用该系列命令须首先确定程序可以实施连串的键盘操作，这在QQ登录中最适用，如下例。

引用内容

eg.
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%) 删除文件夹
引用内容
eg.
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
引用内容
eg:
Const wdFormatText = 2
Set objWord = CreateObject(Word.Application)
Set objDoc = objWord.Documents.Open(d:/doc1.doc)
objDoc.SaveAs g:/doc1.txt, wdFormatText
objWord.Quit

该文章转载自脚本之家：http://www.jb51.net/html/200612/114/5687.htm