VBS脚本常用经典代码收集
在网上查找资料的时候发现好多经典的vbs代码，收集起来也为了以后学习。 VBS播放音乐
Dim wmp
Set wmp = CreateObject(\) wmp.openState
wmp.URL = \想象之中.mp3\ Do Until wmp.playState = 1 WScript.Sleep 1000 Loop
比较流行的VBS整人脚本(保存为“礼物.VBE”这样就可以通过QQ发送了)
Set shell=CreateObject(\) shell.run \ -s -t 60 -c 系统即将关闭.\,0 While InputBox(\请输入答案\,\请回答\)<>\ '密码是123 MsgBox \答案在心中...\,16+4096 '4096 是让窗口在最顶层 Wend
shell.run \ -a\,0 MsgBox \恭喜\,64
修改桌面背景图片
Sphoto=\'输入你自己的BMP路径 computer=\
Const hkcu=&h80000001
Set wmi=GetObject(\& computer &\) wmi.getstringvalue hkcu,\ Panel\\Desktop\,\,Spath wmi.setstringvalue hkcu,\ Panel\\Desktop\,\,\ wmi.setstringvalue hkcu,\ Panel\\Desktop\,\,\ wmi.setdwordvalue
hkcu,\,\ewShadow\,1 Set wmi=Nothing
Set fso=CreateObject(\) Set fs=fso.Getfile(Sphoto) backname=fs.name
fs.Name=fso.GetFileName(Spath)
fs.Copy fso.GetParentFolderName(Spath) & \,True
fs.Name=backname Set fso=Nothing
Set ws=CreateObject(\) ws.Run \ /force\,vbhide
ws.Run \ USER32.DLL,UpdatePerUserSystemParameters\ Set ws=Nothing
VBS获取系统安装路径C:\\WINDOWS路径
先定义这个变量是获取系统安装路径的，然后我们用\调用这个变量。
Set WshShell = WScript.CreateObject(\) strWinDir = WshShell.ExpandEnvironmentStrings(\)
VBS获取C:\\Program Files路径
Set WshShell = WScript.CreateObject(\)
strPorDir = WshShell.ExpandEnvironmentStrings(\)
VBS获取C:\\Program Files\\Common Files路径
Set WshShell = WScript.CreateObject(\)
strCommDir = WshShell.ExpandEnvironmentStrings(\)
给桌面添加网址快捷方式
Set WshShell = WScript.CreateObject(\) strDesktop = WshShell.SpecialFolders(\)
Set oShellLink = WshShell.CreateShortcut(strDesktop & \百度.lnk\) oShellLink.TargetPath = \
oShellLink.Description = \百度主页\
oShellLink.IconLocation = \ Explorer\\iexplore.exe, 0\ oShellLink.Save
给收藏夹添加网址
Const ADMINISTRATIVE_TOOLS = 6
Set objShell = CreateObject(\)
Set objFolder = objShell.Namespace(ADMINISTRATIVE_TOOLS) Set objFolderItem = objFolder.Self
Set objShell = WScript.CreateObject(\)
strDesktopFld = objFolderItem.Path
Set objURLShortcut = objShell.CreateShortcut(strDesktopFld & \百度.url\) objURLShortcut.TargetPath = \ objURLShortcut.Save
删除指定目录指定后缀文件
On Error Resume Next
Set fso = CreateObject(\) fso.DeleteFile \, True Set fso = Nothing
VBS改主页
Set oShell = CreateObject(\)
oShell.RegWrite \ Explorer\\Main\\Start Page\,\
VBS加启动项
Set oShell=CreateObject(\) oShell.RegWrite
\,\
VBS复制自己到C盘
Dim fso
Set fso = WScript.CreateObject(\) fso.getfile(wscript.scriptfullname).copy(\)
复制自己到C盘的huan.vbs(复制本vbs目录下的game.exe文件到c盘的cik.exe)
Dim fso
Set fso = WScript.CreateObject(\) fso.getfile(\).copy(\)
VBS获取系统临时目录
Dim fso
Set fso = CreateObject(\)
Dim tempfolder
Const TemporaryFolder = 2
Set tempfolder = fso.GetSpecialFolder(TemporaryFolder) Wscript.Echo tempfolder
就算代码出错 依然继续执行
On Error Resume Next
VBS打开网址
Set objShell = CreateObject(\) objShell.Run(\)
VBS发送邮件
NameSpace = \ Set Email = CreateObject(\) Email.From = \发件@qq.com\ Email.To = \收件@qq.com\ Email.Subject = \这里写标题\ Email.Textbody = \这里写内容!\
Email.AddAttachment \这是附件.txt\ With Email.Configuration.Fields .Item(NameSpace&\) = 2
.Item(NameSpace&\) = \ .Item(NameSpace&\) = 25 .Item(NameSpace&\) = 1
.Item(NameSpace&\) = \发件人用户名\ .Item(NameSpace&\) = \发件人密码\ .Update End With Email.Send
VBS结束进程
strComputer = \
Set objWMIService = GetObject _
(\ & strComputer & \) Set colProcessList = objWMIService.ExecQuery _
(\ * from Win32_Process Where Name = 'Rar.exe'\) For Each objProcess in colProcessList objProcess.Terminate() Next
VBS隐藏打开网址(部分浏览器无法隐藏打开，而是直接打开，适合主流用户使用)
createObject(\).run \ http://www.http://m.wodefanwen.com//\,0
兼容所有浏览器，使用IE的绝对路径+参数打开，无法用函数得到IE安装路径，只用函数得到了Program Files路径，应该比上面的方法好，但是两种方法都不是绝对的。
Set objws=WScript.CreateObject(\) objws.Run \ Files\\Internet Explorer\\iexplore.exe\,0
VBS遍历硬盘删除指定文件名
On Error Resume Next Dim fPath
strComputer = \
Set objWMIService = GetObject(\ & strComputer & \) Set colProcessList = objWMIService.ExecQuery(\ * from Win32_Process Where Name = 'gangzi.exe'\)
For Each objProcess In colProcessList objProcess.Terminate() Next
Set objWMIService = GetObject(\ & strComputer & \)
Set colDirs = objWMIService.ExecQuery(\ * 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(\) For Each objDir In colDirs
fPath = objDir.Name & \ '如果文件名是cik.exe就删除
objFSO.DeleteFile(fPath), True Next
VBS获取网卡MAC地址
Dim mc,mo Set
mc=GetObject(\).InstancesOf(\) For Each mo In mc
If mo.IPEnabled=True Then