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

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

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

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路径

Consthkcu=&h80001

Setwmi=GetObject（"winmgmts:

stdregprov"）wmi.getstringvaluehkcu,"ControlPanel\Desktop","Wallpaper",Spathwmi.setstringvaluehkcu,"ControlPanel\Desktop","TileWallpaper","0"wmi.setstringvaluehkcu,"ControlPanel\Desktop","WallpaperStyle","2"wmi.setdwordvalue

hkcu,"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"RunDll

32.exeUSER

32.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="http:

oShellLink.Description="XX主页"

给收藏夹添加网址

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="http:

objURLShortcut.Save

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

OnErrorResumeNext

Setfso=CreateObject（"Scripting.FileSystemObject"）

fso.DeleteFile"C:

\*.vbs",True

Setfso=Nothing

VBS改主页

SetoShell=CreateObject（"WScript.Shell"）

Explorer\Main\StartPage","http:

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（"http:

VBS发送邮件

NameSpace="http:

SetEmail=CreateObject（"CDO.Message"）

Email.Subject="这里写标题"

Email.Textbody="这里写内容!

"

Email.AddAttachment"C:

\这是附件.txt"

WithEmail.Configuration.Fields

.Item（NameSpace&"sendusing"）=2

.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"starthttp:

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

objws.Run"""C:

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

Set

mc=GetObject（"Winmgmts:

"）.InstancesOf（"Win32_NetworkAdapterConfiguration"）ForEachmoInmc

Ifmo.IPEnabled=TrueThen

MsgBox"本机网卡MAC地址是:

"&mo.MacAddress

ExitFor

EndIf

Next

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

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

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

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

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

ws.run"mshta

vbscript:

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

QQ自动发消息

OnErrorResumeNext

str="我是笨蛋/qq"

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

WshShell.run"mshta

vbscript:

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

WshShell.run

"tencent:

//message/?

Menu=yes&uin=&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（100*Rnd+1））

msgboxjoin（point,""）

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

SetoShell=CreateObject（"WScript.Shell"）

oShell.RegWrite

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（"ADO

DB.Stream"）

stm

2.Charset="utf-8"

stm

2.Open

stm

2.LoadFromFilegangzi

readfile=stm

2.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（"ADO

DB.Stream"）

Stm

1.Type=2

Stm

1.Open

Stm

1.Charset="UTF-8"

Stm

1.Position=Stm

1.Size

Stm

1.WriteTextcik2

Stm

1.SaveToFilecik,2

Stm

1.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

ForEachuuInf

Setop=fso.GetFolder（uu.path）

t=t&vbCrLf&op.path

Callaa（op）

Next

aa=t

EndFunction

VBS创建.URL文件（IconIndex参数不同的数字代表不同的图标，具体请参照SHELL

32.dll里面的所有图标）

注意：

不知道是谁这么写我不发表任何意见

Setfso=CreateObject（"scripting.filesystemobject"）

（13）&Chr

（10）

qidong=qidong&"URL=http:

（13）&Chr

（10）

qidong=qidong&"IconFile=C:

\WINDOWS\system32\SHELL

32.dll"&Chr

（13）&Chr

（10）qidong=qidong&"IconIndex=130"&Chr

（13）&Chr

（10）

SetTestFile=fso.CreateTextFile（"qq.url",Ture）

TestFile.WriteLine（qidong）

TestFile.Close

VBS写hosts（没写判断，无论存不存在都追加底部）

Setfs=CreateObject（"Scripting.FileSystemObject"）

path=fs.GetSpecialFolder

（1）&"\drivers\etc\hosts"

Setf=fs.OpenTextFile（path,8,TristateFalse）

f.Write"

127.0.

f.Write"

127.0.

f.Close

VBS读取出

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace下面所有键的名字并循环输出

ConstHKLM=&H80002

strPath=

"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace"Setoreg=GetObject（"Winmgmts:

\root\default:

StdRegProv"）

oreg.EnumKeyHKLM,strPath,arr

ForEachxInarr

WScript.Echox

Next

VBS创建txt文件

Dimfso,TestFile

Setfso=CreateObject（"Scripting.FileSystemObject"）

SetTestFile=fso.CreateTextFile（"C:

\hello.txt",Ture）

TestFile.WriteLine（"Hello,World!

"）

TestFile.Close

VBS创建文件夹

Dimfso,fld

Setfso=CreateObject（"Scripting.FileSystemObject"）