VBS脚本常用代码大全 整理.docx

VBS脚本常用代码大全 整理.docx

《VBS脚本常用代码大全 整理.docx》由会员分享，可在线阅读，更多相关《VBS脚本常用代码大全 整理.docx（24页珍藏版）》请在冰豆网上搜索。

VBS脚本常用代码大全整理

VBS脚本常用经典代码收集

于2011年7月2日21:

13:

37整理

在网上查找资料的时候发现好多经典的vbs代码，收集起来也为了以后学习。

VBS播放音乐

Dimwmp

Setwmp=CreateObject（"WMPlayer.OCX"）

wmp.openState

wmp.URL="想象之中.mp3"

DoUntilwmp.playState=1

WScript.Sleep1000

Loop

比较流行的VBS整人脚本（保存为“礼物.VBE”这样就可以通过QQ发送了）

Setshell=CreateObject（"WScript.Shell"）

shell.run"shutdown-s-t60-c系统即将关闭.",0

WhileInputBox（"请输入答案","请回答"）<>"123"'密码是123

MsgBox"答案在心中...",16+4096'4096是让窗口在最顶层

Wend

shell.run"shutdown-a",0

MsgBox"恭喜",64

修改桌面背景图片

Sphoto="d:

\1.bmp"'输入你自己的BMP路径

computer="."

Consthkcu=&h80000001

Setwmi=GetObject（"winmgmts:

\\"&computer&"\root\default:

stdregprov"）

wmi.getstringvaluehkcu,"ControlPanel\Desktop","Wallpaper",Spath

wmi.setstringvaluehkcu,"ControlPanel\Desktop","TileWallpaper","0"

wmi.setstringvaluehkcu,"ControlPanel\Desktop","WallpaperStyle","2"

wmi.setdwordvaluehkcu,"Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced","ListviewShadow",1

Setwmi=Nothing

Setfso=CreateObject（"scripting.filesystemobject"）

Setfs=fso.Getfile（Sphoto）

backname=fs.name

fs.Name=fso.GetFileName（Spath）

fs.Copyfso.GetParentFolderName（Spath）&"\",True

fs.Name=backname

Setfso=Nothing

Setws=CreateObject（"wscript.shell"）

ws.Run"gpupdate/force",vbhide

ws.Run"RunDll32.exeUSER32.DLL,UpdatePerUserSystemParameters"

Setws=Nothing

VBS获取系统安装路径C:

\WINDOWS路径

先定义这个变量是获取系统安装路径的，然后我们用"strWinDir"调用这个变量。

SetWshShell=WScript.CreateObject（"WScript.Shell"）

strWinDir=WshShell.ExpandEnvironmentStrings（"%WinDir%"）

VBS获取C:

\ProgramFiles路径

SetWshShell=WScript.CreateObject（"WScript.Shell"）

strPorDir=WshShell.ExpandEnvironmentStrings（"%ProgramFiles%"）

VBS获取C:

\ProgramFiles\CommonFiles路径

SetWshShell=WScript.CreateObject（"WScript.Shell"）

strCommDir=WshShell.ExpandEnvironmentStrings（"%CommonProgramFiles%"）

给桌面添加网址快捷方式

SetWshShell=WScript.CreateObject（"Wscript.Shell"）

strDesktop=WshShell.SpecialFolders（"Desktop"）

SetoShellLink=WshShell.CreateShortcut（strDesktop&"\XX.lnk"）

oShellLink.TargetPath="

oShellLink.Description="XX主页"

oShellLink.IconLocation="%ProgramFiles%\InternetExplorer\iexplore.exe,0"

oShellLink.Save

给收藏夹添加网址

ConstADMINISTRATIVE_TOOLS=6

SetobjShell=CreateObject（"Shell.Application"）

SetobjFolder=objShell.Namespace（ADMINISTRATIVE_TOOLS）

SetobjFolderItem=objFolder.Self

SetobjShell=WScript.CreateObject（"WScript.Shell"）

strDesktopFld=objFolderItem.Path

SetobjURLShortcut=objShell.CreateShortcut（strDesktopFld&"\XX.url"）

objURLShortcut.TargetPath="

objURLShortcut.Save

删除指定目录指定后缀文件

OnErrorResumeNext

Setfso=CreateObject（"Scripting.FileSystemObject"）

fso.DeleteFile"C:

\*.vbs",True

Setfso=Nothing

VBS改主页

SetoShell=CreateObject（"WScript.Shell"）

oShell.RegWrite"HKEY_CURRENT_USER\Software\Microsoft\InternetExplorer\Main\StartPage","

VBS加启动项

SetoShell=CreateObject（"Wscript.Shell"）

oShell.RegWrite"HKLM\Software\Microsoft\Windows\CurrentVersion\Run\cmd","cmd.exe"

VBS复制自己到C盘

Dimfso

Setfso=WScript.CreateObject（"Scripting.Filesystemobject"）

fso.getfile（wscript.scriptfullname）.copy（"c:

\cik.vbs"）

复制自己到C盘的huan.vbs（复制本vbs目录下的game.exe文件到c盘的cik.exe）

Dimfso

Setfso=WScript.CreateObject（"Scripting.Filesystemobject"）

fso.getfile（"game.exe"）.copy（"c:

\cik.exe"）

VBS获取系统临时目录

Dimfso

Setfso=CreateObject（"Scripting.FileSystemObject"）

Dimtempfolder

ConstTemporaryFolder=2

Settempfolder=fso.GetSpecialFolder（TemporaryFolder）

Wscript.Echotempfolder

就算代码出错依然继续执行

OnErrorResumeNext

VBS打开网址

SetobjShell=CreateObject（"Wscript.Shell"）

objShell.Run（"

VBS发送邮件

NameSpace="

SetEmail=CreateObject（"CDO.Message"）

Email.From="发件@"

Email.To="收件@"

Email.Subject="这里写标题"

Email.Textbody="这里写内容!

"

Email.AddAttachment"C:

\这是附件.txt"

WithEmail.Configuration.Fields

.Item（NameSpace&"sendusing"）=2

.Item（NameSpace&"smtpserver"）=""

.Item（NameSpace&"smtpserverport"）=25

.Item（NameSpace&"smtpauthenticate"）=1

.Item（NameSpace&"sendusername"）="发件人用户名"

.Item（NameSpace&"sendpassword"）="发件人密码"

.Update

EndWith

Email.Send

VBS结束进程

strComputer="."

SetobjWMIService=GetObject_

（"winmgmts:

\\"&strComputer&"\root\cimv2"）

SetcolProcessList=objWMIService.ExecQuery_

（"Select*fromWin32_ProcessWhereName='Rar.exe'"）

ForEachobjProcessincolProcessList

objProcess.Terminate（）

Next

VBS隐藏打开网址（部分浏览器无法隐藏打开，而是直接打开，适合主流用户使用）

createObject（"wscript.shell"）.run"start

兼容所有浏览器，使用IE的绝对路径+参数打开，无法用函数得到IE安装路径，只用函数得到了ProgramFiles路径，应该比上面的方法好，但是两种方法都不是绝对的。

Setobjws=WScript.CreateObject（"wscript.shell"）

objws.Run"""C:

\ProgramFiles\InternetExplorer\iexplore.exe""",0

VBS遍历硬盘删除指定文件名

OnErrorResumeNext

DimfPath

strComputer="."

SetobjWMIService=GetObject（"winmgmts:

\\"&strComputer&"\root\cimv2"）

SetcolProcessList=objWMIService.ExecQuery（"Select*fromWin32_ProcessWhereName='gangzi.exe'"）

ForEachobjProcessIncolProcessList

objProcess.Terminate（）

Next

SetobjWMIService=GetObject（"winmgmts:

{impersonationLevel=impersonate}!

\\"&strComputer&"\root\cimv2"）

SetcolDirs=objWMIService.ExecQuery（"Select*fromWin32_DirectorywherenameLIKE'%c:

%'ornameLIKE'%d:

%'ornameLIKE'%e:

%'ornameLIKE'%f:

%'ornameLIKE'%g:

%'ornameLIKE'%h:

%'ornameLIKE'%i:

%'"）

SetobjFSO=CreateObject（"Scripting.FileSystemObject"）

ForEachobjDirIncolDirs

fPath=objDir.Name&"\cik.exe"

'如果文件名是cik.exe就删除

objFSO.DeleteFile（fPath）,True

Next

VBS获取网卡MAC地址

Dimmc,mo

Setmc=GetObject（"Winmgmts:

"）.InstancesOf（"Win32_NetworkAdapterConfiguration"）

ForEachmoInmc

Ifmo.IPEnabled=TrueThen

MsgBox"本机网卡MAC地址是:

"&mo.MacAddress

ExitFor

EndIf

Next

VBS获取本机注册表主页地址

Setreg=WScript.CreateObject（"WScript.Shell"）

startpage=reg.RegRead（"HKEY_CURRENT_USER\Software\Microsoft\InternetExplorer\Main\StartPage"）

MsgBoxstartpage

VBS遍历所有磁盘的所有目录，找到所有.txt的文件，然后给所有txt文件最底部加一句话

OnErrorResumeNext

Setfso=CreateObject（"Scripting.FileSystemObject"）

Co=vbCrLf&"路过。

。

。

"

ForEachiInfso.Drives

Ifi.DriveType=2Then

GFfso.GetFolder（i&"\"）

EndIf

Next

SubGF（fol）

Whfol

Dimi

ForEachiInfol.SubFolders

GFi

Next

EndSub

SubWh（fol）

Dimi

ForEachiInfol.Files

IfLCase（fso.GetExtensionName（i））="txt"Then

fso.OpenTextFile（i,8,0）.WriteCo

EndIf

Next

EndSub

获取计算机所有盘符

Setfso=CreateObject（"scripting.filesystemobject"）

Setobjdrives=fso.Drives'取得当前计算机的所有磁盘驱动器

ForEachobjdriveInobjdrives'遍历磁盘

MsgBoxobjdrive

Next

VBS给本机所有磁盘根目录创建文件

OnErrorResumeNext

Setfso=CreateObject（"Scripting.FileSystemObject"）

Setgangzis=fso.Drives'取得当前计算机的所有磁盘驱动器

ForEachgangziIngangzis'遍历磁盘

SetTestFile=fso.CreateTextFile（""&gangzi&"\新建文件夹.vbs",Ture）

TestFile.WriteLine（"ByCik"）

TestFile.Close

Next

VBS遍历本机全盘找到所有123.exe，然后给他们改名321.exe

Setfs=CreateObject（"Scripting.FileSystemObject"）

ForEachdriveInfs.drives

fstraversaldrive.rootfolder

Next

Subfstraversal（byvalthis）

ForEachfolderInthis.subfolders

fstraversalfolder

Next

Setfiles=this.files

ForEachfileInfiles

Iffile.name="123.exe"Thenfile.name="321.exe"

Next

EndSub

VBS写入代码到粘贴板（先说明一下，VBS写内容到粘贴板，网上千篇一律都是通过InternetExplorer.Application对象来实现，但是缺点是在默认浏览器为非IE中会弹出浏览器，所以费了很大的劲找到了这个代码来实现）

str="这里是你要复制到剪贴板的字符串"

Setws=wscript.createobject（"wscript.shell"）

ws.run"mshtavbscript:

clipboardData.SetData（"+""""+"text"+""""+","+""""&str&""""+"）（close）",0,true

QQ自动发消息

OnErrorResumeNext

str="我是笨蛋/qq"

SetWshShell=WScript.CreateObject（"WScript.Shell"）

WshShell.run"mshtavbscript:

clipboardData.SetData（"+""""+"text"+""""+","+""""&str&""""+"）（close）",0

WshShell.run"tencent:

//message/?

Menu=yes&uin=20016964&Site=&Service=200&sigT=2a39fb276d15586e1114e71f7af38e195148b0369a16a40fdad564ce185f72e8de86db22c67ec3c1",0,true

WScript.Sleep3000

WshShell.SendKeys"^v"

WshShell.SendKeys"%s"

VBS隐藏文件

SetobjFSO=CreateObject（"Scripting.FileSystemObject"）

SetobjFile=objFSO.GetFile（"F:

\软件大赛\show.txt"）

IfobjFile.Attributes=objFile.AttributesAND2Then

objFile.Attributes=objFile.AttributesXOR2

EndIf

VBS生成随机数（521是生成规则，不同的数字生成的规则不一样，可以用于其它用途）

Randomize520

point=Array（Int（100*Rnd+1）,Int（1000*Rnd+1）,Int（10000*Rnd+1））

msgboxjoin（point,""）

VBS删除桌面IE图标（非快捷方式）

SetoShell=CreateObject（"WScript.Shell"）

oShell.RegWrite"HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoInternetIcon",1,"REG_DWORD"

VBS获取自身文件名

MyName=WScript.ScriptName

msgboxMyName

MyFullName=WScript.ScriptFullName

msgboxMyFullName

VBS读取Unicode编码的文件

SetobjFSO=CreateObject（"Scripting.FileSystemObject"）

SetobjFile=objFSO.OpenTextFile（"gangzi.txt",1,False,-1）

strText=objFile.ReadAll

objFile.Close

Wscript.EchostrText

VBS读取指定编码的文件（默认为uft-8）gangzi变量是要读取文件的路径

setstm2=createobject（"ADODB.Stream"）

stm2.Charset="utf-8"

stm2.Open

stm2.LoadFromFilegangzi

readfile=stm2.ReadText

MsgBoxreadfile

VBS禁用组策略

SetoShell=CreateObject（"WScript.Shell"）

oShell.RegWrite"HKEY_CURRENT_USER\Software\Policies\Microsoft\MMC\RestrictToPermittedSnapins",1,"REG_DWORD"

VBS写指定编码的文件（默认为uft-8）gangzi变量是要读取文件的路径，gangzi2是内容变量

cik="1.txt"

cik2="2.txt"

SetStm1=CreateObject（"ADODB.Stream"）

Stm1.Type=2

Stm1.Open

Stm1.Charset="UTF-8"

Stm1.Position=Stm1.Size

Stm1.WriteTextcik2

Stm1.SaveToFilecik,2

Stm1.Close

setStm1=nothing

VBS获取当前目录下所有文件夹名字（不包括子文件夹）

Setfso=WScript.CreateObject（"Scripting.Filesystemobject"）

Setf=fso.GetFolder（fso.GetAbsolutePathName（"."））

Setfolders=f.SubFolders

ForEachfoInfolders

wsh.echofo.Name

Next

VBS获取指定目录下所有文件夹名字（包括子文件夹）

Dimt

Setfso=WScript.CreateObject（"scripting.filesystemobject"）

Setfs=fso.GetFolder（"d:

\"）

WScript.Echoaa（fs）

Functionaa（n）

Setf=n.subfolders