首页 > 编程 > VBScript > 正文

收藏的比较精典VBS代码

2020-06-26 18:06:19
字体:
来源:转载
供稿:网友
比较精典VBS代码,想学习vbscript的朋友可以参考下
 

文件操作 

复制代码代码如下:

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 Wsh = 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 

无界面自动检测安装iscsi客户端,映射及断开映射vbs脚本 

下列代码实现无界面自动检测安装iscsi客户端,自动映射 
复制代码代码如下:

On Error Resume Next setupfile="iscsi2.0.exe" 'iscsi客户端安装文件路径 
serverip="192.168.0.100" 'iscsi服务器ip 
Set oshell= CreateObject("WScript.Shell") 
Set fso = CreateObject("Scripting.FileSystemObject") 
if not fso.fileexists(oshell.ExpandEnvironmentStrings("%WinDir%")+"/system32/iscsicpl.cpl") 
then oshell.run setupfile&" /q",,1 
end if 
oshell.run "iscsicli AddTargetPortal "&serverip&" 3260",0,1 
oshell.run "iscsicli LoginTarget iqn.2005-02.com.ricecake.iscsi:00 T * * * * * * * * * * * * * * * 0",0,1 


下例代码实现无界面删除iscsi映射盘 
复制代码代码如下:

filetmp="c:/my.txt" 
On Error Resume Next 
Set Shell = CreateObject("WScript.Shell") 
Set fso = Wscript.CreateObject("Scripting.FileSystemObject") 
shell.run "cmd /c iscsicli sessionlist>"&filetmp,0,1 
Const ForReading = 1 
Dim fso, theFile, retstring 
Set fso = CreateObject("Scripting.FileSystemObject") 
Set theFile = fso.OpenTextFile(filetmp, ForReading) 
aaa=thefile.readall 
thefile.close 
function myreadline() 
X=instr(1,aaa,vbcrlf,vbTextCompare) 
myline=mid(aaa,1,x-1) 
aaa=right(aaa,len(aaa)-x) 
if len(aaa) =<1 then myline ="end" 
myreadline=myline 
end function 
Do While bbb<>"end" 
bbb=myreadline 
if bbb <> "end" then 
if bbb <>" " then 
if instr(bbb,"Session")<>0 then 
temID=mid(bbb,instr(bbb,":")+1,len(bbb)-instr(bbb,":")) 
shell.run "iscsicli logouttarget"&temID,0 
end if 
end if 
end if 
Loop 
fso.deletefile(filetmp) 


删除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 

要设开机自动运行,禁止程序

发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表