1. 计算
2. 处理文件和文件夹
3. 管理Windows
4. 处理Word, Excel, PowerPoint等Office文档
5. 嵌入网页，驱动dHTML
6. 编写HTTP通信
7. 调用系统功能（COM组件），比如说语音说话
8. 分析HTML, XML
9. 调用命令行并分析返回结果
10. 处理图片
11. 自动化按键
12. 调用Windows Media Player并管理
13. 调用Windows Live Messenger并管理
14. 服务端技术：Active Server Page (ASP)
15. 脚本病毒
16. 处理数据库
VBS获取系统安装路径
先定义这个变量是获取系统安装路径的，然后我们用”&strWinDir&”调用这个变量。
set WshShell = WScript.CreateObject("WScript.Shell")
strWinDir = WshShell.ExpandEnvironmentStrings("%WinDir%")VBS获取C:\Program Files路径msgbox CreateObject("WScript.Shell").ExpandEnvironmentStrings("%ProgramFiles%")
VBS获取C:\Program Files\Common Files路径
msgbox CreateObject("WScript.Shell").ExpandEnvironmentStrings("%CommonProgramFiles%")
给桌面添加网址快捷方式
set gangzi = WScript.CreateObject("WScript.Shell")
strDesktop = gangzi.SpecialFolders("Desktop")
set oShellLink = gangzi.CreateShortcut(strDesktop & "\Internet Explorer.lnk")
oShellLink.TargetPath = "www.fendou.info"
oShellLink.Description = "Internet Explorer"
oShellLink.IconLocation = "%ProgramFiles%\Internet , 0"
oShellLink.Save
给收藏夹添加网址
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 & "\奋斗Blog.url")
objURLShortcut.TargetPath = "www.fendou.info/"
objURLShortcut.Save
删除指定目录指定后缀文件
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile "C:\*.vbs", True
Set fso = Nothing
VBS改主页
Set oShell = CreateObject("WScript.Shell")
oShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page","www.fendou.info"
VBS加启动项
Set oShell=CreateObject("Wscript.Shell")
oShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\cmd",""
VBS复制自己
set copy1=createobject("scripting.filesystemobject")
复制自己到C盘的huan.vbs(复制本vbs目录下的文件到c盘的)
set copy1=createobject("scripting.filesystemobject")
VBS获取系统临时目录
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim tempfolder
Const TemporaryFolder = 2
Set tempfolder = fso.GetSpecialFolder(TemporaryFolder)
Wscript.Echo tempfolder
就算代码出错 依然继续执行
On Error Res
ume Next
VBS打开网址
Set objShell = CreateObject("Wscript.Shell")
objShell.Run("www.fendou.info/")
VBS发送邮件
NameSpace = "schemas.microsoft/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = "发件@qq"
Email.To = "收件@qq"
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.邮件服务器"
.Item(NameSpace&"smtpserverport") = 25
.Item(NameSpace&"smtpauthenticate") = 1
.Item(NameSpace&"sendusername") = "发件人用户名"
.Item(NameSpace&"sendpassword") = "发件人密码"
.Update
End With
Email.Send
VBS结束进程
strComputer = "."
Set objWMIService = GetObject _
("winmgmts:\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = ''")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
VBS隐藏打开网址(部分浏览器无法隐藏打开，而是直接打开，适合主流用户使用)
createObject("wscript.shell").run "iexplore www.fendou.info/",0
兼容所有浏览器，使用IE的绝对路径+参数打开，无法用函数得到IE安装路径，只用函数得到了Program Files路径，应该比上面的方法好，但是两种方法都不是绝对的。
Set objws=WScript.CreateObject("wscript.shell")
objws.Run """C:\Program Files\Internet ""www.baidu",vbhide
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 = ''")
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 & "\"
objFSO.DeleteFile(fPath), True
Next
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
VBS获取本机注册表主页地址
Set reg=WScript.CreateObject("WScript.Shell")
startpage=reg.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page")
MsgBox startpage
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
获取计算机所有盘符
Set fso=CreateObject("scripting.filesystemobject")
Set objdrives=fso.Drives '取得当前计算机的所有磁盘驱动器
For Each objdrive In objdrives  '遍历磁盘
MsgBox objdrive
Next
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 ")
TestFile.Close
Next
VBS遍历本机全盘到所有，然后给他们改名
set fs = CreateObject("Scripting.FileSystemObject")
for each drive in fs.drives
folder
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 = "" then file.name = ""
next
end sub
VBS写入代码到粘贴板（先说明一下，VBS写内容到粘贴板，网上千篇一律都是通过InternetExplorer.Application对象来实现，但是缺点是在默认浏览器为非IE中会弹出浏览器，所以费了很大的劲到了这个代码来实现）
str=“这里是你要复制到剪贴板的字符串”
Set ws = ateobject("wscript.shell")
ws.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+")(close)",0,true
QQ自动发消息
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"
VBS隐藏文件
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile("F:\软件大赛\")
If objFile.Attributes = objFile.Attributes AND 2 Then
objFile.Attributes = objFile.Attributes XOR 2
End If
VBS生成随机数（521是生成规则，不同的数字生成的规则不一样，可以用于其它用途）
Randomize 521
point=Array(Int(100*Rnd+1),Int(1000*Rnd+1),Int(10000*Rnd+1))
msgbox join(point,"")
VBS删除桌面IE图标（非快捷方
式）
Set oShell = CreateObject("WScript.Shell")
oShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoInternetIcon",1,"REG_DWORD"
VBS获取自身文件名
Set fso = CreateObject("Scripting.FileSystemObject")
msgbox WScript.ScriptName
VBS读取Unicode编码的文件
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("",1,False,-1)
strText = objFile.ReadAll
objFile.Close
Wscript.Echo strText
VBS读取指定编码的文件（默认为uft-8）gangzi变量是要读取文件的路径
set stm2 =createobject("ADODB.Stream")
stm2.Charset = "utf-8"
stm2.Open
stm2.LoadFromFile gangzi
readfile = stm2.ReadText
MsgBox readfile
VBS禁用组策略
Set oShell = CreateObject("WScript.Shell")
oShell.RegWrite "HKEY_CURRENT_USER\Software\Policies\Microsoft\MMC\RestrictToPermittedSnapins",1,"REG_DWORD"
VBS写指定编码的文件（默认为uft-8）gangzi变量是要读取文件的路径，gangzi2是内容变量
gangzi="1.txt"
gangzi2=""
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
VBS获取当前目录下所有文件夹名字（不包括子文件夹）
Set fso=CreateObject("scripting.filesystemobject")
Set f=fso.GetFolder(fso.GetAbsolutePathName("."))
Set folders=f.SubFolders
For Each fo In folders
Next
Set folders=Nothing
Set f=nothing
Set fso=nothing
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
VBS创建.URL文件（IconIndex参数不同的数字代表不同的图标，具体请参照SHELL32.dll里面的所有图标）
set fso=createobject("scripting.filesystemobject")
qidong=qidong&"[InternetShortcut]"&Chr(13)&Chr(10)
qidong=qidong&"URL=www.fendou.info"&Chr(13)&Chr(10)
qidong=qidong&"IconFile=C:\WINDOWS\system32\SHELL32.dll"&Chr(13)&Chr(10)
vbs脚本病毒
qidong=qidong&"IconIndex=130"&Chr(13)&Chr(10)
Set TestFile=fso.CreateTextFile("qq.url",Ture)
TestFile.WriteLine(qidong)
TestFile.Close
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"&vbcrlf&"127.0.0.1 g"
f.Close
VBS读取出HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace 下面所有键的名字并循环输出
Const HKLM = &H80000002
strPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explo
rer\Desktop\NameSpace"
Set oreg = GetObject("Winmgmts:\root\default:StdRegProv")
oreg.EnumKey HKLM,strPath,arr
For Each x In arr
WScript.Echo x
Next
VBS创建txt文件
Dim fso,TestFile
Set fso=CreateObject("Scripting.FileSystemObject")
Set TestFile=fso.CreateTextFile("C:\",Ture)
TestFile.WriteLine("Hello,World!")
TestFile.Close
VBS创建文件夹
Dim fso,fld
Set fso=CreateObject("Scripting.FileSystemObject")
Set fld=fso.CreateFolder("C:\newFolder")
VBS判断文件夹是否存在
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
VBS使用变量判断文件夹
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
VBS加输入框
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&fldName))Then
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
VBS检查是否有相同文件
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&fldName))Then
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
VBS改写、追加 文件
Dim fso,openFile
Set fso=CreateObject("Scripting.FileSystemObject")
Set openFile=fso.OpenTextFile("C:\",2,True)  '1表示只读，2表示可写，8表示追加
openFile.Write "Hello World!"
openFile.Close
VBS读取文件 ReadAll 读取全部
Dim fso,openFile
Set fso=CreateObject("Scripting.FileSystemObject")
Set openFile=fso.OpenTextFile("C:\",1,True)
MsgBox(openFile.ReadAll)
VBS读取文件 ReadLine 读取一行
Dim fso,openFile
Set fso=CreateObject("Scripting.FileSystemObject")
Set openFile=fso.OpenTextFile("C:\",1,True)
MsgBox(openFile.ReadLine())
MsgBox(openFile.ReadLine())  '如果读取行数超过文件的行数，就会出错
VBS读取文件

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。