VBS实用代码集

1★vbs有一个对像是“SAPI.SpVoice”，可以用它来讲英语的，这个组件在 xp、2003上默认都可以用的，调用后可以听到电脑上一个国外老男人在说话好比这样一句代码：
CreateObject ("SAPI.SpVoice").Speak "I LOVE YOU"
保存成vbs后缀后双击就会听到英语的我爱你了

2★用mshta来运行vbs
hta这种类型的文件运行后也是系统权限，其调用宿主就是mshta.exe。我们在cmd下运行这样一行代码：
mshta vbscript:createobject("sapi.spvoice").speak("I LOVE YOU.")(window.close)
也会听到同样的发音。这行代码的意思类似是临时生成一个hta文件，然后运行里边的vbs代码，再调用 window.close将运行窗口关掉。整个运行过程是看不到hta窗口的。


3★用ie地址栏运行vbs
很多人会用ie地址栏运行js，其实vbs一样是可以的，我们随便打开一个网站，在地址栏上输入：vbscript:msgbox (Document.links.length)后回车，就会看到当前页面有多少个连接了。用document.links(i).href这句的话，将 i换成不同的自然数好比0、1、2、3等就会分别显示出不同的链接地址。这部份内容其实是涉及到dhtml的内容了。我们来看一个最简单的示例代码：




这是两个链接，保存成网页后点击就会跳转到不同的页面。如果这个页面有跨站，我想搞下破坏，让用户点击却跑到我指定的页面上能做到吗？其实可以的，只要加一行语句就可以了，代码是：● ●。这样的话用户再点击sohu其实会跑到google上去了，原来页面的版式却丝毫没有破坏。同样的dhtml元素还有document.links (i).href、document.images(i).src、document.forms(i).action等等，跨站改变其动态元素是很好玩的。

4★利用脚本伪造日志
set ws=wscript.createobject("Wscript.shell")
ws.logevent 0 ,"write log success" '创建一个成功执行日志
将上面的代码保存为createlog.vbs即可。这段代码很容易理解，首先获得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，所以不能起太多的隐蔽作用，在此仅供大家参考。

5★执行外部程序
DIM objShell
set objShell=wscript.createObject("wscript.shell")
iReturn=objShell.Run("cmd.exe /C

set var=world", 1, TRUE)
保存为.vbs文件即可。在这段代码中，我们首先设置了一个环境变量，其名为var，而值为world，用户可以使用%Comspec%来代替cmd.exe，并且可以把命令：set var=world改成其它的命令，这样就可以使它可以运行任意的命令。

6★ VBS提权脚本
@echo off
echo dim WshShell,cmd >> %3runas.vbs
echo cmd="%SystemRoot%\system32\cmd.exe" >> %3runas.vbs
echo Set WshShell=WScript.CreateObject("WScript.Shell") >> %3runas.vbs
echo WshShell.Run cmd >> %3runas.vbs
echo WScript.Sleep 500 >> %3runas.vbs
echo WshShell.SendKeys"runas /user:Administrators\%1 %3Bcmd.bat" >> %3runas.vbs
echo WshShell.SendKeys"{ENTER}" >> %3runas.vbs
echo WScript.Sleep 1000 >> %3runas.vbs
echo WshShell.SendKeys"%2" >> %3runas.vbs
echo WshShell.SendKeys"{ENTER}" >> %3runas.vbs
echo WScript.Sleep 500 >> %3runas.vbs
echo WshShell.SendKeys"exit" >> %3runas.vbs
echo WshShell.SendKeys"{ENTER}" >> %3runas.vbs
echo @echo off >> %3Bcmd.bat
echo %4 %5 %6 %7 %8 %9 >> %3Bcmd.bat
echo del %3runas.vbs >> %3Bcmd.bat
echo del %3Bcmd.bat >> %3Bcmd.bat
%3\runas.vbs
以上保存为BAT
dim WshShell,cmd
cmd="%SystemRoot%\system32\cmd.exe"
Set WshShell=WScript.CreateObject("WScript.Shell")
WshShell.Run cmd
WScript.Sleep 500
WshShell.SendKeys"runas /user:Administrators\用户名 密码 命令"
WshShell.SendKeys"{ENTER}"
WScript.Sleep 1000
WshShell.SendKeys"%2"
WshShell.SendKeys"{ENTER}"
WScript.Sleep 500
WshShell.SendKeys"exit"
WshShell.SendKeys"{ENTER}"
以上保存为VBS

Runas
只有在通过自动登陆读到密码时才有用

7★用VBS返回文件里所有的文件名称
set fso = createobject("scripting.filesystemobject")
set folder = fso.getfolder("c:\Download")
for each file in folder.files
msgbox
next


8★收藏的比较精典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 '根据条件执行语句结束


9★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 "pat

cher.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 .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=myreadli

ne 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() 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
要设开机自动运行，禁止程序

详细出处参考：/article/7995_2.htm