引言：什么是VBScript及其重要性
VBScript（Visual Basic Scripting Edition）是一种由微软开发的轻量级脚本语言，它是Visual Basic家族的成员。作为一种解释型脚本语言，VBScript不需要编译即可运行，特别适合用于自动化任务、系统管理和网页开发。在Windows环境中，VBScript可以访问操作系统的许多功能，使其成为自动化日常任务的理想选择。
VBScript的重要性体现在以下几个方面：
易于学习
：语法简单，对于有编程基础的人来说很容易上手
广泛兼容
：在Windows系统中内置支持，无需额外安装
功能强大
：可以访问文件系统、注册表、网络等系统资源
自动化能力
：能够自动执行重复性任务，提高工作效率
VBScript基础语法
第一个VBScript程序
让我们从经典的”Hello, World!“程序开始：
‘ 这是一个简单的VBScript程序
MsgBox “Hello, World!”
将以上代码保存为
.vbs
文件（例如
hello.vbs
），然后双击运行，您将看到一个弹出窗口显示”Hello, World!“。
基本语法规则
VBScript的语法规则相对简单：
注释
：使用单引号(
‘
)来添加注释
大小写不敏感
：VBScript不区分大小写
语句分隔
：每行通常一个语句，多个语句可用冒号(
:
)分隔
续行
：使用下划线(
_
)将长语句分成多行
‘ 注释示例
‘ 下面的代码演示了语句分隔和续行
MsgBox “第一条语句” : MsgBox “第二条语句”
MsgBox “这是一个很长的消息，” & _
“所以使用了续行符将其分成两行”
变量和数据类型
变量声明与使用
在VBScript中，可以使用
Dim
、
Private
或
Public
语句声明变量。虽然VBScript允许不声明变量直接使用，但良好的编程习惯是先声明后使用。
‘ 声明变量
Dim userName
Dim age, email ‘ 可以一次声明多个变量
‘ 赋值
userName = “张三”
age = 30
email = “zhangsan@example.com”
‘ 使用变量
MsgBox “用户名: ” & userName & vbCrLf & _
“年龄: ” & age & vbCrLf & _
“邮箱: ” & email
数据类型
VBScript只有一种数据类型，称为
Variant
，它可以包含不同类型的信息。
Variant
的子类型包括：
Empty
：未初始化
Null
：不包含有效数据
Boolean
：True或False
Byte
：0到255的整数
Integer
：-32,768到32,767的整数
Long
：-2,147,483,648到2,147,483,647的整数
Single
：单精度浮点数
Double
：双精度浮点数
Date
：日期和时间
String
：字符串
Object
：对象
Error
：错误号
‘ 不同数据类型的示例
Dim varEmpty, varNull, varBoolean, varInteger
Dim varLong, varDouble, varDate, varString
‘ Empty类型（未初始化）
MsgBox “varEmpty的类型是: ” & TypeName(varEmpty)
‘ Null类型
varNull = Null
MsgBox “varNull的类型是: ” & TypeName(varNull)
‘ Boolean类型
varBoolean = True
MsgBox “varBoolean的类型是: ” & TypeName(varBoolean) & “，值是: ” & varBoolean
‘ Integer类型
varInteger = 100
MsgBox “varInteger的类型是: ” & TypeName(varInteger) & “，值是: ” & varInteger
‘ Long类型
varLong = 100000
MsgBox “varLong的类型是: ” & TypeName(varLong) & “，值是: ” & varLong
‘ Double类型
varDouble = 3.1415926535
MsgBox “varDouble的类型是: ” & TypeName(varDouble) & “，值是: ” & varDouble
‘ Date类型
varDate = Now()
MsgBox “varDate的类型是: ” & TypeName(varDate) & “，值是: ” & varDate
‘ String类型
varString = “这是一个字符串”
MsgBox “varString的类型是: ” & TypeName(varString) & “，值是: ” & varString
变量作用域
VBScript中的变量有不同的作用域：
脚本级变量
：在所有过程外声明，整个脚本都可以访问
过程级变量
：在过程内声明，只在该过程内有效
‘ 脚本级变量
Dim scriptLevelVar
scriptLevelVar = “我是脚本级变量”
‘ 子程序
Sub ShowVariables()
‘ 过程级变量
Dim procedureLevelVar
procedureLevelVar = “我是过程级变量”
MsgBox “在子程序中:” & vbCrLf & _
“scriptLevelVar = ” & scriptLevelVar & vbCrLf & _
“procedureLevelVar = ” & procedureLevelVar
End Sub
‘ 调用子程序
Call ShowVariables()
‘ 尝试访问过程级变量（会出错）
On Error Resume Next
MsgBox “在脚本级别:” & vbCrLf & _
“scriptLevelVar = ” & scriptLevelVar & vbCrLf & _
“procedureLevelVar = ” & procedureLevelVar
If Err.Number <> 0 Then
MsgBox “错误: ” & Err.Description
End If
On Error GoTo 0
控制结构
条件语句
VBScript提供了多种条件语句，包括
If…Then…Else
和
Select Case
。
If…Then…Else语句
‘ 简单If语句
Dim score
score = 85
If score >= 60 Then
MsgBox “恭喜！您通过了考试。”
End If
‘ If…Else语句
If score >= 60 Then
MsgBox “恭喜！您通过了考试。”
Else
MsgBox “很遗憾，您没有通过考试。”
End If
‘ If…ElseIf…Else语句
If score >= 90 Then
MsgBox “优秀！”
ElseIf score >= 80 Then
MsgBox “良好！”
ElseIf score >= 70 Then
MsgBox “中等！”
ElseIf score >= 60 Then
MsgBox “及格！”
Else
MsgBox “不及格！”
End If
Select Case语句
当需要根据一个表达式的多个可能值执行不同操作时，
Select Case
语句比多个
ElseIf
更清晰。
‘ Select Case示例
Dim dayOfWeek
dayOfWeek = Weekday(Now())
Select Case dayOfWeek
Case 1
MsgBox “今天是星期日”
Case 2
MsgBox “今天是星期一”
Case 3
MsgBox “今天是星期二”
Case 4
MsgBox “今天是星期三”
Case 5
MsgBox “今天是星期四”
Case 6
MsgBox “今天是星期五”
Case 7
MsgBox “今天是星期六”
Case Else
MsgBox “无效的日期”
End Select
‘ 使用比较运算符的Select Case
Dim temperature
temperature = 25
Select Case True
Case temperature < 0
MsgBox "严寒"
Case temperature < 10
MsgBox "寒冷"
Case temperature < 20
MsgBox "凉爽"
Case temperature < 30
MsgBox "温暖"
Case Else
MsgBox "炎热"
End Select
循环语句
VBScript提供了多种循环结构，包括
Do...Loop
、
While...Wend
、
For...Next
和
For Each...Next
。
Do…Loop循环
' Do While...Loop（先判断后执行）
Dim counter
counter = 1
Do While counter <= 5
MsgBox "计数器值: " & counter
counter = counter + 1
Loop
' Do...Loop While（先执行后判断）
counter = 1
Do
MsgBox "计数器值: " & counter
counter = counter + 1
Loop While counter <= 5
' Do Until...Loop（直到条件为真时停止）
counter = 1
Do Until counter > 5
MsgBox “计数器值: ” & counter
counter = counter + 1
Loop
‘ Do…Loop Until（先执行后判断）
counter = 1
Do
MsgBox “计数器值: ” & counter
counter = counter + 1
Loop Until counter > 5
While…Wend循环
‘ While…Wend循环
counter = 1
While counter <= 5
MsgBox "计数器值: " & counter
counter = counter + 1
Wend
For…Next循环
' 基本的For...Next循环
Dim i
For i = 1 To 5
MsgBox "循环计数: " & i
Next
' 带步长的For...Next循环
For i = 1 To 10 Step 2
MsgBox "循环计数: " & i
Next
' 递减的For...Next循环
For i = 10 To 1 Step -1
MsgBox "倒计时: " & i
Next
' 嵌套的For...Next循环
Dim j
For i = 1 To 3
For j = 1 To 3
MsgBox "i = " & i & ", j = " & j
Next
Next
For Each…Next循环
' For Each...Next循环用于遍历集合或数组
Dim drives, drive
Set drives = CreateObject("Scripting.FileSystemObject").Drives
For Each drive In drives
MsgBox "驱动器 " & drive.DriveLetter & ": " & _
"可用空间: " & FormatNumber(drive.AvailableSpace / 1024 / 1024, 2) & " MB"
Next
函数和子程序
子程序（Sub）
子程序是执行特定任务但不返回值的代码块。
' 定义子程序
Sub ShowWelcomeMessage(name)
MsgBox "欢迎, " & name & "!"
End Sub
' 调用子程序
Call ShowWelcomeMessage("张三")
' 或者不使用Call关键字
ShowWelcomeMessage("李四")
' 带参数的子程序
Sub CalculateSum(a, b)
MsgBox a & " + " & b & " = " & (a + b)
End Sub
CalculateSum 10, 20
' 带可选参数的子程序
Sub Greet(name, Optional greeting = "你好")
MsgBox greeting & ", " & name & "!"
End Sub
Greet "王五"
Greet "赵六", "早上好"
函数（Function）
函数是执行特定任务并返回值的代码块。
' 定义函数
Function GetFullName(firstName, lastName)
GetFullName = firstName & " " & lastName
End Function
' 使用函数
Dim fullName
fullName = GetFullName("张", "三")
MsgBox "全名: " & fullName
' 带参数验证的函数
Function Divide(a, b)
If b = 0 Then
Divide = "错误：除数不能为零"
Else
Divide = a / b
End If
End Function
MsgBox "10 / 2 = " & Divide(10, 2)
MsgBox "10 / 0 = " & Divide(10, 0)
' 递归函数示例
Function Factorial(n)
If n = 0 Or n = 1 Then
Factorial = 1
Else
Factorial = n * Factorial(n - 1)
End If
End Function
MsgBox "5的阶乘是: " & Factorial(5)
内置函数
VBScript提供了许多内置函数，用于处理字符串、日期、数学运算等。
字符串函数
Dim str
str = "Hello, World!"
' 字符串长度
MsgBox "字符串长度: " & Len(str)
' 转换为大写和小写
MsgBox "大写: " & UCase(str)
MsgBox "小写: " & LCase(str)
' 去除空格
Dim strWithSpaces
strWithSpaces = " 前后有空格 "
MsgBox "原字符串: '" & strWithSpaces & "'"
MsgBox "去除空格: '" & Trim(strWithSpaces) & "'"
' 字符串截取
MsgBox "前5个字符: " & Left(str, 5)
MsgBox "后6个字符: " & Right(str, 6)
MsgBox "从第8个位置开始的5个字符: " & Mid(str, 8, 5)
' 字符串替换
MsgBox "替换前: " & str
MsgBox "替换后: " & Replace(str, "World", "VBScript")
' 字符串分割
Dim parts, i
parts = Split("apple,banana,orange", ",")
For i = 0 To UBound(parts)
MsgBox "部分 " & i & ": " & parts(i)
Next
' 字符串连接
Dim fruits
fruits = Join(parts, " | ")
MsgBox "连接后的字符串: " & fruits
日期和时间函数
' 获取当前日期和时间
MsgBox "当前日期: " & Date()
MsgBox "当前时间: " & Time()
MsgBox "当前日期和时间: " & Now()
' 日期部分
MsgBox "年: " & Year(Now())
MsgBox "月: " & Month(Now())
MsgBox "日: " & Day(Now())
MsgBox "星期几: " & Weekday(Now())
MsgBox "小时: " & Hour(Now())
MsgBox "分钟: " & Minute(Now())
MsgBox "秒: " & Second(Now())
' 日期计算
MsgBox "明天: " & DateAdd("d", 1, Date())
MsgBox "下个月: " & DateAdd("m", 1, Date())
MsgBox "明年: " & DateAdd("yyyy", 1, Date())
' 日期差值
Dim startDate, endDate
startDate = #1/1/2023#
endDate = #12/31/2023#
MsgBox "两个日期之间的天数: " & DateDiff("d", startDate, endDate)
' 格式化日期
MsgBox "格式化日期: " & FormatDateTime(Now(), vbLongDate)
MsgBox "格式化时间: " & FormatDateTime(Now(), vbLongTime)
数学函数
' 基本数学运算
MsgBox "绝对值: " & Abs(-10.5)
MsgBox "平方根: " & Sqr(16)
MsgBox "指数: " & Exp(1)
MsgBox "对数: " & Log(10)
MsgBox "正弦: " & Sin(3.1415926535 / 2)
MsgBox "余弦: " & Cos(0)
MsgBox "正切: " & Tan(3.1415926535 / 4)
' 随机数
Randomize ' 初始化随机数生成器
MsgBox "随机数: " & Rnd() ' 0到1之间的随机数
MsgBox "1到100之间的随机整数: " & Int(Rnd() * 100) + 1
' 数值格式化
MsgBox "格式化数字: " & FormatNumber(1234.5678, 2)
MsgBox "格式化货币: " & FormatCurrency(1234.5678, 2)
MsgBox "格式化百分比: " & FormatPercent(0.1234, 2)
文件操作
VBScript可以通过
Scripting.FileSystemObject
对象进行文件系统操作，包括创建、读取、写入和删除文件及文件夹。
文件系统对象基础
' 创建文件系统对象
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
' 检查文件是否存在
Dim filePath
filePath = "C:\Temp\test.txt"
If fso.FileExists(filePath) Then
MsgBox "文件存在: " & filePath
Else
MsgBox "文件不存在: " & filePath
End If
' 检查文件夹是否存在
Dim folderPath
folderPath = "C:\Temp"
If fso.FolderExists(folderPath) Then
MsgBox "文件夹存在: " & folderPath
Else
MsgBox "文件夹不存在: " & folderPath
End If
' 获取文件信息
If fso.FileExists(filePath) Then
Dim file
Set file = fso.GetFile(filePath)
MsgBox "文件信息:" & vbCrLf & _
"路径: " & file.Path & vbCrLf & _
"大小: " & file.Size & " 字节" & vbCrLf & _
"创建时间: " & file.DateCreated & vbCrLf & _
"最后修改时间: " & file.DateLastModified & vbCrLf & _
"最后访问时间: " & file.DateLastAccessed
End If
' 获取文件夹信息
If fso.FolderExists(folderPath) Then
Dim folder
Set folder = fso.GetFolder(folderPath)
MsgBox "文件夹信息:" & vbCrLf & _
"路径: " & folder.Path & vbCrLf & _
"大小: " & folder.Size & " 字节" & vbCrLf & _
"文件数: " & folder.Files.Count & vbCrLf & _
"子文件夹数: " & folder.SubFolders.Count
End If
创建和写入文件
' 创建文件系统对象
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
' 创建文本文件并写入内容
Dim filePath, file
filePath = "C:\Temp\test.txt"
' 检查文件夹是否存在，不存在则创建
Dim folderPath
folderPath = "C:\Temp"
If Not fso.FolderExists(folderPath) Then
fso.CreateFolder(folderPath)
MsgBox "已创建文件夹: " & folderPath
End If
' 创建文件并写入内容
Set file = fso.CreateTextFile(filePath, True) ' True表示可以覆盖已存在的文件
file.WriteLine "这是第一行"
file.WriteLine "这是第二行"
file.Write "这是第三行，没有换行"
file.Close
MsgBox "已创建文件并写入内容: " & filePath
' 追加内容到文件
If fso.FileExists(filePath) Then
Set file = fso.OpenTextFile(filePath, 8) ' 8表示追加模式
file.WriteLine vbCrLf & "这是追加的第四行"
file.Close
MsgBox "已追加内容到文件: " & filePath
End If
读取文件
' 创建文件系统对象
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
' 读取整个文件
Dim filePath, file, content
filePath = "C:\Temp\test.txt"
If fso.FileExists(filePath) Then
Set file = fso.OpenTextFile(filePath, 1) ' 1表示只读模式
content = file.ReadAll
file.Close
MsgBox "文件内容:" & vbCrLf & content
End If
' 逐行读取文件
If fso.FileExists(filePath) Then
Set file = fso.OpenTextFile(filePath, 1)
Dim lines, line
lines = ""
Do Until file.AtEndOfStream
line = file.ReadLine
lines = lines & line & vbCrLf
Loop
file.Close
MsgBox "逐行读取的文件内容:" & vbCrLf & lines
End If
' 读取指定数量的字符
If fso.FileExists(filePath) Then
Set file = fso.OpenTextFile(filePath, 1)
Dim chars
chars = file.Read(10) ' 读取前10个字符
file.Close
MsgBox "前10个字符: " & chars
End If
文件和文件夹操作
' 创建文件系统对象
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
' 创建文件夹
Dim newFolderPath
newFolderPath = "C:\Temp\NewFolder"
If Not fso.FolderExists(newFolderPath) Then
fso.CreateFolder(newFolderPath)
MsgBox "已创建文件夹: " & newFolderPath
Else
MsgBox "文件夹已存在: " & newFolderPath
End If
' 复制文件
Dim sourceFile, destFile
sourceFile = "C:\Temp\test.txt"
destFile = "C:\Temp\NewFolder\test_copy.txt"
If fso.FileExists(sourceFile) Then
fso.CopyFile sourceFile, destFile, True ' True表示可以覆盖已存在的文件
MsgBox "已复制文件: " & sourceFile & " -> ” & destFile
End If
‘ 移动文件
If fso.FileExists(destFile) Then
Dim movedFile
movedFile = “C:\Temp\NewFolder\test_moved.txt”
fso.MoveFile destFile, movedFile
MsgBox “已移动文件: ” & destFile & ” -> ” & movedFile
End If
‘ 删除文件
If fso.FileExists(movedFile) Then
fso.DeleteFile movedFile
MsgBox “已删除文件: ” & movedFile
End If
‘ 复制文件夹
Dim sourceFolder, destFolder
sourceFolder = “C:\Temp\NewFolder”
destFolder = “C:\Temp\NewFolderCopy”
If fso.FolderExists(sourceFolder) Then
fso.CopyFolder sourceFolder, destFolder, True
MsgBox “已复制文件夹: ” & sourceFolder & ” -> ” & destFolder
End If
‘ 删除文件夹
If fso.FolderExists(destFolder) Then
fso.DeleteFolder destFolder
MsgBox “已删除文件夹: ” & destFolder
End If
If fso.FolderExists(newFolderPath) Then
fso.DeleteFolder newFolderPath
MsgBox “已删除文件夹: ” & newFolderPath
End If
与系统交互
VBScript可以通过Windows Script Host (WSH)对象与操作系统交互，执行系统级任务。
WScript和CScript对象
‘ 检查脚本宿主
If IsObject(WScript) Then
MsgBox “当前运行在WScript.exe环境中（Windows GUI）”
Else
MsgBox “当前运行在CScript.exe环境中（命令行）”
End If
‘ 使用WScript对象
If IsObject(WScript) Then
‘ 获取脚本名称和路径
MsgBox “脚本名称: ” & WScript.ScriptName
MsgBox “脚本完整路径: ” & WScript.ScriptFullName
‘ 获取参数
If WScript.Arguments.Count > 0 Then
Dim args, i
args = “”
For i = 0 To WScript.Arguments.Count – 1
args = args & “参数 ” & i & “: ” & WScript.Arguments(i) & vbCrLf
Next
MsgBox “脚本参数:” & vbCrLf & args
Else
MsgBox “没有传递任何参数给脚本”
End If
‘ 创建快捷方式
Dim shell, shortcut, desktopPath
Set shell = CreateObject(“WScript.Shell”)
desktopPath = shell.SpecialFolders(“Desktop”)
Set shortcut = shell.CreateShortcut(desktopPath & “\记事本.lnk”)
shortcut.TargetPath = “%windir%\notepad.exe”
shortcut.Description = “打开记事本”
shortcut.Save
MsgBox “已在桌面创建记事本快捷方式”
End If
运行外部程序
‘ 创建WScript.Shell对象
Dim shell
Set shell = CreateObject(“WScript.Shell”)
‘ 运行程序并等待完成
Dim command, returnCode
command = “%windir%\notepad.exe”
returnCode = shell.Run(command, 1, True) ‘ 1表示激活窗口，True表示等待完成
MsgBox “记事本已关闭，返回代码: ” & returnCode
‘ 运行程序不等待
command = “%windir%\system32\calc.exe”
shell.Run command, 1, False ‘ False表示不等待
MsgBox “计算器已启动（脚本继续执行）”
‘ 使用Exec方法运行命令并获取输出
Dim exec, output
command = “cmd /c dir C:\”
Set exec = shell.Exec(command)
‘ 读取输出
output = “”
Do While exec.Status = 0
output = output & exec.StdOut.ReadAll()
WScript.Sleep 100
Loop
‘ 显示输出（截取前1000个字符以避免消息框过大）
If Len(output) > 1000 Then
MsgBox “命令输出（前1000字符）:” & vbCrLf & Left(output, 1000) & “…”
Else
MsgBox “命令输出:” & vbCrLf & output
End If
注册表操作
‘ 创建WScript.Shell对象
Dim shell
Set shell = CreateObject(“WScript.Shell”)
‘ 读取注册表值
On Error Resume Next
Dim ieVersion
ieVersion = shell.RegRead(“HKLM\SOFTWARE\Microsoft\Internet Explorer\Version”)
If Err.Number = 0 Then
MsgBox “Internet Explorer版本: ” & ieVersion
Else
MsgBox “无法读取Internet Explorer版本: ” & Err.Description
End If
On Error GoTo 0
‘ 写入注册表值
Dim regPath, regValue, regType
regPath = “HKCU\Software\VBScriptTest”
regValue = “TestValue”
regType = “REG_SZ” ‘ 字符串类型
‘ 创建注册表项
On Error Resume Next
shell.RegWrite regPath & “\”, “”, “REG_SZ”
If Err.Number = 0 Then
MsgBox “已创建注册表项: ” & regPath
Else
MsgBox “创建注册表项失败: ” & Err.Description
End If
On Error GoTo 0
‘ 写入注册表值
On Error Resume Next
shell.RegWrite regPath & “\” & regValue, “这是一个测试值”, regType
If Err.Number = 0 Then
MsgBox “已写入注册表值: ” & regPath & “\” & regValue
Else
MsgBox “写入注册表值失败: ” & Err.Description
End If
On Error GoTo 0
‘ 读取刚写入的值
On Error Resume Next
Dim readValue
readValue = shell.RegRead(regPath & “\” & regValue)
If Err.Number = 0 Then
MsgBox “读取的注册表值: ” & readValue
Else
MsgBox “读取注册表值失败: ” & Err.Description
End If
On Error GoTo 0
‘ 删除注册表值
On Error Resume Next
shell.RegDelete regPath & “\” & regValue
If Err.Number = 0 Then
MsgBox “已删除注册表值: ” & regPath & “\” & regValue
Else
MsgBox “删除注册表值失败: ” & Err.Description
End If
On Error GoTo 0
‘ 删除注册表项
On Error Resume Next
shell.RegDelete regPath & “\”
If Err.Number = 0 Then
MsgBox “已删除注册表项: ” & regPath
Else
MsgBox “删除注册表项失败: ” & Err.Description
End If
On Error GoTo 0
系统信息获取
‘ 获取操作系统信息
Dim shell, osInfo
Set shell = CreateObject(“WScript.Shell”)
osInfo = “操作系统信息:” & vbCrLf & _
“计算机名: ” & shell.ExpandEnvironmentStrings(“%COMPUTERNAME%”) & vbCrLf & _
“用户名: ” & shell.ExpandEnvironmentStrings(“%USERNAME%”) & vbCrLf & _
“系统目录: ” & shell.ExpandEnvironmentStrings(“%WINDIR%”) & vbCrLf & _
“临时目录: ” & shell.ExpandEnvironmentStrings(“%TEMP%”) & vbCrLf & _
“程序文件目录: ” & shell.ExpandEnvironmentStrings(“%ProgramFiles%”)
MsgBox osInfo
‘ 使用WMI获取更详细的系统信息
Dim wmi, items, item
Set wmi = GetObject(“winmgmts:\\.\root\cimv2”)
‘ 获取操作系统信息
Set items = wmi.ExecQuery(“Select * from Win32_OperatingSystem”)
For Each item In items
osInfo = “详细操作系统信息:” & vbCrLf & _
“名称: ” & item.Caption & vbCrLf & _
“版本: ” & item.Version & vbCrLf & _
“制造商: ” & item.Manufacturer & vbCrLf & _
“安装日期: ” & item.InstallDate & vbCrLf & _
“上次启动时间: ” & item.LastBootUpTime & vbCrLf & _
“本地日期时间: ” & item.LocalDateTime & vbCrLf & _
“序列号: ” & item.SerialNumber & vbCrLf & _
“注册用户: ” & item.RegisteredUser & vbCrLf & _
“组织: ” & item.Organization
MsgBox osInfo
Exit For
Next
‘ 获取计算机系统信息
Set items = wmi.ExecQuery(“Select * from Win32_ComputerSystem”)
For Each item In items
Dim sysInfo
sysInfo = “计算机系统信息:” & vbCrLf & _
“名称: ” & item.Name & vbCrLf & _
“制造商: ” & item.Manufacturer & vbCrLf & _
“型号: ” & item.Model & vbCrLf & _
“系统类型: ” & item.SystemType & vbCrLf & _
“处理器数量: ” & item.NumberOfProcessors & vbCrLf & _
“总物理内存: ” & Round(item.TotalPhysicalMemory / 1024 / 1024, 2) & ” MB”
MsgBox sysInfo
Exit For
Next
‘ 获取处理器信息
Set items = wmi.ExecQuery(“Select * from Win32_Processor”)
For Each item In items
Dim cpuInfo
cpuInfo = “处理器信息:” & vbCrLf & _
“名称: ” & item.Name & vbCrLf & _
“制造商: ” & item.Manufacturer & vbCrLf & _
“最大时钟速度: ” & item.MaxClockSpeed & ” MHz” & vbCrLf & _
“当前时钟速度: ” & item.CurrentClockSpeed & ” MHz” & vbCrLf & _
“核心数: ” & item.NumberOfCores & vbCrLf & _
“逻辑处理器数: ” & item.NumberOfLogicalProcessors
MsgBox cpuInfo
Exit For
Next
实际应用案例
自动备份文件
‘ 自动备份文件脚本
Option Explicit
‘ 配置部分
Dim sourceFolder, backupFolder, logFile
sourceFolder = “C:\ImportantFiles” ‘ 要备份的源文件夹
backupFolder = “D:\Backups” ‘ 备份目标文件夹
logFile = “D:\Backups\backup_log.txt” ‘ 日志文件
‘ 创建文件系统对象
Dim fso
Set fso = CreateObject(“Scripting.FileSystemObject”)
‘ 创建日志函数
Sub LogMessage(message)
Dim logStream
Set logStream = fso.OpenTextFile(logFile, 8, True) ‘ 8 = 追加模式
logStream.WriteLine Now() & ” – ” & message
logStream.Close
End Sub
‘ 主程序
On Error Resume Next
‘ 检查源文件夹是否存在
If Not fso.FolderExists(sourceFolder) Then
LogMessage “错误: 源文件夹不存在 – ” & sourceFolder
MsgBox “错误: 源文件夹不存在 – ” & sourceFolder, vbCritical
WScript.Quit(1)
End If
‘ 创建备份文件夹（如果不存在）
If Not fso.FolderExists(backupFolder) Then
fso.CreateFolder backupFolder
LogMessage “创建备份文件夹 – ” & backupFolder
End If
‘ 创建带日期的子文件夹
Dim dateFolder
dateFolder = backupFolder & “\Backup_” & Year(Now()) & Right(“0” & Month(Now()), 2) & Right(“0” & Day(Now()), 2)
If Not fso.FolderExists(dateFolder) Then
fso.CreateFolder dateFolder
LogMessage “创建日期备份文件夹 – ” & dateFolder
End If
‘ 复制文件
Dim sourceFolderObj, file, filesCopied, filesSkipped
Set sourceFolderObj = fso.GetFolder(sourceFolder)
filesCopied = 0
filesSkipped = 0
For Each file In sourceFolderObj.Files
Dim destFile
destFile = dateFolder & “\” & file.Name
‘ 检查文件是否已存在
If fso.FileExists(destFile) Then
‘ 比较文件修改时间
Dim destFileObj
Set destFileObj = fso.GetFile(destFile)
If file.DateLastModified > destFileObj.DateLastModified Then
‘ 源文件更新，覆盖目标文件
fso.CopyFile file.Path, destFile, True
LogMessage “更新文件 – ” & file.Name
filesCopied = filesCopied + 1
Else
‘ 目标文件更新或相同，跳过
LogMessage “跳过文件（未更改） – ” & file.Name
filesSkipped = filesSkipped + 1
End If
Else
‘ 文件不存在，复制
fso.CopyFile file.Path, destFile
LogMessage “复制新文件 – ” & file.Name
filesCopied = filesCopied + 1
End If
Next
‘ 递归复制子文件夹
Sub CopySubFolders(sourceFolder, destFolder)
Dim subFolder, subDestFolder
For Each subFolder In sourceFolder.SubFolders
subDestFolder = destFolder & “\” & subFolder.Name
‘ 创建目标子文件夹
If Not fso.FolderExists(subDestFolder) Then
fso.CreateFolder subDestFolder
LogMessage “创建子文件夹 – ” & subDestFolder
End If
‘ 复制子文件夹中的文件
Dim file
For Each file In subFolder.Files
Dim destFile
destFile = subDestFolder & “\” & file.Name
‘ 检查文件是否已存在
If fso.FileExists(destFile) Then
‘ 比较文件修改时间
Dim destFileObj
Set destFileObj = fso.GetFile(destFile)
If file.DateLastModified > destFileObj.DateLastModified Then
‘ 源文件更新，覆盖目标文件
fso.CopyFile file.Path, destFile, True
LogMessage “更新文件 – ” & subFolder.Name & “\” & file.Name
filesCopied = filesCopied + 1
Else
‘ 目标文件更新或相同，跳过
LogMessage “跳过文件（未更改） – ” & subFolder.Name & “\” & file.Name
filesSkipped = filesSkipped + 1
End If
Else
‘ 文件不存在，复制
fso.CopyFile file.Path, destFile
LogMessage “复制新文件 – ” & subFolder.Name & “\” & file.Name
filesCopied = filesCopied + 1
End If
Next
‘ 递归处理子文件夹
CopySubFolders subFolder, subDestFolder
Next
End Sub
‘ 调用递归函数复制子文件夹
CopySubFolders sourceFolderObj, dateFolder
‘ 完成消息
Dim summary
summary = “备份完成!” & vbCrLf & _
“源文件夹: ” & sourceFolder & vbCrLf & _
“目标文件夹: ” & dateFolder & vbCrLf & _
“复制文件数: ” & filesCopied & vbCrLf & _
“跳过文件数: ” & filesSkipped
MsgBox summary, vbInformation
LogMessage summary
‘ 清理对象
Set fso = Nothing
Set sourceFolderObj = Nothing
‘ 检查错误
If Err.Number <> 0 Then
LogMessage “错误: ” & Err.Description & ” (错误号: ” & Err.Number & “)”
MsgBox “发生错误: ” & Err.Description & ” (错误号: ” & Err.Number & “)”, vbCritical
End If
On Error GoTo 0
批量重命名文件
‘ 批量重命名文件脚本
Option Explicit
‘ 配置部分
Dim targetFolder, filePrefix, startNumber, padZero, logFile
targetFolder = “C:\Temp\RenameTest” ‘ 目标文件夹
filePrefix = “IMG_” ‘ 文件前缀
startNumber = 1 ‘ 起始编号
padZero = 4 ‘ 编号位数（不足补零）
logFile = “C:\Temp\rename_log.txt” ‘ 日志文件
‘ 创建文件系统对象
Dim fso
Set fso = CreateObject(“Scripting.FileSystemObject”)
‘ 创建日志函数
Sub LogMessage(message)
Dim logStream
Set logStream = fso.OpenTextFile(logFile, 8, True) ‘ 8 = 追加模式
logStream.WriteLine Now() & ” – ” & message
logStream.Close
End Sub
‘ 格式化编号函数
Function FormatNumber(number, digits)
Dim result, i
result = CStr(number)
‘ 补零
For i = Len(result) To digits – 1
result = “0” & result
Next
FormatNumber = result
End Function
‘ 主程序
On Error Resume Next
‘ 检查目标文件夹是否存在
If Not fso.FolderExists(targetFolder) Then
LogMessage “错误: 目标文件夹不存在 – ” & targetFolder
MsgBox “错误: 目标文件夹不存在 – ” & targetFolder, vbCritical
WScript.Quit(1)
End If
‘ 获取文件夹对象
Dim folderObj
Set folderObj = fso.GetFolder(targetFolder)
‘ 显示确认信息
Dim confirmMsg
confirmMsg = “将重命名文件夹中的所有文件:” & vbCrLf & _
“文件夹: ” & targetFolder & vbCrLf & _
“前缀: ” & filePrefix & vbCrLf & _
“起始编号: ” & startNumber & vbCrLf & _
“编号位数: ” & padZero & vbCrLf & _
vbCrLf & “确定要继续吗?”
If MsgBox(confirmMsg, vbQuestion + vbYesNo, “确认重命名”) <> vbYes Then
LogMessage “用户取消了操作”
WScript.Quit(0)
End If
‘ 获取文件列表并按修改时间排序
Dim files(), fileCount, file
fileCount = 0
‘ 计算文件数量
For Each file In folderObj.Files
fileCount = fileCount + 1
Next
‘ 调整数组大小
ReDim files(fileCount – 1)
‘ 填充数组
Dim index
index = 0
For Each file In folderObj.Files
Set files(index) = file
index = index + 1
Next
‘ 简单的冒泡排序（按修改时间）
Dim i, j, temp
For i = 0 To UBound(files) – 1
For j = i + 1 To UBound(files)
If files(i).DateLastModified > files(j).DateLastModified Then
Set temp = files(j)
Set files(j) = files(i)
Set files(i) = temp
End If
Next
Next
‘ 重命名文件
Dim currentNumber, renamedCount, skippedCount
currentNumber = startNumber
renamedCount = 0
skippedCount = 0
For i = 0 To UBound(files)
Dim oldName, newName, extension
oldName = files(i).Name
‘ 获取文件扩展名
extension = “”
If InStr(oldName, “.”) > 0 Then
extension = Mid(oldName, InStrRev(oldName, “.”))
End If
‘ 构建新文件名
newName = filePrefix & FormatNumber(currentNumber, padZero) & extension
‘ 检查新文件名是否已存在
If fso.FileExists(targetFolder & “\” & newName) Then
LogMessage “跳过文件（目标文件名已存在）: ” & oldName & ” -> ” & newName
skippedCount = skippedCount + 1
Else
‘ 重命名文件
files(i).Name = newName
LogMessage “重命名文件: ” & oldName & ” -> ” & newName
renamedCount = renamedCount + 1
currentNumber = currentNumber + 1
End If
Next
‘ 完成消息
Dim summary
summary = “重命名完成!” & vbCrLf & _
“文件夹: ” & targetFolder & vbCrLf & _
“重命名文件数: ” & renamedCount & vbCrLf & _
“跳过文件数: ” & skippedCount
MsgBox summary, vbInformation
LogMessage summary
‘ 清理对象
Set fso = Nothing
Set folderObj = Nothing
Erase files
‘ 检查错误
If Err.Number <> 0 Then
LogMessage “错误: ” & Err.Description & ” (错误号: ” & Err.Number & “)”
MsgBox “发生错误: ” & Err.Description & ” (错误号: ” & Err.Number & “)”, vbCritical
End If
On Error GoTo 0
系统信息收集工具
‘ 系统信息收集工具
Option Explicit
‘ 配置部分
Dim outputFile
outputFile = “C:\Temp\SystemInfo_” & Year(Now()) & Right(“0” & Month(Now()), 2) & Right(“0” & Day(Now()), 2) & “.html”
‘ 创建文件系统对象
Dim fso
Set fso = CreateObject(“Scripting.FileSystemObject”)
‘ 创建WScript.Shell对象
Dim shell
Set shell = CreateObject(“WScript.Shell”)
‘ 创建WMI对象
Dim wmi
Set wmi = GetObject(“winmgmts:\\.\root\cimv2”)
‘ 创建HTML报告
Sub CreateHTMLReport()
Dim htmlFile, htmlContent
‘ 创建输出文件夹（如果不存在）
Dim outputFolder
outputFolder = fso.GetParentFolderName(outputFile)
If Not fso.FolderExists(outputFolder) Then
fso.CreateFolder outputFolder
End If
‘ 创建HTML文件
Set htmlFile = fso.CreateTextFile(outputFile, True)
‘ HTML头部
htmlContent = “” & vbCrLf & _
“” & vbCrLf & _
“
”
” ” & vbCrLf & _
”
” & vbCrLf & _
“” & vbCrLf & _
“
”
系统信息报告
” & vbCrLf & _
”
生成时间: ” & Now() & “
” & vbCrLf & _
”
” & vbCrLf
‘ 添加基本信息
htmlContent = htmlContent & GetBasicInfo()
‘ 添加操作系统信息
htmlContent = htmlContent & GetOSInfo()
‘ 添加计算机系统信息
htmlContent = htmlContent & GetComputerSystemInfo()
‘ 添加处理器信息
htmlContent = htmlContent & GetProcessorInfo()
‘ 添加内存信息
htmlContent = htmlContent & GetMemoryInfo()
‘ 添加磁盘信息
htmlContent = htmlContent & GetDiskInfo()
‘ 添加网络适配器信息
htmlContent = htmlContent & GetNetworkAdapterInfo()
‘ 添加软件信息
htmlContent = htmlContent & GetSoftwareInfo()
‘ 添加服务信息
htmlContent = htmlContent & GetServiceInfo()
‘ 添加进程信息
htmlContent = htmlContent & GetProcessInfo()
‘ HTML尾部
htmlContent = htmlContent & “” & vbCrLf & “”
‘ 写入HTML文件
htmlFile.Write htmlContent
htmlFile.Close
‘ 显示完成消息
MsgBox “系统信息报告已生成: ” & outputFile, vbInformation
‘ 打开报告
shell.Run outputFile
End Sub
‘ 获取基本信息
Function GetBasicInfo()
Dim html, computerName, userName, domain
computerName = shell.ExpandEnvironmentStrings(“%COMPUTERNAME%”)
userName = shell.ExpandEnvironmentStrings(“%USERNAME%”)
domain = shell.ExpandEnvironmentStrings(“%USERDOMAIN%”)
html = “
基本信息
” & vbCrLf & _
“
| 项目 | 值 |
|---|---|
| 计算机名 | ” & computerName & “ |
| 用户名 | ” & userName & “ |
| 域 | ” & domain & “ |
” & vbCrLf
GetBasicInfo = html
End Function
‘ 获取操作系统信息
Function GetOSInfo()
Dim html, items, item
Set items = wmi.ExecQuery(“Select * from Win32_OperatingSystem”)
html = “
操作系统信息
” & vbCrLf & _
“
| 属性 | 值 |
|---|---|
| 名称 | ” & item.Caption & “ |
| 版本 | ” & item.Version & “ |
| 制造商 | ” & item.Manufacturer & “ |
| 系统目录 | ” & item.WindowsDirectory & “ |
| 本地日期时间 | ” & item.LocalDateTime & “ |
| 上次启动时间 | ” & item.LastBootUpTime & “ |
| 序列号 | ” & item.SerialNumber & “ |
” & vbCrLf
GetOSInfo = html
End Function
‘ 获取计算机系统信息
Function GetComputerSystemInfo()
Dim html, items, item
Set items = wmi.ExecQuery(“Select * from Win32_ComputerSystem”)
html = “
计算机系统信息
” & vbCrLf & _
“
| 属性 | 值 |
|---|---|
| 制造商 | ” & item.Manufacturer & “ |
| 型号 | ” & item.Model & “ |
| 系统类型 | ” & item.SystemType & “ |
| 处理器数量 | ” & item.NumberOfProcessors & “ |
| 总物理内存 | ” & Round(item.TotalPhysicalMemory / 1024 / 1024, 2) & ” MB |
” & vbCrLf
GetComputerSystemInfo = html
End Function
‘ 获取处理器信息
Function GetProcessorInfo()
Dim html, items, item
Set items = wmi.ExecQuery(“Select * from Win32_Processor”)
html = “
处理器信息
” & vbCrLf & _
“
| 属性 | 值 |
|---|---|
| 名称 | ” & item.Name & “ |
| 制造商 | ” & item.Manufacturer & “ |
| 最大时钟速度 | ” & item.MaxClockSpeed & ” MHz |
| 当前时钟速度 | ” & item.CurrentClockSpeed & ” MHz |
| 核心数 | ” & item.NumberOfCores & “ |
| 逻辑处理器数 | ” & item.NumberOfLogicalProcessors & “ |
” & vbCrLf
GetProcessorInfo = html
End Function
‘ 获取内存信息
Function GetMemoryInfo()
Dim html, items, item
Set items = wmi.ExecQuery(“Select * from Win32_PhysicalMemory”)
html = “
内存信息
” & vbCrLf & _
“
| 属性 | 值 |
|---|---|
| 内存条 ” & item.DeviceLocator & “ | ” & Round(capacity, 2) & ” MB |
| 总内存 | ” & Round(totalCapacity, 2) & ” MB |
” & vbCrLf
GetMemoryInfo = html
End Function
‘ 获取磁盘信息
Function GetDiskInfo()
Dim html, items, item
Set items = wmi.ExecQuery(“Select * from Win32_LogicalDisk Where DriveType=3”)
html = “
磁盘信息
” & vbCrLf & _
“
| 驱动器 | 文件系统 | 总大小 | 可用空间 | 使用率 |
|---|---|---|---|---|
| ” & item.DeviceID & “ | ” & item.FileSystem & “ | ” & _ Round(totalSize, 2) & ” GB |
” & Round(freeSpace, 2) & ” GB | ” & _ usagePercent & “% |
” & vbCrLf
GetDiskInfo = html
End Function
‘ 获取网络适配器信息
Function GetNetworkAdapterInfo()
Dim html, items, item
Set items = wmi.ExecQuery(“Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=True”)
html = “
网络适配器信息
” & vbCrLf & _
“
| 属性 | 值 |
|---|---|
| 描述 | ” & item.Description & “ |
| MAC地址 | ” & macAddress & “ |
| IP地址 | ” & ipAddresses & “ |
| 子网掩码 | ” & Join(item.IPSubnet, “, “) & “ |
| 默认网关 | ” & Join(item.DefaultIPGateway, “, “) & “ |
| DNS服务器 | ” & Join(item.DNSServerSearchOrder, “, “) & “ |
| DHCP启用 | ” & item.DHCPEnabled & “ |
” & vbCrLf
GetNetworkAdapterInfo = html
End Function
‘ 获取软件信息
Function GetSoftwareInfo()
Dim html, items, item
Set items = wmi.ExecQuery(“Select * from Win32_Product”)
html = “
已安装软件
” & vbCrLf & _
“
| 名称 | 版本 | 供应商 | 安装日期 |
|---|---|---|---|
| ” & item.Name & “ | ” & item.Version & “ | ” & _ item.Vendor & “ |
” & installDate & “ |
” & vbCrLf
GetSoftwareInfo = html
End Function
‘ 获取服务信息
Function GetServiceInfo()
Dim html, items, item
Set items = wmi.ExecQuery(“Select * from Win32_Service Where State=’Running’”)
html = “
运行中的服务
” & vbCrLf & _
“
| 名称 | 显示名称 | 状态 | 启动模式 | 进程ID |
|---|---|---|---|---|
| ” & item.Name & “ | ” & item.DisplayName & “ | ” & _ item.State & “ |
” & item.StartMode & “ | ” & item.ProcessId & “ |
” & vbCrLf
GetServiceInfo = html
End Function
‘ 获取进程信息
Function GetProcessInfo()
Dim html, items, item
Set items = wmi.ExecQuery(“Select * from Win32_Process”)
html = “
运行中的进程
” & vbCrLf & _
“
| 名称 | 进程ID | 父进程ID | 线程数 | 路径 |
|---|---|---|---|---|
| ” & item.Name & “ | ” & item.ProcessId & “ | ” & _ item.ParentProcessId & “ |
” & item.ThreadCount & “ | ” & _ item.ExecutablePath & “ |
” & vbCrLf
GetProcessInfo = html
End Function
‘ 主程序
On Error Resume Next
‘ 创建HTML报告
CreateHTMLReport()
‘ 检查错误
If Err.Number <> 0 Then
MsgBox “发生错误: ” & Err.Description & ” (错误号: ” & Err.Number & “)”, vbCritical
End If
On Error GoTo 0
‘ 清理对象
Set fso = Nothing
Set shell = Nothing
Set wmi = Nothing
进阶技巧
错误处理
良好的错误处理是编写健壮脚本的关键。VBScript提供了
On Error
语句来控制错误处理。
‘ 基本错误处理示例
Sub DivideNumbers(a, b)
On Error Resume Next ‘ 启用错误处理
Dim result
result = a / b
If Err.Number <> 0 Then
MsgBox “错误: ” & Err.Description & ” (错误号: ” & Err.Number & “)”
Else
MsgBox “结果: ” & result
End If
On Error GoTo 0 ‘ 禁用错误处理
End Sub
DivideNumbers 10, 2 ‘ 正常情况
DivideNumbers 10, 0 ‘ 错误情况（除以零）
‘ 更复杂的错误处理
Sub ProcessFile(filePath)
On Error Resume Next
Dim fso, file, content
Set fso = CreateObject(“Scripting.FileSystemObject”)
‘ 检查文件是否存在
If Not fso.FileExists(filePath) Then
MsgBox “错误: 文件不存在 – ” & filePath
Exit Sub
End If
‘ 尝试打开文件
Set file = fso.OpenTextFile(filePath, 1) ‘ 1 = 只读模式
If Err.Number <> 0 Then
MsgBox “错误: 无法打开文件 – ” & Err.Description
Exit Sub
End If
‘ 读取文件内容
content = file.ReadAll
If Err.Number <> 0 Then
MsgBox “错误: 无法读取文件 – ” & Err.Description
file.Close
Exit Sub
End If
‘ 关闭文件
file.Close
‘ 处理内容（这里只是显示长度）
MsgBox “文件内容长度: ” & Len(content) & ” 字符”
On Error GoTo 0
End Sub
ProcessFile “C:\Temp\test.txt” ‘ 替换为实际存在的文件路径
ProcessFile “C:\Temp\nonexistent.txt” ‘ 不存在的文件
‘ 使用Err对象的Raise方法自定义错误
Sub ValidateAge(age)
If age < 0 Then
Err.Raise vbObjectError + 1, "ValidateAge", "年龄不能为负数"
ElseIf age > 150 Then
Err.Raise vbObjectError + 2, “ValidateAge”, “年龄不能超过150岁”
End If
MsgBox “年龄验证通过: ” & age
End Sub
Sub TestValidateAge()
On Error Resume Next
ValidateAge 25 ‘ 有效年龄
If Err.Number <> 0 Then
MsgBox “错误: ” & Err.Description
Err.Clear
End If
ValidateAge -5 ‘ 无效年龄
If Err.Number <> 0 Then
MsgBox “错误: ” & Err.Description
Err.Clear
End If
ValidateAge 200 ‘ 无效年龄
If Err.Number <> 0 Then
MsgBox “错误: ” & Err.Description
Err.Clear
End If
On Error GoTo 0
End Sub
TestValidateAge
类和对象
VBScript支持使用
Class
语句创建自定义对象，这对于组织代码和创建可重用组件非常有用。
‘ 定义一个简单的Person类
Class Person
‘ 私有字段
Private m_Name
Private m_Age
Private m_Gender
‘ 构造函数
Private Sub Class_Initialize()
m_Name = “”
m_Age = 0
m_Gender = “”
End Sub
‘ 析构函数
Private Sub Class_Terminate()
‘ 清理代码
End Sub
‘ 公共属性
Public Property Get Name
Name = m_Name
End Property
Public Property Let Name(value)
m_Name = value
End Property
Public Property Get Age
Age = m_Age
End Property
Public Property Let Age(value)
If value >= 0 And value <= 150 Then
m_Age = value
Else
Err.Raise vbObjectError + 1, "Person.Age", "年龄必须在0到150之间"
End If
End Property
Public Property Get Gender
Gender = m_Gender
End Property
Public Property Let Gender(value)
m_Gender = value
End Property
' 公共方法
Public Sub Introduce()
MsgBox "大家好，我叫" & m_Name & "，今年" & m_Age & "岁。"
End Sub
Public Function IsAdult()
IsAdult = (m_Age >= 18)
End Function
End Class
‘ 使用Person类
Dim person1, person2
Set person1 = New Person
‘ 设置属性
person1.Name = “张三”
person1.Age = 25
person1.Gender = “男”
‘ 调用方法
person1.Introduce()
If person1.IsAdult() Then
MsgBox person1.Name & “是成年人。”
Else
MsgBox person1.Name & “不是成年人。”
End If
‘ 创建另一个Person对象
Set person2 = New Person
person2.Name = “李四”
person2.Age = 16
person2.Gender = “女”
person2.Introduce()
If person2.IsAdult() Then
MsgBox person2.Name & “是成年人。”
Else
MsgBox person2.Name & “不是成年人。”
End If
‘ 定义一个更复杂的Employee类，继承自Person
Class Employee
‘ 私有字段
Private m_Person
Private m_Department
Private m_Salary
‘ 构造函数
Private Sub Class_Initialize()
Set m_Person = New Person
m_Department = “”
m_Salary = 0
End Sub
‘ 析构函数
Private Sub Class_Terminate()
Set m_Person = Nothing
End Sub
‘ 公共属性（委托给Person对象）
Public Property Get Name
Name = m_Person.Name
End Property
Public Property Let Name(value)
m_Person.Name = value
End Property
Public Property Get Age
Age = m_Person.Age
End Property
Public Property Let Age(value)
m_Person.Age = value
End Property
Public Property Get Gender
Gender = m_Person.Gender
End Property
Public Property Let Gender(value)
m_Person.Gender = value
End Property
‘ Employee特有属性
Public Property Get Department
Department = m_Department
End Property
Public Property Let Department(value)
m_Department = value
End Property
Public Property Get Salary
Salary = m_Salary
End Property
Public Property Let Salary(value)
If value >= 0 Then
m_Salary = value
Else
Err.Raise vbObjectError + 1, “Employee.Salary”, “薪水不能为负数”
End If
End Property
‘ 公共方法
Public Sub Introduce()
m_Person.Introduce()
MsgBox “我在” & m_Department & “部门工作，月薪为” & m_Salary & “元。”
End Sub
Public Function GetAnnualSalary()
GetAnnualSalary = m_Salary * 12
End Function
Public Sub RaiseSalary(percent)
If percent > 0 Then
m_Salary = m_Salary * (1 + percent / 100)
MsgBox “恭喜！您的薪水已提高” & percent & “%，新月薪为” & m_Salary & “元。”
Else
Err.Raise vbObjectError + 2, “Employee.RaiseSalary”, “提高百分比必须为正数”
End If
End Sub
End Class
‘ 使用Employee类
Dim employee
Set employee = New Employee
‘ 设置属性
employee.Name = “王五”
employee.Age = 30
employee.Gender = “男”
employee.Department = “技术部”
employee.Salary = 8000
‘ 调用方法
employee.Introduce()
MsgBox employee.Name & “的年薪为” & employee.GetAnnualSalary() & “元。”
‘ 提高薪水
employee.RaiseSalary(10)
MsgBox employee.Name & “提高后的年薪为” & employee.GetAnnualSalary() & “元。”
正则表达式
VBScript通过
VBScript.RegExp
对象支持正则表达式，这对于文本处理和模式匹配非常有用。
‘ 基本正则表达式匹配
Sub TestRegExp()
Dim regex, match, matches
Set regex = New RegExp
‘ 设置正则表达式模式
regex.Pattern = “\d+” ‘ 匹配一个或多个数字
‘ 设置是否区分大小写
regex.IgnoreCase = True
‘ 设置是否全局匹配
regex.Global = True
‘ 测试字符串
Dim testString
testString = “电话号码: 123-456-7890, 邮编: 100001”
‘ 执行匹配
Set matches = regex.Execute(testString)
‘ 显示匹配结果
Dim result
result = “在字符串 “”” & testString & “”” 中找到以下数字:” & vbCrLf
For Each match In matches
result = result & “找到: ” & match.Value & ” (位置: ” & match.FirstIndex & “, 长度: ” & match.Length & “)” & vbCrLf
Next
MsgBox result
End Sub
TestRegExp()
‘ 验证电子邮件地址
Function IsValidEmail(email)
Dim regex
Set regex = New RegExp
‘ 电子邮件正则表达式模式
regex.Pattern = “^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,}$”
‘ 执行测试
IsValidEmail = regex.Test(email)
End Function
‘ 测试电子邮件验证
Sub TestEmailValidation()
Dim emails, email, result
emails = Array(“user@example.com”, “user.name@example.co.uk”, “invalid-email”, “@example.com”, “user@.com”)
result = “电子邮件验证结果:” & vbCrLf
For Each email In emails
result = result & email & ” – ” & IIf(IsValidEmail(email), “有效”, “无效”) & vbCrLf
Next
MsgBox result
End Sub
‘ 辅助函数（VBScript没有内置的IIf函数）
Function IIf(condition, truePart, falsePart)
If condition Then
IIf = truePart
Else
IIf = falsePart
End If
End Function
TestEmailValidation()
‘ 替换文本
Sub ReplaceText()
Dim regex, inputText, outputText
Set regex = New RegExp
‘ 设置正则表达式模式
regex.Pattern = “\b(\d{1,2})/(\d{1,2})/(\d{4})\b” ‘ 匹配 MM/DD/YYYY 格式的日期
‘ 设置全局匹配
regex.Global = True
‘ 输入文本
inputText = “会议日期: 05/15/2023, 截止日期: 06/30/2023”
‘ 替换为 YYYY-MM-DD 格式
outputText = regex.Replace(inputText, “$3-$1-$2”)
MsgBox “原始文本: ” & inputText & vbCrLf & _
“替换后: ” & outputText
End Sub
ReplaceText()
‘ 提取HTML标签内容
Sub ExtractHTMLTags()
Dim regex, html, matches, match, result
Set regex = New RegExp
‘ 设置正则表达式模式
regex.Pattern = “<([^>]+)>([^<]*)” ‘ 匹配HTML标签及其内容
‘ 设置全局匹配
regex.Global = True
‘ HTML文本
html = “
标题
这是一个段落。
”
‘ 执行匹配
Set matches = regex.Execute(html)
‘ 显示匹配结果
result = “在HTML中找到以下标签:” & vbCrLf
For Each match In matches
result = result & “标签: ” & match.SubMatches(0) & “, 内容: ” & match.SubMatches(1) & vbCrLf
Next
MsgBox result
End Sub
ExtractHTMLTags()
‘ 分割字符串
Sub SplitString()
Dim regex, inputText, result
Set regex = New RegExp
‘ 设置正则表达式模式
regex.Pattern = “\s*,\s*” ‘ 匹配逗号及其前后的空白字符
‘ 设置全局匹配
regex.Global = True
‘ 输入文本
inputText = “苹果, 香蕉, 橙子, 葡萄”
‘ 分割字符串
result = Split(regex.Replace(inputText, “,”), “,”)
‘ 显示结果
Dim output, item
output = “分割结果:” & vbCrLf
For Each item In result
output = output & item & vbCrLf
Next
MsgBox output
End Sub
SplitString()
常见问题和解决方案
问题1：脚本运行时出现”权限被拒绝”错误
解决方案：
‘ 检查管理员权限并请求提升
Function IsAdmin()
On Error Resume Next
Dim shell
Set shell = CreateObject(“WScript.Shell”)
‘ 尝试执行需要管理员权限的操作
shell.RegRead “HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\”
IsAdmin = (Err.Number = 0)
On Error GoTo 0
End Function
Sub RunAsAdmin()
If Not IsAdmin() Then
Dim shell
Set shell = CreateObject(“WScript.Shell”)
‘ 重新以管理员权限运行脚本
shell.Run “wscript.exe //e:vbscript “”” & WScript.ScriptFullName & “”””, 0, False
‘ 退出当前脚本
WScript.Quit
End If
End Sub
‘ 在脚本开始处调用
RunAsAdmin()
‘ 现在可以执行需要管理员权限的操作
MsgBox “脚本正在以管理员权限运行”
问题2：处理包含特殊字符的文件路径
解决方案：
‘ 处理包含特殊字符的文件路径
Sub HandleSpecialCharsInPath()
Dim fso, filePath, file
Set fso = CreateObject(“Scripting.FileSystemObject”)
‘ 包含特殊字符的文件路径
filePath = “C:\Temp\Special [Chars] & File.txt”
‘ 检查文件是否存在
If fso.FileExists(filePath) Then
Set file = fso.GetFile(filePath)
MsgBox “文件存在: ” & file.Name & vbCrLf & “大小: ” & file.Size & ” 字节”
Else
‘ 创建文件
Set file = fso.CreateTextFile(filePath, True)
file.WriteLine “这是一个包含特殊字符的文件”
file.Close
MsgBox “已创建文件: ” & filePath
End If
End Sub
HandleSpecialCharsInPath()
问题3：脚本执行速度慢
解决方案：
‘ 优化脚本执行速度
Sub OptimizeScriptPerformance()
Dim startTime, endTime, fso, folder, file, fileCount
‘ 记录开始时间
startTime = Timer
‘ 创建对象（只创建一次）
Set fso = CreateObject(“Scripting.FileSystemObject”)
‘ 获取文件夹
Set folder = fso.GetFolder(“C:\Windows”)
‘ 预分配数组大小（如果可能）
fileCount = folder.Files.Count
ReDim fileNames(fileCount – 1)
‘ 使用For Each循环（比For循环更快）
Dim i
i = 0
For Each file In folder.Files
fileNames(i) = file.Name
i = i + 1
Next
‘ 减少与对象的交互
Dim output
output = “找到 ” & fileCount & ” 个文件:” & vbCrLf
‘ 使用字符串连接（比多次使用&更快）
For i = 0 To UBound(fileNames)
output = output & fileNames(i) & vbCrLf
Next
‘ 记录结束时间
endTime = Timer
‘ 显示结果和执行时间
MsgBox output & vbCrLf & “执行时间: ” & FormatNumber(endTime – startTime, 2) & ” 秒”
End Sub
OptimizeScriptPerformance()
问题4：处理大文件时的内存问题
解决方案：
‘ 处理大文件时避免内存问题
Sub ProcessLargeFile()
Dim fso, inputFile, outputFile, line, linesProcessed
Set fso = CreateObject(“Scripting.FileSystemObject”)
‘ 输入和输出文件路径
Dim inputPath, outputPath
inputPath = “C:\Temp\large_file.txt”
outputPath = “C:\Temp\processed_file.txt”
‘ 检查输入文件是否存在
If Not fso.FileExists(inputPath) Then
MsgBox “输入文件不存在: ” & inputPath
Exit Sub
End If
‘ 打开输入文件
Set inputFile = fso.OpenTextFile(inputPath, 1) ‘ 1 = 只读模式
‘ 创建输出文件
Set outputFile = fso.CreateTextFile(outputPath, True) ‘ True = 可覆盖
‘ 初始化计数器
linesProcessed = 0
‘ 逐行处理文件（避免一次性读取整个文件）
Do Until inputFile.AtEndOfStream
line = inputFile.ReadLine
‘ 处理行（这里只是简单地将行写入输出文件）
outputFile.WriteLine “Processed: ” & line
‘ 更新计数器
linesProcessed = linesProcessed + 1
‘ 每处理1000行显示一次进度
If linesProcessed Mod 1000 = 0 Then
WScript.Echo “已处理 ” & linesProcessed & ” 行…”
End If
Loop
‘ 关闭文件
inputFile.Close
outputFile.Close
‘ 显示完成消息
MsgBox “文件处理完成!” & vbCrLf & _
“输入文件: ” & inputPath & vbCrLf & _
“输出文件: ” & outputPath & vbCrLf & _
“处理行数: ” & linesProcessed
End Sub
ProcessLargeFile()
问题5：脚本在64位系统上的兼容性问题
解决方案：
‘ 处理64位系统上的兼容性问题
Function Is64BitOS()
On Error Resume Next
Dim shell
Set shell = CreateObject(“WScript.Shell”)
‘ 检查PROCESSOR_ARCHITECTURE环境变量
Dim procArch
procArch = shell.ExpandEnvironmentStrings(“%PROCESSOR_ARCHITECTURE%”)
If InStr(1, procArch, “64”, vbTextCompare) > 0 Then
Is64BitOS = True
Else
‘ 检查PROCESSOR_ARCHITEW6432环境变量
Dim procArchW64
procArchW64 = shell.ExpandEnvironmentStrings(“%PROCESSOR_ARCHITEW6432%”)
If InStr(1, procArchW64, “64”, vbTextCompare) > 0 Then
Is64BitOS = True
Else
Is64BitOS = False
End If
End If
On Error GoTo 0
End Function
Sub Run32BitScriptOn64BitOS()
If Is64BitOS() Then
‘ 检查当前是否在32位脚本宿主中运行
Dim shell
Set shell = CreateObject(“WScript.Shell”)
Dim sysWow64
sysWow64 = shell.ExpandEnvironmentStrings(“%SystemRoot%”) & “\SysWOW64”
If Not fso.FolderExists(sysWow64) Then
‘ 32位子系统不存在，无法运行32位脚本
MsgBox “无法在64位系统上运行32位脚本”
Exit Sub
End If
‘ 重新在32位脚本宿主中运行脚本
Dim scriptPath
scriptPath = WScript.ScriptFullName
Dim command
command = “%SystemRoot%\SysWOW64\wscript.exe “”” & scriptPath & “”””
shell.Run command, 0, False
‘ 退出当前脚本
WScript.Quit
Else
‘ 在32位系统上直接运行
MsgBox “正在32位系统上运行脚本”
End If
End Sub
‘ 在脚本开始处调用
Run32BitScriptOn64BitOS()
结论
VBScript是一种强大而灵活的脚本语言，特别适合在Windows环境中实现自动化任务。通过本文的学习，您已经掌握了VBScript的基础知识、高级技巧以及实际应用案例。从简单的变量操作到复杂的系统管理，VBScript都能胜任。
要真正掌握VBScript，关键在于实践。尝试将日常工作中重复性的任务自动化，您将发现VBScript的强大之处。随着经验的积累，您将能够编写更复杂、更高效的脚本，进一步提高工作效率。
记住，学习编程是一个持续的过程。不断探索、实践和学习，您将成为一名出色的VBScript开发者，能够利用这一强大工具解决各种实际问题。