轻松掌握VBScript应用从零开始学习这一强大脚本语言助您在日常工作中实现自动化提高工作效率解决实际问题

威震华夏关云长

引言：什么是VBScript及其重要性

VBScript（Visual Basic Scripting Edition）是一种由微软开发的轻量级脚本语言，它是Visual Basic家族的成员。作为一种解释型脚本语言，VBScript不需要编译即可运行，特别适合用于自动化任务、系统管理和网页开发。在Windows环境中，VBScript可以访问操作系统的许多功能，使其成为自动化日常任务的理想选择。

VBScript的重要性体现在以下几个方面：

• 易于学习：语法简单，对于有编程基础的人来说很容易上手
• 广泛兼容：在Windows系统中内置支持，无需额外安装
• 功能强大：可以访问文件系统、注册表、网络等系统资源
• 自动化能力：能够自动执行重复性任务，提高工作效率

VBScript基础语法

第一个VBScript程序

让我们从经典的”Hello, World!“程序开始：

2. ' 这是一个简单的VBScript程序
3. MsgBox "Hello, World!"

复制代码

将以上代码保存为.vbs文件（例如hello.vbs），然后双击运行，您将看到一个弹出窗口显示”Hello, World!“。

基本语法规则

VBScript的语法规则相对简单：

1. 注释：使用单引号(')来添加注释
2. 大小写不敏感：VBScript不区分大小写
3. 语句分隔：每行通常一个语句，多个语句可用冒号(:)分隔
4. 续行：使用下划线(_)将长语句分成多行

2. ' 注释示例
3. ' 下面的代码演示了语句分隔和续行
4. MsgBox "第一条语句" : MsgBox "第二条语句"
5. MsgBox "这是一个很长的消息，" & _
6.        "所以使用了续行符将其分成两行"

复制代码

变量和数据类型

变量声明与使用

在VBScript中，可以使用Dim、Private或Public语句声明变量。虽然VBScript允许不声明变量直接使用，但良好的编程习惯是先声明后使用。

2. ' 声明变量
3. Dim userName
4. Dim age, email  ' 可以一次声明多个变量
6. ' 赋值
7. userName = "张三"
8. age = 30
9. email = "zhangsan@example.com"
11. ' 使用变量
12. MsgBox "用户名: " & userName & vbCrLf & _
13.        "年龄: " & age & vbCrLf & _
14.        "邮箱: " & 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：错误号

2. ' 不同数据类型的示例
3. Dim varEmpty, varNull, varBoolean, varInteger
4. Dim varLong, varDouble, varDate, varString
6. ' Empty类型（未初始化）
7. MsgBox "varEmpty的类型是: " & TypeName(varEmpty)
9. ' Null类型
10. varNull = Null
11. MsgBox "varNull的类型是: " & TypeName(varNull)
13. ' Boolean类型
14. varBoolean = True
15. MsgBox "varBoolean的类型是: " & TypeName(varBoolean) & "，值是: " & varBoolean
17. ' Integer类型
18. varInteger = 100
19. MsgBox "varInteger的类型是: " & TypeName(varInteger) & "，值是: " & varInteger
21. ' Long类型
22. varLong = 100000
23. MsgBox "varLong的类型是: " & TypeName(varLong) & "，值是: " & varLong
25. ' Double类型
26. varDouble = 3.1415926535
27. MsgBox "varDouble的类型是: " & TypeName(varDouble) & "，值是: " & varDouble
29. ' Date类型
30. varDate = Now()
31. MsgBox "varDate的类型是: " & TypeName(varDate) & "，值是: " & varDate
33. ' String类型
34. varString = "这是一个字符串"
35. MsgBox "varString的类型是: " & TypeName(varString) & "，值是: " & varString

复制代码

变量作用域

VBScript中的变量有不同的作用域：

• 脚本级变量：在所有过程外声明，整个脚本都可以访问
• 过程级变量：在过程内声明，只在该过程内有效

2. ' 脚本级变量
3. Dim scriptLevelVar
4. scriptLevelVar = "我是脚本级变量"
6. ' 子程序
7. Sub ShowVariables()
8.     ' 过程级变量
9.     Dim procedureLevelVar
10.     procedureLevelVar = "我是过程级变量"
11.    
12.     MsgBox "在子程序中:" & vbCrLf & _
13.            "scriptLevelVar = " & scriptLevelVar & vbCrLf & _
14.            "procedureLevelVar = " & procedureLevelVar
15. End Sub
17. ' 调用子程序
18. Call ShowVariables()
20. ' 尝试访问过程级变量（会出错）
21. On Error Resume Next
22. MsgBox "在脚本级别:" & vbCrLf & _
23.        "scriptLevelVar = " & scriptLevelVar & vbCrLf & _
24.        "procedureLevelVar = " & procedureLevelVar
25. If Err.Number <> 0 Then
26.     MsgBox "错误: " & Err.Description
27. End If
28. On Error GoTo 0

复制代码

控制结构

条件语句

VBScript提供了多种条件语句，包括If...Then...Else和Select Case。

2. ' 简单If语句
3. Dim score
4. score = 85
6. If score >= 60 Then
7.     MsgBox "恭喜！您通过了考试。"
8. End If
10. ' If...Else语句
11. If score >= 60 Then
12.     MsgBox "恭喜！您通过了考试。"
13. Else
14.     MsgBox "很遗憾，您没有通过考试。"
15. End If
17. ' If...ElseIf...Else语句
18. If score >= 90 Then
19.     MsgBox "优秀！"
20. ElseIf score >= 80 Then
21.     MsgBox "良好！"
22. ElseIf score >= 70 Then
23.     MsgBox "中等！"
24. ElseIf score >= 60 Then
25.     MsgBox "及格！"
26. Else
27.     MsgBox "不及格！"
28. End If

复制代码

当需要根据一个表达式的多个可能值执行不同操作时，Select Case语句比多个ElseIf更清晰。

2. ' Select Case示例
3. Dim dayOfWeek
4. dayOfWeek = Weekday(Now())
6. Select Case dayOfWeek
7.     Case 1
8.         MsgBox "今天是星期日"
9.     Case 2
10.         MsgBox "今天是星期一"
11.     Case 3
12.         MsgBox "今天是星期二"
13.     Case 4
14.         MsgBox "今天是星期三"
15.     Case 5
16.         MsgBox "今天是星期四"
17.     Case 6
18.         MsgBox "今天是星期五"
19.     Case 7
20.         MsgBox "今天是星期六"
21.     Case Else
22.         MsgBox "无效的日期"
23. End Select
25. ' 使用比较运算符的Select Case
26. Dim temperature
27. temperature = 25
29. Select Case True
30.     Case temperature < 0
31.         MsgBox "严寒"
32.     Case temperature < 10
33.         MsgBox "寒冷"
34.     Case temperature < 20
35.         MsgBox "凉爽"
36.     Case temperature < 30
37.         MsgBox "温暖"
38.     Case Else
39.         MsgBox "炎热"
40. End Select

复制代码

循环语句

VBScript提供了多种循环结构，包括Do...Loop、While...Wend、For...Next和For Each...Next。

2. ' Do While...Loop（先判断后执行）
3. Dim counter
4. counter = 1
6. Do While counter <= 5
7.     MsgBox "计数器值: " & counter
8.     counter = counter + 1
9. Loop
11. ' Do...Loop While（先执行后判断）
12. counter = 1
14. Do
15.     MsgBox "计数器值: " & counter
16.     counter = counter + 1
17. Loop While counter <= 5
19. ' Do Until...Loop（直到条件为真时停止）
20. counter = 1
22. Do Until counter > 5
23.     MsgBox "计数器值: " & counter
24.     counter = counter + 1
25. Loop
27. ' Do...Loop Until（先执行后判断）
28. counter = 1
30. Do
31.     MsgBox "计数器值: " & counter
32.     counter = counter + 1
33. Loop Until counter > 5

复制代码

2. ' While...Wend循环
3. counter = 1
5. While counter <= 5
6.     MsgBox "计数器值: " & counter
7.     counter = counter + 1
8. Wend

复制代码

2. ' 基本的For...Next循环
3. Dim i
5. For i = 1 To 5
6.     MsgBox "循环计数: " & i
7. Next
9. ' 带步长的For...Next循环
10. For i = 1 To 10 Step 2
11.     MsgBox "循环计数: " & i
12. Next
14. ' 递减的For...Next循环
15. For i = 10 To 1 Step -1
16.     MsgBox "倒计时: " & i
17. Next
19. ' 嵌套的For...Next循环
20. Dim j
22. For i = 1 To 3
23.     For j = 1 To 3
24.         MsgBox "i = " & i & ", j = " & j
25.     Next
26. Next

复制代码

2. ' For Each...Next循环用于遍历集合或数组
3. Dim drives, drive
4. Set drives = CreateObject("Scripting.FileSystemObject").Drives
6. For Each drive In drives
7.     MsgBox "驱动器 " & drive.DriveLetter & ": " & _
8.            "可用空间: " & FormatNumber(drive.AvailableSpace / 1024 / 1024, 2) & " MB"
9. Next

复制代码

函数和子程序

子程序（Sub）

子程序是执行特定任务但不返回值的代码块。

2. ' 定义子程序
3. Sub ShowWelcomeMessage(name)
4.     MsgBox "欢迎, " & name & "!"
5. End Sub
7. ' 调用子程序
8. Call ShowWelcomeMessage("张三")
9. ' 或者不使用Call关键字
10. ShowWelcomeMessage("李四")
12. ' 带参数的子程序
13. Sub CalculateSum(a, b)
14.     MsgBox a & " + " & b & " = " & (a + b)
15. End Sub
17. CalculateSum 10, 20
19. ' 带可选参数的子程序
20. Sub Greet(name, Optional greeting = "你好")
21.     MsgBox greeting & ", " & name & "!"
22. End Sub
24. Greet "王五"
25. Greet "赵六", "早上好"

复制代码

函数（Function）

函数是执行特定任务并返回值的代码块。

2. ' 定义函数
3. Function GetFullName(firstName, lastName)
4.     GetFullName = firstName & " " & lastName
5. End Function
7. ' 使用函数
8. Dim fullName
9. fullName = GetFullName("张", "三")
10. MsgBox "全名: " & fullName
12. ' 带参数验证的函数
13. Function Divide(a, b)
14.     If b = 0 Then
15.         Divide = "错误：除数不能为零"
16.     Else
17.         Divide = a / b
18.     End If
19. End Function
21. MsgBox "10 / 2 = " & Divide(10, 2)
22. MsgBox "10 / 0 = " & Divide(10, 0)
24. ' 递归函数示例
25. Function Factorial(n)
26.     If n = 0 Or n = 1 Then
27.         Factorial = 1
28.     Else
29.         Factorial = n * Factorial(n - 1)
30.     End If
31. End Function
33. MsgBox "5的阶乘是: " & Factorial(5)

复制代码

内置函数

VBScript提供了许多内置函数，用于处理字符串、日期、数学运算等。

2. Dim str
3. str = "Hello, World!"
5. ' 字符串长度
6. MsgBox "字符串长度: " & Len(str)
8. ' 转换为大写和小写
9. MsgBox "大写: " & UCase(str)
10. MsgBox "小写: " & LCase(str)
12. ' 去除空格
13. Dim strWithSpaces
14. strWithSpaces = "  前后有空格  "
15. MsgBox "原字符串: '" & strWithSpaces & "'"
16. MsgBox "去除空格: '" & Trim(strWithSpaces) & "'"
18. ' 字符串截取
19. MsgBox "前5个字符: " & Left(str, 5)
20. MsgBox "后6个字符: " & Right(str, 6)
21. MsgBox "从第8个位置开始的5个字符: " & Mid(str, 8, 5)
23. ' 字符串替换
24. MsgBox "替换前: " & str
25. MsgBox "替换后: " & Replace(str, "World", "VBScript")
27. ' 字符串分割
28. Dim parts, i
29. parts = Split("apple,banana,orange", ",")
30. For i = 0 To UBound(parts)
31.     MsgBox "部分 " & i & ": " & parts(i)
32. Next
34. ' 字符串连接
35. Dim fruits
36. fruits = Join(parts, " | ")
37. MsgBox "连接后的字符串: " & fruits

复制代码

2. ' 获取当前日期和时间
3. MsgBox "当前日期: " & Date()
4. MsgBox "当前时间: " & Time()
5. MsgBox "当前日期和时间: " & Now()
7. ' 日期部分
8. MsgBox "年: " & Year(Now())
9. MsgBox "月: " & Month(Now())
10. MsgBox "日: " & Day(Now())
11. MsgBox "星期几: " & Weekday(Now())
12. MsgBox "小时: " & Hour(Now())
13. MsgBox "分钟: " & Minute(Now())
14. MsgBox "秒: " & Second(Now())
16. ' 日期计算
17. MsgBox "明天: " & DateAdd("d", 1, Date())
18. MsgBox "下个月: " & DateAdd("m", 1, Date())
19. MsgBox "明年: " & DateAdd("yyyy", 1, Date())
21. ' 日期差值
22. Dim startDate, endDate
23. startDate = #1/1/2023#
24. endDate = #12/31/2023#
25. MsgBox "两个日期之间的天数: " & DateDiff("d", startDate, endDate)
27. ' 格式化日期
28. MsgBox "格式化日期: " & FormatDateTime(Now(), vbLongDate)
29. MsgBox "格式化时间: " & FormatDateTime(Now(), vbLongTime)

复制代码

2. ' 基本数学运算
3. MsgBox "绝对值: " & Abs(-10.5)
4. MsgBox "平方根: " & Sqr(16)
5. MsgBox "指数: " & Exp(1)
6. MsgBox "对数: " & Log(10)
7. MsgBox "正弦: " & Sin(3.1415926535 / 2)
8. MsgBox "余弦: " & Cos(0)
9. MsgBox "正切: " & Tan(3.1415926535 / 4)
11. ' 随机数
12. Randomize  ' 初始化随机数生成器
13. MsgBox "随机数: " & Rnd()  ' 0到1之间的随机数
14. MsgBox "1到100之间的随机整数: " & Int(Rnd() * 100) + 1
16. ' 数值格式化
17. MsgBox "格式化数字: " & FormatNumber(1234.5678, 2)
18. MsgBox "格式化货币: " & FormatCurrency(1234.5678, 2)
19. MsgBox "格式化百分比: " & FormatPercent(0.1234, 2)

复制代码

文件操作

VBScript可以通过Scripting.FileSystemObject对象进行文件系统操作，包括创建、读取、写入和删除文件及文件夹。

文件系统对象基础

2. ' 创建文件系统对象
3. Dim fso
4. Set fso = CreateObject("Scripting.FileSystemObject")
6. ' 检查文件是否存在
7. Dim filePath
8. filePath = "C:\Temp\test.txt"
10. If fso.FileExists(filePath) Then
11.     MsgBox "文件存在: " & filePath
12. Else
13.     MsgBox "文件不存在: " & filePath
14. End If
16. ' 检查文件夹是否存在
17. Dim folderPath
18. folderPath = "C:\Temp"
20. If fso.FolderExists(folderPath) Then
21.     MsgBox "文件夹存在: " & folderPath
22. Else
23.     MsgBox "文件夹不存在: " & folderPath
24. End If
26. ' 获取文件信息
27. If fso.FileExists(filePath) Then
28.     Dim file
29.     Set file = fso.GetFile(filePath)
30.    
31.     MsgBox "文件信息:" & vbCrLf & _
32.            "路径: " & file.Path & vbCrLf & _
33.            "大小: " & file.Size & " 字节" & vbCrLf & _
34.            "创建时间: " & file.DateCreated & vbCrLf & _
35.            "最后修改时间: " & file.DateLastModified & vbCrLf & _
36.            "最后访问时间: " & file.DateLastAccessed
37. End If
39. ' 获取文件夹信息
40. If fso.FolderExists(folderPath) Then
41.     Dim folder
42.     Set folder = fso.GetFolder(folderPath)
43.    
44.     MsgBox "文件夹信息:" & vbCrLf & _
45.            "路径: " & folder.Path & vbCrLf & _
46.            "大小: " & folder.Size & " 字节" & vbCrLf & _
47.            "文件数: " & folder.Files.Count & vbCrLf & _
48.            "子文件夹数: " & folder.SubFolders.Count
49. End If

复制代码

创建和写入文件

2. ' 创建文件系统对象
3. Dim fso
4. Set fso = CreateObject("Scripting.FileSystemObject")
6. ' 创建文本文件并写入内容
7. Dim filePath, file
8. filePath = "C:\Temp\test.txt"
10. ' 检查文件夹是否存在，不存在则创建
11. Dim folderPath
12. folderPath = "C:\Temp"
13. If Not fso.FolderExists(folderPath) Then
14.     fso.CreateFolder(folderPath)
15.     MsgBox "已创建文件夹: " & folderPath
16. End If
18. ' 创建文件并写入内容
19. Set file = fso.CreateTextFile(filePath, True)  ' True表示可以覆盖已存在的文件
20. file.WriteLine "这是第一行"
21. file.WriteLine "这是第二行"
22. file.Write "这是第三行，没有换行"
23. file.Close
24. MsgBox "已创建文件并写入内容: " & filePath
26. ' 追加内容到文件
27. If fso.FileExists(filePath) Then
28.     Set file = fso.OpenTextFile(filePath, 8)  ' 8表示追加模式
29.     file.WriteLine vbCrLf & "这是追加的第四行"
30.     file.Close
31.     MsgBox "已追加内容到文件: " & filePath
32. End If

复制代码

读取文件

2. ' 创建文件系统对象
3. Dim fso
4. Set fso = CreateObject("Scripting.FileSystemObject")
6. ' 读取整个文件
7. Dim filePath, file, content
8. filePath = "C:\Temp\test.txt"
10. If fso.FileExists(filePath) Then
11.     Set file = fso.OpenTextFile(filePath, 1)  ' 1表示只读模式
12.     content = file.ReadAll
13.     file.Close
14.    
15.     MsgBox "文件内容:" & vbCrLf & content
16. End If
18. ' 逐行读取文件
19. If fso.FileExists(filePath) Then
20.     Set file = fso.OpenTextFile(filePath, 1)
21.     Dim lines, line
22.     lines = ""
23.    
24.     Do Until file.AtEndOfStream
25.         line = file.ReadLine
26.         lines = lines & line & vbCrLf
27.     Loop
28.    
29.     file.Close
30.     MsgBox "逐行读取的文件内容:" & vbCrLf & lines
31. End If
33. ' 读取指定数量的字符
34. If fso.FileExists(filePath) Then
35.     Set file = fso.OpenTextFile(filePath, 1)
36.     Dim chars
37.     chars = file.Read(10)  ' 读取前10个字符
38.     file.Close
39.    
40.     MsgBox "前10个字符: " & chars
41. End If

复制代码

文件和文件夹操作

2. ' 创建文件系统对象
3. Dim fso
4. Set fso = CreateObject("Scripting.FileSystemObject")
6. ' 创建文件夹
7. Dim newFolderPath
8. newFolderPath = "C:\Temp\NewFolder"
10. If Not fso.FolderExists(newFolderPath) Then
11.     fso.CreateFolder(newFolderPath)
12.     MsgBox "已创建文件夹: " & newFolderPath
13. Else
14.     MsgBox "文件夹已存在: " & newFolderPath
15. End If
17. ' 复制文件
18. Dim sourceFile, destFile
19. sourceFile = "C:\Temp\test.txt"
20. destFile = "C:\Temp\NewFolder\test_copy.txt"
22. If fso.FileExists(sourceFile) Then
23.     fso.CopyFile sourceFile, destFile, True  ' True表示可以覆盖已存在的文件
24.     MsgBox "已复制文件: " & sourceFile & " -> " & destFile
25. End If
27. ' 移动文件
28. If fso.FileExists(destFile) Then
29.     Dim movedFile
30.     movedFile = "C:\Temp\NewFolder\test_moved.txt"
31.    
32.     fso.MoveFile destFile, movedFile
33.     MsgBox "已移动文件: " & destFile & " -> " & movedFile
34. End If
36. ' 删除文件
37. If fso.FileExists(movedFile) Then
38.     fso.DeleteFile movedFile
39.     MsgBox "已删除文件: " & movedFile
40. End If
42. ' 复制文件夹
43. Dim sourceFolder, destFolder
44. sourceFolder = "C:\Temp\NewFolder"
45. destFolder = "C:\Temp\NewFolderCopy"
47. If fso.FolderExists(sourceFolder) Then
48.     fso.CopyFolder sourceFolder, destFolder, True
49.     MsgBox "已复制文件夹: " & sourceFolder & " -> " & destFolder
50. End If
52. ' 删除文件夹
53. If fso.FolderExists(destFolder) Then
54.     fso.DeleteFolder destFolder
55.     MsgBox "已删除文件夹: " & destFolder
56. End If
58. If fso.FolderExists(newFolderPath) Then
59.     fso.DeleteFolder newFolderPath
60.     MsgBox "已删除文件夹: " & newFolderPath
61. End If

复制代码

与系统交互

VBScript可以通过Windows Script Host (WSH)对象与操作系统交互，执行系统级任务。

WScript和CScript对象

2. ' 检查脚本宿主
3. If IsObject(WScript) Then
4.     MsgBox "当前运行在WScript.exe环境中（Windows GUI）"
5. Else
6.     MsgBox "当前运行在CScript.exe环境中（命令行）"
7. End If
9. ' 使用WScript对象
10. If IsObject(WScript) Then
11.     ' 获取脚本名称和路径
12.     MsgBox "脚本名称: " & WScript.ScriptName
13.     MsgBox "脚本完整路径: " & WScript.ScriptFullName
14.    
15.     ' 获取参数
16.     If WScript.Arguments.Count > 0 Then
17.         Dim args, i
18.         args = ""
19.         For i = 0 To WScript.Arguments.Count - 1
20.             args = args & "参数 " & i & ": " & WScript.Arguments(i) & vbCrLf
21.         Next
22.         MsgBox "脚本参数:" & vbCrLf & args
23.     Else
24.         MsgBox "没有传递任何参数给脚本"
25.     End If
26.    
27.     ' 创建快捷方式
28.     Dim shell, shortcut, desktopPath
29.     Set shell = CreateObject("WScript.Shell")
30.     desktopPath = shell.SpecialFolders("Desktop")
31.     Set shortcut = shell.CreateShortcut(desktopPath & "\记事本.lnk")
32.    
33.     shortcut.TargetPath = "%windir%\notepad.exe"
34.     shortcut.Description = "打开记事本"
35.     shortcut.Save
36.    
37.     MsgBox "已在桌面创建记事本快捷方式"
38. End If

复制代码

运行外部程序

2. ' 创建WScript.Shell对象
3. Dim shell
4. Set shell = CreateObject("WScript.Shell")
6. ' 运行程序并等待完成
7. Dim command, returnCode
8. command = "%windir%\notepad.exe"
9. returnCode = shell.Run(command, 1, True)  ' 1表示激活窗口，True表示等待完成
11. MsgBox "记事本已关闭，返回代码: " & returnCode
13. ' 运行程序不等待
14. command = "%windir%\system32\calc.exe"
15. shell.Run command, 1, False  ' False表示不等待
16. MsgBox "计算器已启动（脚本继续执行）"
18. ' 使用Exec方法运行命令并获取输出
19. Dim exec, output
20. command = "cmd /c dir C:"
21. Set exec = shell.Exec(command)
23. ' 读取输出
24. output = ""
25. Do While exec.Status = 0
26.     output = output & exec.StdOut.ReadAll()
27.     WScript.Sleep 100
28. Loop
30. ' 显示输出（截取前1000个字符以避免消息框过大）
31. If Len(output) > 1000 Then
32.     MsgBox "命令输出（前1000字符）:" & vbCrLf & Left(output, 1000) & "..."
33. Else
34.     MsgBox "命令输出:" & vbCrLf & output
35. End If

复制代码

注册表操作

2. ' 创建WScript.Shell对象
3. Dim shell
4. Set shell = CreateObject("WScript.Shell")
6. ' 读取注册表值
7. On Error Resume Next
8. Dim ieVersion
9. ieVersion = shell.RegRead("HKLM\SOFTWARE\Microsoft\Internet Explorer\Version")
11. If Err.Number = 0 Then
12.     MsgBox "Internet Explorer版本: " & ieVersion
13. Else
14.     MsgBox "无法读取Internet Explorer版本: " & Err.Description
15. End If
16. On Error GoTo 0
18. ' 写入注册表值
19. Dim regPath, regValue, regType
20. regPath = "HKCU\Software\VBScriptTest"
21. regValue = "TestValue"
22. regType = "REG_SZ"  ' 字符串类型
24. ' 创建注册表项
25. On Error Resume Next
26. shell.RegWrite regPath & "", "", "REG_SZ"
27. If Err.Number = 0 Then
28.     MsgBox "已创建注册表项: " & regPath
29. Else
30.     MsgBox "创建注册表项失败: " & Err.Description
31. End If
32. On Error GoTo 0
34. ' 写入注册表值
35. On Error Resume Next
36. shell.RegWrite regPath & "" & regValue, "这是一个测试值", regType
37. If Err.Number = 0 Then
38.     MsgBox "已写入注册表值: " & regPath & "" & regValue
39. Else
40.     MsgBox "写入注册表值失败: " & Err.Description
41. End If
42. On Error GoTo 0
44. ' 读取刚写入的值
45. On Error Resume Next
46. Dim readValue
47. readValue = shell.RegRead(regPath & "" & regValue)
48. If Err.Number = 0 Then
49.     MsgBox "读取的注册表值: " & readValue
50. Else
51.     MsgBox "读取注册表值失败: " & Err.Description
52. End If
53. On Error GoTo 0
55. ' 删除注册表值
56. On Error Resume Next
57. shell.RegDelete regPath & "" & regValue
58. If Err.Number = 0 Then
59.     MsgBox "已删除注册表值: " & regPath & "" & regValue
60. Else
61.     MsgBox "删除注册表值失败: " & Err.Description
62. End If
63. On Error GoTo 0
65. ' 删除注册表项
66. On Error Resume Next
67. shell.RegDelete regPath & ""
68. If Err.Number = 0 Then
69.     MsgBox "已删除注册表项: " & regPath
70. Else
71.     MsgBox "删除注册表项失败: " & Err.Description
72. End If
73. On Error GoTo 0

复制代码

系统信息获取

2. ' 获取操作系统信息
3. Dim shell, osInfo
4. Set shell = CreateObject("WScript.Shell")
6. osInfo = "操作系统信息:" & vbCrLf & _
7.          "计算机名: " & shell.ExpandEnvironmentStrings("%COMPUTERNAME%") & vbCrLf & _
8.          "用户名: " & shell.ExpandEnvironmentStrings("%USERNAME%") & vbCrLf & _
9.          "系统目录: " & shell.ExpandEnvironmentStrings("%WINDIR%") & vbCrLf & _
10.          "临时目录: " & shell.ExpandEnvironmentStrings("%TEMP%") & vbCrLf & _
11.          "程序文件目录: " & shell.ExpandEnvironmentStrings("%ProgramFiles%")
13. MsgBox osInfo
15. ' 使用WMI获取更详细的系统信息
16. Dim wmi, items, item
17. Set wmi = GetObject("winmgmts:\\.\root\cimv2")
19. ' 获取操作系统信息
20. Set items = wmi.ExecQuery("Select * from Win32_OperatingSystem")
22. For Each item In items
23.     osInfo = "详细操作系统信息:" & vbCrLf & _
24.              "名称: " & item.Caption & vbCrLf & _
25.              "版本: " & item.Version & vbCrLf & _
26.              "制造商: " & item.Manufacturer & vbCrLf & _
27.              "安装日期: " & item.InstallDate & vbCrLf & _
28.              "上次启动时间: " & item.LastBootUpTime & vbCrLf & _
29.              "本地日期时间: " & item.LocalDateTime & vbCrLf & _
30.              "序列号: " & item.SerialNumber & vbCrLf & _
31.              "注册用户: " & item.RegisteredUser & vbCrLf & _
32.              "组织: " & item.Organization
33.    
34.     MsgBox osInfo
35.     Exit For
36. Next
38. ' 获取计算机系统信息
39. Set items = wmi.ExecQuery("Select * from Win32_ComputerSystem")
41. For Each item In items
42.     Dim sysInfo
43.     sysInfo = "计算机系统信息:" & vbCrLf & _
44.               "名称: " & item.Name & vbCrLf & _
45.               "制造商: " & item.Manufacturer & vbCrLf & _
46.               "型号: " & item.Model & vbCrLf & _
47.               "系统类型: " & item.SystemType & vbCrLf & _
48.               "处理器数量: " & item.NumberOfProcessors & vbCrLf & _
49.               "总物理内存: " & Round(item.TotalPhysicalMemory / 1024 / 1024, 2) & " MB"
50.    
51.     MsgBox sysInfo
52.     Exit For
53. Next
55. ' 获取处理器信息
56. Set items = wmi.ExecQuery("Select * from Win32_Processor")
58. For Each item In items
59.     Dim cpuInfo
60.     cpuInfo = "处理器信息:" & vbCrLf & _
61.               "名称: " & item.Name & vbCrLf & _
62.               "制造商: " & item.Manufacturer & vbCrLf & _
63.               "最大时钟速度: " & item.MaxClockSpeed & " MHz" & vbCrLf & _
64.               "当前时钟速度: " & item.CurrentClockSpeed & " MHz" & vbCrLf & _
65.               "核心数: " & item.NumberOfCores & vbCrLf & _
66.               "逻辑处理器数: " & item.NumberOfLogicalProcessors
67.    
68.     MsgBox cpuInfo
69.     Exit For
70. Next

复制代码

实际应用案例

自动备份文件

2. ' 自动备份文件脚本
3. Option Explicit
5. ' 配置部分
6. Dim sourceFolder, backupFolder, logFile
7. sourceFolder = "C:\ImportantFiles"  ' 要备份的源文件夹
8. backupFolder = "D:\Backups"         ' 备份目标文件夹
9. logFile = "D:\Backups\backup_log.txt"  ' 日志文件
11. ' 创建文件系统对象
12. Dim fso
13. Set fso = CreateObject("Scripting.FileSystemObject")
15. ' 创建日志函数
16. Sub LogMessage(message)
17.     Dim logStream
18.     Set logStream = fso.OpenTextFile(logFile, 8, True)  ' 8 = 追加模式
19.     logStream.WriteLine Now() & " - " & message
20.     logStream.Close
21. End Sub
23. ' 主程序
24. On Error Resume Next
26. ' 检查源文件夹是否存在
27. If Not fso.FolderExists(sourceFolder) Then
28.     LogMessage "错误: 源文件夹不存在 - " & sourceFolder
29.     MsgBox "错误: 源文件夹不存在 - " & sourceFolder, vbCritical
30.     WScript.Quit(1)
31. End If
33. ' 创建备份文件夹（如果不存在）
34. If Not fso.FolderExists(backupFolder) Then
35.     fso.CreateFolder backupFolder
36.     LogMessage "创建备份文件夹 - " & backupFolder
37. End If
39. ' 创建带日期的子文件夹
40. Dim dateFolder
41. dateFolder = backupFolder & "\Backup_" & Year(Now()) & Right("0" & Month(Now()), 2) & Right("0" & Day(Now()), 2)
43. If Not fso.FolderExists(dateFolder) Then
44.     fso.CreateFolder dateFolder
45.     LogMessage "创建日期备份文件夹 - " & dateFolder
46. End If
48. ' 复制文件
49. Dim sourceFolderObj, file, filesCopied, filesSkipped
50. Set sourceFolderObj = fso.GetFolder(sourceFolder)
51. filesCopied = 0
52. filesSkipped = 0
54. For Each file In sourceFolderObj.Files
55.     Dim destFile
56.     destFile = dateFolder & "" & file.Name
57.    
58.     ' 检查文件是否已存在
59.     If fso.FileExists(destFile) Then
60.         ' 比较文件修改时间
61.         Dim destFileObj
62.         Set destFileObj = fso.GetFile(destFile)
63.         
64.         If file.DateLastModified > destFileObj.DateLastModified Then
65.             ' 源文件更新，覆盖目标文件
66.             fso.CopyFile file.Path, destFile, True
67.             LogMessage "更新文件 - " & file.Name
68.             filesCopied = filesCopied + 1
69.         Else
70.             ' 目标文件更新或相同，跳过
71.             LogMessage "跳过文件（未更改） - " & file.Name
72.             filesSkipped = filesSkipped + 1
73.         End If
74.     Else
75.         ' 文件不存在，复制
76.         fso.CopyFile file.Path, destFile
77.         LogMessage "复制新文件 - " & file.Name
78.         filesCopied = filesCopied + 1
79.     End If
80. Next
82. ' 递归复制子文件夹
83. Sub CopySubFolders(sourceFolder, destFolder)
84.     Dim subFolder, subDestFolder
85.    
86.     For Each subFolder In sourceFolder.SubFolders
87.         subDestFolder = destFolder & "" & subFolder.Name
88.         
89.         ' 创建目标子文件夹
90.         If Not fso.FolderExists(subDestFolder) Then
91.             fso.CreateFolder subDestFolder
92.             LogMessage "创建子文件夹 - " & subDestFolder
93.         End If
94.         
95.         ' 复制子文件夹中的文件
96.         Dim file
97.         For Each file In subFolder.Files
98.             Dim destFile
99.             destFile = subDestFolder & "" & file.Name
100.             
101.             ' 检查文件是否已存在
102.             If fso.FileExists(destFile) Then
103.                 ' 比较文件修改时间
104.                 Dim destFileObj
105.                 Set destFileObj = fso.GetFile(destFile)
106.                
107.                 If file.DateLastModified > destFileObj.DateLastModified Then
108.                     ' 源文件更新，覆盖目标文件
109.                     fso.CopyFile file.Path, destFile, True
110.                     LogMessage "更新文件 - " & subFolder.Name & "" & file.Name
111.                     filesCopied = filesCopied + 1
112.                 Else
113.                     ' 目标文件更新或相同，跳过
114.                     LogMessage "跳过文件（未更改） - " & subFolder.Name & "" & file.Name
115.                     filesSkipped = filesSkipped + 1
116.                 End If
117.             Else
118.                 ' 文件不存在，复制
119.                 fso.CopyFile file.Path, destFile
120.                 LogMessage "复制新文件 - " & subFolder.Name & "" & file.Name
121.                 filesCopied = filesCopied + 1
122.             End If
123.         Next
124.         
125.         ' 递归处理子文件夹
126.         CopySubFolders subFolder, subDestFolder
127.     Next
128. End Sub
130. ' 调用递归函数复制子文件夹
131. CopySubFolders sourceFolderObj, dateFolder
133. ' 完成消息
134. Dim summary
135. summary = "备份完成!" & vbCrLf & _
136.           "源文件夹: " & sourceFolder & vbCrLf & _
137.           "目标文件夹: " & dateFolder & vbCrLf & _
138.           "复制文件数: " & filesCopied & vbCrLf & _
139.           "跳过文件数: " & filesSkipped
141. MsgBox summary, vbInformation
142. LogMessage summary
144. ' 清理对象
145. Set fso = Nothing
146. Set sourceFolderObj = Nothing
148. ' 检查错误
149. If Err.Number <> 0 Then
150.     LogMessage "错误: " & Err.Description & " (错误号: " & Err.Number & ")"
151.     MsgBox "发生错误: " & Err.Description & " (错误号: " & Err.Number & ")", vbCritical
152. End If
154. On Error GoTo 0

复制代码

批量重命名文件

2. ' 批量重命名文件脚本
3. Option Explicit
5. ' 配置部分
6. Dim targetFolder, filePrefix, startNumber, padZero, logFile
7. targetFolder = "C:\Temp\RenameTest"  ' 目标文件夹
8. filePrefix = "IMG_"                   ' 文件前缀
9. startNumber = 1                       ' 起始编号
10. padZero = 4                           ' 编号位数（不足补零）
11. logFile = "C:\Temp\rename_log.txt"    ' 日志文件
13. ' 创建文件系统对象
14. Dim fso
15. Set fso = CreateObject("Scripting.FileSystemObject")
17. ' 创建日志函数
18. Sub LogMessage(message)
19.     Dim logStream
20.     Set logStream = fso.OpenTextFile(logFile, 8, True)  ' 8 = 追加模式
21.     logStream.WriteLine Now() & " - " & message
22.     logStream.Close
23. End Sub
25. ' 格式化编号函数
26. Function FormatNumber(number, digits)
27.     Dim result, i
28.     result = CStr(number)
29.    
30.     ' 补零
31.     For i = Len(result) To digits - 1
32.         result = "0" & result
33.     Next
34.    
35.     FormatNumber = result
36. End Function
38. ' 主程序
39. On Error Resume Next
41. ' 检查目标文件夹是否存在
42. If Not fso.FolderExists(targetFolder) Then
43.     LogMessage "错误: 目标文件夹不存在 - " & targetFolder
44.     MsgBox "错误: 目标文件夹不存在 - " & targetFolder, vbCritical
45.     WScript.Quit(1)
46. End If
48. ' 获取文件夹对象
49. Dim folderObj
50. Set folderObj = fso.GetFolder(targetFolder)
52. ' 显示确认信息
53. Dim confirmMsg
54. confirmMsg = "将重命名文件夹中的所有文件:" & vbCrLf & _
55.              "文件夹: " & targetFolder & vbCrLf & _
56.              "前缀: " & filePrefix & vbCrLf & _
57.              "起始编号: " & startNumber & vbCrLf & _
58.              "编号位数: " & padZero & vbCrLf & _
59.              vbCrLf & "确定要继续吗?"
61. If MsgBox(confirmMsg, vbQuestion + vbYesNo, "确认重命名") <> vbYes Then
62.     LogMessage "用户取消了操作"
63.     WScript.Quit(0)
64. End If
66. ' 获取文件列表并按修改时间排序
67. Dim files(), fileCount, file
68. fileCount = 0
70. ' 计算文件数量
71. For Each file In folderObj.Files
72.     fileCount = fileCount + 1
73. Next
75. ' 调整数组大小
76. ReDim files(fileCount - 1)
78. ' 填充数组
79. Dim index
80. index = 0
81. For Each file In folderObj.Files
82.     Set files(index) = file
83.     index = index + 1
84. Next
86. ' 简单的冒泡排序（按修改时间）
87. Dim i, j, temp
88. For i = 0 To UBound(files) - 1
89.     For j = i + 1 To UBound(files)
90.         If files(i).DateLastModified > files(j).DateLastModified Then
91.             Set temp = files(j)
92.             Set files(j) = files(i)
93.             Set files(i) = temp
94.         End If
95.     Next
96. Next
98. ' 重命名文件
99. Dim currentNumber, renamedCount, skippedCount
100. currentNumber = startNumber
101. renamedCount = 0
102. skippedCount = 0
104. For i = 0 To UBound(files)
105.     Dim oldName, newName, extension
106.     oldName = files(i).Name
107.    
108.     ' 获取文件扩展名
109.     extension = ""
110.     If InStr(oldName, ".") > 0 Then
111.         extension = Mid(oldName, InStrRev(oldName, "."))
112.     End If
113.    
114.     ' 构建新文件名
115.     newName = filePrefix & FormatNumber(currentNumber, padZero) & extension
116.    
117.     ' 检查新文件名是否已存在
118.     If fso.FileExists(targetFolder & "" & newName) Then
119.         LogMessage "跳过文件（目标文件名已存在）: " & oldName & " -> " & newName
120.         skippedCount = skippedCount + 1
121.     Else
122.         ' 重命名文件
123.         files(i).Name = newName
124.         LogMessage "重命名文件: " & oldName & " -> " & newName
125.         renamedCount = renamedCount + 1
126.         currentNumber = currentNumber + 1
127.     End If
128. Next
130. ' 完成消息
131. Dim summary
132. summary = "重命名完成!" & vbCrLf & _
133.           "文件夹: " & targetFolder & vbCrLf & _
134.           "重命名文件数: " & renamedCount & vbCrLf & _
135.           "跳过文件数: " & skippedCount
137. MsgBox summary, vbInformation
138. LogMessage summary
140. ' 清理对象
141. Set fso = Nothing
142. Set folderObj = Nothing
143. Erase files
145. ' 检查错误
146. If Err.Number <> 0 Then
147.     LogMessage "错误: " & Err.Description & " (错误号: " & Err.Number & ")"
148.     MsgBox "发生错误: " & Err.Description & " (错误号: " & Err.Number & ")", vbCritical
149. End If
151. On Error GoTo 0

复制代码

系统信息收集工具

2. ' 系统信息收集工具
3. Option Explicit
5. ' 配置部分
6. Dim outputFile
7. outputFile = "C:\Temp\SystemInfo_" & Year(Now()) & Right("0" & Month(Now()), 2) & Right("0" & Day(Now()), 2) & ".html"
9. ' 创建文件系统对象
10. Dim fso
11. Set fso = CreateObject("Scripting.FileSystemObject")
13. ' 创建WScript.Shell对象
14. Dim shell
15. Set shell = CreateObject("WScript.Shell")
17. ' 创建WMI对象
18. Dim wmi
19. Set wmi = GetObject("winmgmts:\\.\root\cimv2")
21. ' 创建HTML报告
22. Sub CreateHTMLReport()
23.     Dim htmlFile, htmlContent
24.    
25.     ' 创建输出文件夹（如果不存在）
26.     Dim outputFolder
27.     outputFolder = fso.GetParentFolderName(outputFile)
28.    
29.     If Not fso.FolderExists(outputFolder) Then
30.         fso.CreateFolder outputFolder
31.     End If
32.    
33.     ' 创建HTML文件
34.     Set htmlFile = fso.CreateTextFile(outputFile, True)
35.    
36.     ' HTML头部
37.     htmlContent = "<!DOCTYPE html>" & vbCrLf & _
38.                   "<html>" & vbCrLf & _
39.                   "<head>" & vbCrLf & _
40.                   "    <title>系统信息报告</title>" & vbCrLf & _
41.                   "    <meta charset=""utf-8"">" & vbCrLf & _
42.                   "    <style>" & vbCrLf & _
43.                   "        body { font-family: Arial, sans-serif; margin: 20px; }" & vbCrLf & _
44.                   "        h1, h2, h3 { color: #0066cc; }" & vbCrLf & _
45.                   "        table { border-collapse: collapse; width: 100%; margin-bottom: 20px; }" & vbCrLf & _
46.                   "        th, td { border: 1px solid #ddd; padding: 8px; text-align: left; }" & vbCrLf & _
47.                   "        th { background-color: #f2f2f2; }" & vbCrLf & _
48.                   "        tr:nth-child(even) { background-color: #f9f9f9; }" & vbCrLf & _
49.                   "        .timestamp { color: #666; font-size: 0.9em; }" & vbCrLf & _
50.                   "    </style>" & vbCrLf & _
51.                   "</head>" & vbCrLf & _
52.                   "<body>" & vbCrLf & _
53.                   "    <h1>系统信息报告</h1>" & vbCrLf & _
54.                   "    <p class=""timestamp"">生成时间: " & Now() & "</p>" & vbCrLf & _
55.                   "    <hr>" & vbCrLf
56.    
57.     ' 添加基本信息
58.     htmlContent = htmlContent & GetBasicInfo()
59.    
60.     ' 添加操作系统信息
61.     htmlContent = htmlContent & GetOSInfo()
62.    
63.     ' 添加计算机系统信息
64.     htmlContent = htmlContent & GetComputerSystemInfo()
65.    
66.     ' 添加处理器信息
67.     htmlContent = htmlContent & GetProcessorInfo()
68.    
69.     ' 添加内存信息
70.     htmlContent = htmlContent & GetMemoryInfo()
71.    
72.     ' 添加磁盘信息
73.     htmlContent = htmlContent & GetDiskInfo()
74.    
75.     ' 添加网络适配器信息
76.     htmlContent = htmlContent & GetNetworkAdapterInfo()
77.    
78.     ' 添加软件信息
79.     htmlContent = htmlContent & GetSoftwareInfo()
80.    
81.     ' 添加服务信息
82.     htmlContent = htmlContent & GetServiceInfo()
83.    
84.     ' 添加进程信息
85.     htmlContent = htmlContent & GetProcessInfo()
86.    
87.     ' HTML尾部
88.     htmlContent = htmlContent & "</body>" & vbCrLf & "</html>"
89.    
90.     ' 写入HTML文件
91.     htmlFile.Write htmlContent
92.     htmlFile.Close
93.    
94.     ' 显示完成消息
95.     MsgBox "系统信息报告已生成: " & outputFile, vbInformation
96.    
97.     ' 打开报告
98.     shell.Run outputFile
99. End Sub
101. ' 获取基本信息
102. Function GetBasicInfo()
103.     Dim html, computerName, userName, domain
104.    
105.     computerName = shell.ExpandEnvironmentStrings("%COMPUTERNAME%")
106.     userName = shell.ExpandEnvironmentStrings("%USERNAME%")
107.     domain = shell.ExpandEnvironmentStrings("%USERDOMAIN%")
108.    
109.     html = "<h2>基本信息</h2>" & vbCrLf & _
110.            "<table>" & vbCrLf & _
111.            "    <tr><th>项目</th><th>值</th></tr>" & vbCrLf & _
112.            "    <tr><td>计算机名</td><td>" & computerName & "</td></tr>" & vbCrLf & _
113.            "    <tr><td>用户名</td><td>" & userName & "</td></tr>" & vbCrLf & _
114.            "    <tr><td>域</td><td>" & domain & "</td></tr>" & vbCrLf & _
115.            "</table>" & vbCrLf
116.    
117.     GetBasicInfo = html
118. End Function
120. ' 获取操作系统信息
121. Function GetOSInfo()
122.     Dim html, items, item
123.    
124.     Set items = wmi.ExecQuery("Select * from Win32_OperatingSystem")
125.    
126.     html = "<h2>操作系统信息</h2>" & vbCrLf & _
127.            "<table>" & vbCrLf & _
128.            "    <tr><th>属性</th><th>值</th></tr>" & vbCrLf
129.    
130.     For Each item In items
131.         html = html & "    <tr><td>名称</td><td>" & item.Caption & "</td></tr>" & vbCrLf & _
132.                      "    <tr><td>版本</td><td>" & item.Version & "</td></tr>" & vbCrLf & _
133.                      "    <tr><td>制造商</td><td>" & item.Manufacturer & "</td></tr>" & vbCrLf & _
134.                      "    <tr><td>系统目录</td><td>" & item.WindowsDirectory & "</td></tr>" & vbCrLf & _
135.                      "    <tr><td>本地日期时间</td><td>" & item.LocalDateTime & "</td></tr>" & _
136.                      "    <tr><td>上次启动时间</td><td>" & item.LastBootUpTime & "</td></tr>" & vbCrLf & _
137.                      "    <tr><td>序列号</td><td>" & item.SerialNumber & "</td></tr>" & vbCrLf
138.         Exit For
139.     Next
140.    
141.     html = html & "</table>" & vbCrLf
142.    
143.     GetOSInfo = html
144. End Function
146. ' 获取计算机系统信息
147. Function GetComputerSystemInfo()
148.     Dim html, items, item
149.    
150.     Set items = wmi.ExecQuery("Select * from Win32_ComputerSystem")
151.    
152.     html = "<h2>计算机系统信息</h2>" & vbCrLf & _
153.            "<table>" & vbCrLf & _
154.            "    <tr><th>属性</th><th>值</th></tr>" & vbCrLf
155.    
156.     For Each item In items
157.         html = html & "    <tr><td>制造商</td><td>" & item.Manufacturer & "</td></tr>" & vbCrLf & _
158.                      "    <tr><td>型号</td><td>" & item.Model & "</td></tr>" & vbCrLf & _
159.                      "    <tr><td>系统类型</td><td>" & item.SystemType & "</td></tr>" & vbCrLf & _
160.                      "    <tr><td>处理器数量</td><td>" & item.NumberOfProcessors & "</td></tr>" & vbCrLf & _
161.                      "    <tr><td>总物理内存</td><td>" & Round(item.TotalPhysicalMemory / 1024 / 1024, 2) & " MB</td></tr>" & vbCrLf
162.         Exit For
163.     Next
164.    
165.     html = html & "</table>" & vbCrLf
166.    
167.     GetComputerSystemInfo = html
168. End Function
170. ' 获取处理器信息
171. Function GetProcessorInfo()
172.     Dim html, items, item
173.    
174.     Set items = wmi.ExecQuery("Select * from Win32_Processor")
175.    
176.     html = "<h2>处理器信息</h2>" & vbCrLf & _
177.            "<table>" & vbCrLf & _
178.            "    <tr><th>属性</th><th>值</th></tr>" & vbCrLf
179.    
180.     For Each item In items
181.         html = html & "    <tr><td>名称</td><td>" & item.Name & "</td></tr>" & vbCrLf & _
182.                      "    <tr><td>制造商</td><td>" & item.Manufacturer & "</td></tr>" & vbCrLf & _
183.                      "    <tr><td>最大时钟速度</td><td>" & item.MaxClockSpeed & " MHz</td></tr>" & vbCrLf & _
184.                      "    <tr><td>当前时钟速度</td><td>" & item.CurrentClockSpeed & " MHz</td></tr>" & vbCrLf & _
185.                      "    <tr><td>核心数</td><td>" & item.NumberOfCores & "</td></tr>" & vbCrLf & _
186.                      "    <tr><td>逻辑处理器数</td><td>" & item.NumberOfLogicalProcessors & "</td></tr>" & vbCrLf
187.     Next
188.    
189.     html = html & "</table>" & vbCrLf
190.    
191.     GetProcessorInfo = html
192. End Function
194. ' 获取内存信息
195. Function GetMemoryInfo()
196.     Dim html, items, item
197.    
198.     Set items = wmi.ExecQuery("Select * from Win32_PhysicalMemory")
199.    
200.     html = "<h2>内存信息</h2>" & vbCrLf & _
201.            "<table>" & vbCrLf & _
202.            "    <tr><th>属性</th><th>值</th></tr>" & vbCrLf
203.    
204.     Dim totalCapacity
205.     totalCapacity = 0
206.    
207.     For Each item In items
208.         Dim capacity
209.         capacity = item.Capacity / 1024 / 1024  ' 转换为MB
210.         totalCapacity = totalCapacity + capacity
211.         
212.         html = html & "    <tr><td>内存条 " & item.DeviceLocator & "</td><td>" & Round(capacity, 2) & " MB</td></tr>" & vbCrLf
213.     Next
214.    
215.     html = html & "    <tr><td><strong>总内存</strong></td><td><strong>" & Round(totalCapacity, 2) & " MB</strong></td></tr>" & vbCrLf
216.     html = html & "</table>" & vbCrLf
217.    
218.     GetMemoryInfo = html
219. End Function
221. ' 获取磁盘信息
222. Function GetDiskInfo()
223.     Dim html, items, item
224.    
225.     Set items = wmi.ExecQuery("Select * from Win32_LogicalDisk Where DriveType=3")
226.    
227.     html = "<h2>磁盘信息</h2>" & vbCrLf & _
228.            "<table>" & vbCrLf & _
229.            "    <tr><th>驱动器</th><th>文件系统</th><th>总大小</th><th>可用空间</th><th>使用率</th></tr>" & vbCrLf
230.    
231.     For Each item In items
232.         Dim totalSize, freeSpace, usedSpace, usagePercent
233.         
234.         totalSize = item.Size / 1024 / 1024 / 1024  ' 转换为GB
235.         freeSpace = item.FreeSpace / 1024 / 1024 / 1024  ' 转换为GB
236.         usedSpace = totalSize - freeSpace
237.         usagePercent = Round((usedSpace / totalSize) * 100, 2)
238.         
239.         html = html & "    <tr><td>" & item.DeviceID & "</td><td>" & item.FileSystem & "</td><td>" & _
240.                      Round(totalSize, 2) & " GB</td><td>" & Round(freeSpace, 2) & " GB</td><td>" & _
241.                      usagePercent & "%</td></tr>" & vbCrLf
242.     Next
243.    
244.     html = html & "</table>" & vbCrLf
245.    
246.     GetDiskInfo = html
247. End Function
249. ' 获取网络适配器信息
250. Function GetNetworkAdapterInfo()
251.     Dim html, items, item
252.    
253.     Set items = wmi.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=True")
254.    
255.     html = "<h2>网络适配器信息</h2>" & vbCrLf & _
256.            "<table>" & vbCrLf & _
257.            "    <tr><th>属性</th><th>值</th></tr>" & vbCrLf
258.    
259.     For Each item In items
260.         Dim ipAddresses, macAddress
261.         
262.         ' 获取IP地址
263.         ipAddresses = Join(item.IPAddress, ", ")
264.         
265.         ' 获取MAC地址
266.         macAddress = item.MACAddress
267.         
268.         html = html & "    <tr><td>描述</td><td>" & item.Description & "</td></tr>" & vbCrLf & _
269.                      "    <tr><td>MAC地址</td><td>" & macAddress & "</td></tr>" & vbCrLf & _
270.                      "    <tr><td>IP地址</td><td>" & ipAddresses & "</td></tr>" & vbCrLf & _
271.                      "    <tr><td>子网掩码</td><td>" & Join(item.IPSubnet, ", ") & "</td></tr>" & vbCrLf & _
272.                      "    <tr><td>默认网关</td><td>" & Join(item.DefaultIPGateway, ", ") & "</td></tr>" & vbCrLf & _
273.                      "    <tr><td>DNS服务器</td><td>" & Join(item.DNSServerSearchOrder, ", ") & "</td></tr>" & vbCrLf & _
274.                      "    <tr><td>DHCP启用</td><td>" & item.DHCPEnabled & "</td></tr>" & vbCrLf
275.     Next
276.    
277.     html = html & "</table>" & vbCrLf
278.    
279.     GetNetworkAdapterInfo = html
280. End Function
282. ' 获取软件信息
283. Function GetSoftwareInfo()
284.     Dim html, items, item
285.    
286.     Set items = wmi.ExecQuery("Select * from Win32_Product")
287.    
288.     html = "<h2>已安装软件</h2>" & vbCrLf & _
289.            "<table>" & vbCrLf & _
290.            "    <tr><th>名称</th><th>版本</th><th>供应商</th><th>安装日期</th></tr>" & vbCrLf
291.    
292.     For Each item In items
293.         Dim installDate
294.         installDate = item.InstallDate
295.         
296.         ' 格式化日期 (YYYYMMDD -> YYYY-MM-DD)
297.         If Len(installDate) >= 8 Then
298.             installDate = Left(installDate, 4) & "-" & Mid(installDate, 5, 2) & "-" & Mid(installDate, 7, 2)
299.         Else
300.             installDate = "未知"
301.         End If
302.         
303.         html = html & "    <tr><td>" & item.Name & "</td><td>" & item.Version & "</td><td>" & _
304.                      item.Vendor & "</td><td>" & installDate & "</td></tr>" & vbCrLf
305.     Next
306.    
307.     html = html & "</table>" & vbCrLf
308.    
309.     GetSoftwareInfo = html
310. End Function
312. ' 获取服务信息
313. Function GetServiceInfo()
314.     Dim html, items, item
315.    
316.     Set items = wmi.ExecQuery("Select * from Win32_Service Where State='Running'")
317.    
318.     html = "<h2>运行中的服务</h2>" & vbCrLf & _
319.            "<table>" & vbCrLf & _
320.            "    <tr><th>名称</th><th>显示名称</th><th>状态</th><th>启动模式</th><th>进程ID</th></tr>" & vbCrLf
321.    
322.     For Each item In items
323.         html = html & "    <tr><td>" & item.Name & "</td><td>" & item.DisplayName & "</td><td>" & _
324.                      item.State & "</td><td>" & item.StartMode & "</td><td>" & item.ProcessId & "</td></tr>" & vbCrLf
325.     Next
326.    
327.     html = html & "</table>" & vbCrLf
328.    
329.     GetServiceInfo = html
330. End Function
332. ' 获取进程信息
333. Function GetProcessInfo()
334.     Dim html, items, item
335.    
336.     Set items = wmi.ExecQuery("Select * from Win32_Process")
337.    
338.     html = "<h2>运行中的进程</h2>" & vbCrLf & _
339.            "<table>" & vbCrLf & _
340.            "    <tr><th>名称</th><th>进程ID</th><th>父进程ID</th><th>线程数</th><th>路径</th></tr>" & vbCrLf
341.    
342.     For Each item In items
343.         html = html & "    <tr><td>" & item.Name & "</td><td>" & item.ProcessId & "</td><td>" & _
344.                      item.ParentProcessId & "</td><td>" & item.ThreadCount & "</td><td>" & _
345.                      item.ExecutablePath & "</td></tr>" & vbCrLf
346.     Next
347.    
348.     html = html & "</table>" & vbCrLf
349.    
350.     GetProcessInfo = html
351. End Function
353. ' 主程序
354. On Error Resume Next
356. ' 创建HTML报告
357. CreateHTMLReport()
359. ' 检查错误
360. If Err.Number <> 0 Then
361.     MsgBox "发生错误: " & Err.Description & " (错误号: " & Err.Number & ")", vbCritical
362. End If
364. On Error GoTo 0
366. ' 清理对象
367. Set fso = Nothing
368. Set shell = Nothing
369. Set wmi = Nothing

复制代码

进阶技巧

错误处理

良好的错误处理是编写健壮脚本的关键。VBScript提供了On Error语句来控制错误处理。

2. ' 基本错误处理示例
3. Sub DivideNumbers(a, b)
4.     On Error Resume Next  ' 启用错误处理
5.    
6.     Dim result
7.     result = a / b
8.    
9.     If Err.Number <> 0 Then
10.         MsgBox "错误: " & Err.Description & " (错误号: " & Err.Number & ")"
11.     Else
12.         MsgBox "结果: " & result
13.     End If
14.    
15.     On Error GoTo 0  ' 禁用错误处理
16. End Sub
18. DivideNumbers 10, 2  ' 正常情况
19. DivideNumbers 10, 0  ' 错误情况（除以零）
21. ' 更复杂的错误处理
22. Sub ProcessFile(filePath)
23.     On Error Resume Next
24.    
25.     Dim fso, file, content
26.     Set fso = CreateObject("Scripting.FileSystemObject")
27.    
28.     ' 检查文件是否存在
29.     If Not fso.FileExists(filePath) Then
30.         MsgBox "错误: 文件不存在 - " & filePath
31.         Exit Sub
32.     End If
33.    
34.     ' 尝试打开文件
35.     Set file = fso.OpenTextFile(filePath, 1)  ' 1 = 只读模式
36.    
37.     If Err.Number <> 0 Then
38.         MsgBox "错误: 无法打开文件 - " & Err.Description
39.         Exit Sub
40.     End If
41.    
42.     ' 读取文件内容
43.     content = file.ReadAll
44.    
45.     If Err.Number <> 0 Then
46.         MsgBox "错误: 无法读取文件 - " & Err.Description
47.         file.Close
48.         Exit Sub
49.     End If
50.    
51.     ' 关闭文件
52.     file.Close
53.    
54.     ' 处理内容（这里只是显示长度）
55.     MsgBox "文件内容长度: " & Len(content) & " 字符"
56.    
57.     On Error GoTo 0
58. End Sub
60. ProcessFile "C:\Temp\test.txt"  ' 替换为实际存在的文件路径
61. ProcessFile "C:\Temp\nonexistent.txt"  ' 不存在的文件
63. ' 使用Err对象的Raise方法自定义错误
64. Sub ValidateAge(age)
65.     If age < 0 Then
66.         Err.Raise vbObjectError + 1, "ValidateAge", "年龄不能为负数"
67.     ElseIf age > 150 Then
68.         Err.Raise vbObjectError + 2, "ValidateAge", "年龄不能超过150岁"
69.     End If
70.    
71.     MsgBox "年龄验证通过: " & age
72. End Sub
74. Sub TestValidateAge()
75.     On Error Resume Next
76.    
77.     ValidateAge 25  ' 有效年龄
78.    
79.     If Err.Number <> 0 Then
80.         MsgBox "错误: " & Err.Description
81.         Err.Clear
82.     End If
83.    
84.     ValidateAge -5  ' 无效年龄
85.    
86.     If Err.Number <> 0 Then
87.         MsgBox "错误: " & Err.Description
88.         Err.Clear
89.     End If
90.    
91.     ValidateAge 200  ' 无效年龄
92.    
93.     If Err.Number <> 0 Then
94.         MsgBox "错误: " & Err.Description
95.         Err.Clear
96.     End If
97.    
98.     On Error GoTo 0
99. End Sub
101. TestValidateAge

复制代码

类和对象

VBScript支持使用Class语句创建自定义对象，这对于组织代码和创建可重用组件非常有用。

2. ' 定义一个简单的Person类
3. Class Person
4.     ' 私有字段
5.     Private m_Name
6.     Private m_Age
7.     Private m_Gender
8.    
9.     ' 构造函数
10.     Private Sub Class_Initialize()
11.         m_Name = ""
12.         m_Age = 0
13.         m_Gender = ""
14.     End Sub
15.    
16.     ' 析构函数
17.     Private Sub Class_Terminate()
18.         ' 清理代码
19.     End Sub
20.    
21.     ' 公共属性
22.     Public Property Get Name
23.         Name = m_Name
24.     End Property
25.    
26.     Public Property Let Name(value)
27.         m_Name = value
28.     End Property
29.    
30.     Public Property Get Age
31.         Age = m_Age
32.     End Property
33.    
34.     Public Property Let Age(value)
35.         If value >= 0 And value <= 150 Then
36.             m_Age = value
37.         Else
38.             Err.Raise vbObjectError + 1, "Person.Age", "年龄必须在0到150之间"
39.         End If
40.     End Property
41.    
42.     Public Property Get Gender
43.         Gender = m_Gender
44.     End Property
45.    
46.     Public Property Let Gender(value)
47.         m_Gender = value
48.     End Property
49.    
50.     ' 公共方法
51.     Public Sub Introduce()
52.         MsgBox "大家好，我叫" & m_Name & "，今年" & m_Age & "岁。"
53.     End Sub
54.    
55.     Public Function IsAdult()
56.         IsAdult = (m_Age >= 18)
57.     End Function
58. End Class
60. ' 使用Person类
61. Dim person1, person2
62. Set person1 = New Person
64. ' 设置属性
65. person1.Name = "张三"
66. person1.Age = 25
67. person1.Gender = "男"
69. ' 调用方法
70. person1.Introduce()
72. If person1.IsAdult() Then
73.     MsgBox person1.Name & "是成年人。"
74. Else
75.     MsgBox person1.Name & "不是成年人。"
76. End If
78. ' 创建另一个Person对象
79. Set person2 = New Person
80. person2.Name = "李四"
81. person2.Age = 16
82. person2.Gender = "女"
84. person2.Introduce()
86. If person2.IsAdult() Then
87.     MsgBox person2.Name & "是成年人。"
88. Else
89.     MsgBox person2.Name & "不是成年人。"
90. End If
92. ' 定义一个更复杂的Employee类，继承自Person
93. Class Employee
94.     ' 私有字段
95.     Private m_Person
96.     Private m_Department
97.     Private m_Salary
98.    
99.     ' 构造函数
100.     Private Sub Class_Initialize()
101.         Set m_Person = New Person
102.         m_Department = ""
103.         m_Salary = 0
104.     End Sub
105.    
106.     ' 析构函数
107.     Private Sub Class_Terminate()
108.         Set m_Person = Nothing
109.     End Sub
110.    
111.     ' 公共属性（委托给Person对象）
112.     Public Property Get Name
113.         Name = m_Person.Name
114.     End Property
115.    
116.     Public Property Let Name(value)
117.         m_Person.Name = value
118.     End Property
119.    
120.     Public Property Get Age
121.         Age = m_Person.Age
122.     End Property
123.    
124.     Public Property Let Age(value)
125.         m_Person.Age = value
126.     End Property
127.    
128.     Public Property Get Gender
129.         Gender = m_Person.Gender
130.     End Property
131.    
132.     Public Property Let Gender(value)
133.         m_Person.Gender = value
134.     End Property
135.    
136.     ' Employee特有属性
137.     Public Property Get Department
138.         Department = m_Department
139.     End Property
140.    
141.     Public Property Let Department(value)
142.         m_Department = value
143.     End Property
144.    
145.     Public Property Get Salary
146.         Salary = m_Salary
147.     End Property
148.    
149.     Public Property Let Salary(value)
150.         If value >= 0 Then
151.             m_Salary = value
152.         Else
153.             Err.Raise vbObjectError + 1, "Employee.Salary", "薪水不能为负数"
154.         End If
155.     End Property
156.    
157.     ' 公共方法
158.     Public Sub Introduce()
159.         m_Person.Introduce()
160.         MsgBox "我在" & m_Department & "部门工作，月薪为" & m_Salary & "元。"
161.     End Sub
162.    
163.     Public Function GetAnnualSalary()
164.         GetAnnualSalary = m_Salary * 12
165.     End Function
166.    
167.     Public Sub RaiseSalary(percent)
168.         If percent > 0 Then
169.             m_Salary = m_Salary * (1 + percent / 100)
170.             MsgBox "恭喜！您的薪水已提高" & percent & "%，新月薪为" & m_Salary & "元。"
171.         Else
172.             Err.Raise vbObjectError + 2, "Employee.RaiseSalary", "提高百分比必须为正数"
173.         End If
174.     End Sub
175. End Class
177. ' 使用Employee类
178. Dim employee
179. Set employee = New Employee
181. ' 设置属性
182. employee.Name = "王五"
183. employee.Age = 30
184. employee.Gender = "男"
185. employee.Department = "技术部"
186. employee.Salary = 8000
188. ' 调用方法
189. employee.Introduce()
190. MsgBox employee.Name & "的年薪为" & employee.GetAnnualSalary() & "元。"
192. ' 提高薪水
193. employee.RaiseSalary(10)
194. MsgBox employee.Name & "提高后的年薪为" & employee.GetAnnualSalary() & "元。"

复制代码

正则表达式

VBScript通过VBScript.RegExp对象支持正则表达式，这对于文本处理和模式匹配非常有用。

2. ' 基本正则表达式匹配
3. Sub TestRegExp()
4.     Dim regex, match, matches
5.     Set regex = New RegExp
6.    
7.     ' 设置正则表达式模式
8.     regex.Pattern = "\d+"  ' 匹配一个或多个数字
9.    
10.     ' 设置是否区分大小写
11.     regex.IgnoreCase = True
12.    
13.     ' 设置是否全局匹配
14.     regex.Global = True
15.    
16.     ' 测试字符串
17.     Dim testString
18.     testString = "电话号码: 123-456-7890, 邮编: 100001"
19.    
20.     ' 执行匹配
21.     Set matches = regex.Execute(testString)
22.    
23.     ' 显示匹配结果
24.     Dim result
25.     result = "在字符串 """ & testString & """ 中找到以下数字:" & vbCrLf
26.    
27.     For Each match In matches
28.         result = result & "找到: " & match.Value & " (位置: " & match.FirstIndex & ", 长度: " & match.Length & ")" & vbCrLf
29.     Next
30.    
31.     MsgBox result
32. End Sub
34. TestRegExp()
36. ' 验证电子邮件地址
37. Function IsValidEmail(email)
38.     Dim regex
39.     Set regex = New RegExp
40.    
41.     ' 电子邮件正则表达式模式
42.     regex.Pattern = "^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,}$"
43.    
44.     ' 执行测试
45.     IsValidEmail = regex.Test(email)
46. End Function
48. ' 测试电子邮件验证
49. Sub TestEmailValidation()
50.     Dim emails, email, result
51.    
52.     emails = Array("user@example.com", "user.name@example.co.uk", "invalid-email", "@example.com", "user@.com")
53.    
54.     result = "电子邮件验证结果:" & vbCrLf
55.    
56.     For Each email In emails
57.         result = result & email & " - " & IIf(IsValidEmail(email), "有效", "无效") & vbCrLf
58.     Next
59.    
60.     MsgBox result
61. End Sub
63. ' 辅助函数（VBScript没有内置的IIf函数）
64. Function IIf(condition, truePart, falsePart)
65.     If condition Then
66.         IIf = truePart
67.     Else
68.         IIf = falsePart
69.     End If
70. End Function
72. TestEmailValidation()
74. ' 替换文本
75. Sub ReplaceText()
76.     Dim regex, inputText, outputText
77.    
78.     Set regex = New RegExp
79.    
80.     ' 设置正则表达式模式
81.     regex.Pattern = "\b(\d{1,2})/(\d{1,2})/(\d{4})\b"  ' 匹配 MM/DD/YYYY 格式的日期
82.    
83.     ' 设置全局匹配
84.     regex.Global = True
85.    
86.     ' 输入文本
87.     inputText = "会议日期: 05/15/2023, 截止日期: 06/30/2023"
88.    
89.     ' 替换为 YYYY-MM-DD 格式
90.     outputText = regex.Replace(inputText, "$3-$1-$2")
91.    
92.     MsgBox "原始文本: " & inputText & vbCrLf & _
93.            "替换后: " & outputText
94. End Sub
96. ReplaceText()
98. ' 提取HTML标签内容
99. Sub ExtractHTMLTags()
100.     Dim regex, html, matches, match, result
101.    
102.     Set regex = New RegExp
103.    
104.     ' 设置正则表达式模式
105.     regex.Pattern = "<([^>]+)>([^<]*)</\1>"  ' 匹配HTML标签及其内容
106.    
107.     ' 设置全局匹配
108.     regex.Global = True
109.    
110.     ' HTML文本
111.     html = "<div><h1>标题</h1><p>这是一个段落。</p></div>"
112.    
113.     ' 执行匹配
114.     Set matches = regex.Execute(html)
115.    
116.     ' 显示匹配结果
117.     result = "在HTML中找到以下标签:" & vbCrLf
118.    
119.     For Each match In matches
120.         result = result & "标签: " & match.SubMatches(0) & ", 内容: " & match.SubMatches(1) & vbCrLf
121.     Next
122.    
123.     MsgBox result
124. End Sub
126. ExtractHTMLTags()
128. ' 分割字符串
129. Sub SplitString()
130.     Dim regex, inputText, result
131.    
132.     Set regex = New RegExp
133.    
134.     ' 设置正则表达式模式
135.     regex.Pattern = "\s*,\s*"  ' 匹配逗号及其前后的空白字符
136.    
137.     ' 设置全局匹配
138.     regex.Global = True
139.    
140.     ' 输入文本
141.     inputText = "苹果, 香蕉, 橙子, 葡萄"
142.    
143.     ' 分割字符串
144.     result = Split(regex.Replace(inputText, ","), ",")
145.    
146.     ' 显示结果
147.     Dim output, item
148.     output = "分割结果:" & vbCrLf
149.    
150.     For Each item In result
151.         output = output & item & vbCrLf
152.     Next
153.    
154.     MsgBox output
155. End Sub
157. SplitString()

复制代码

常见问题和解决方案

问题1：脚本运行时出现”权限被拒绝”错误

解决方案：

2. ' 检查管理员权限并请求提升
3. Function IsAdmin()
4.     On Error Resume Next
5.    
6.     Dim shell
7.     Set shell = CreateObject("WScript.Shell")
8.    
9.     ' 尝试执行需要管理员权限的操作
10.     shell.RegRead "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System"
11.    
12.     IsAdmin = (Err.Number = 0)
13.    
14.     On Error GoTo 0
15. End Function
17. Sub RunAsAdmin()
18.     If Not IsAdmin() Then
19.         Dim shell
20.         Set shell = CreateObject("WScript.Shell")
21.         
22.         ' 重新以管理员权限运行脚本
23.         shell.Run "wscript.exe //e:vbscript """ & WScript.ScriptFullName & """", 0, False
24.         
25.         ' 退出当前脚本
26.         WScript.Quit
27.     End If
28. End Sub
30. ' 在脚本开始处调用
31. RunAsAdmin()
33. ' 现在可以执行需要管理员权限的操作
34. MsgBox "脚本正在以管理员权限运行"

复制代码

问题2：处理包含特殊字符的文件路径

解决方案：

2. ' 处理包含特殊字符的文件路径
3. Sub HandleSpecialCharsInPath()
4.     Dim fso, filePath, file
5.    
6.     Set fso = CreateObject("Scripting.FileSystemObject")
7.    
8.     ' 包含特殊字符的文件路径
9.     filePath = "C:\Temp\Special [Chars] & File.txt"
10.    
11.     ' 检查文件是否存在
12.     If fso.FileExists(filePath) Then
13.         Set file = fso.GetFile(filePath)
14.         MsgBox "文件存在: " & file.Name & vbCrLf & "大小: " & file.Size & " 字节"
15.     Else
16.         ' 创建文件
17.         Set file = fso.CreateTextFile(filePath, True)
18.         file.WriteLine "这是一个包含特殊字符的文件"
19.         file.Close
20.         
21.         MsgBox "已创建文件: " & filePath
22.     End If
23. End Sub
25. HandleSpecialCharsInPath()

复制代码

问题3：脚本执行速度慢

解决方案：

2. ' 优化脚本执行速度
3. Sub OptimizeScriptPerformance()
4.     Dim startTime, endTime, fso, folder, file, fileCount
5.    
6.     ' 记录开始时间
7.     startTime = Timer
8.    
9.     ' 创建对象（只创建一次）
10.     Set fso = CreateObject("Scripting.FileSystemObject")
11.    
12.     ' 获取文件夹
13.     Set folder = fso.GetFolder("C:\Windows")
14.    
15.     ' 预分配数组大小（如果可能）
16.     fileCount = folder.Files.Count
17.     ReDim fileNames(fileCount - 1)
18.    
19.     ' 使用For Each循环（比For循环更快）
20.     Dim i
21.     i = 0
22.     For Each file In folder.Files
23.         fileNames(i) = file.Name
24.         i = i + 1
25.     Next
26.    
27.     ' 减少与对象的交互
28.     Dim output
29.     output = "找到 " & fileCount & " 个文件:" & vbCrLf
30.    
31.     ' 使用字符串连接（比多次使用&更快）
32.     For i = 0 To UBound(fileNames)
33.         output = output & fileNames(i) & vbCrLf
34.     Next
35.    
36.     ' 记录结束时间
37.     endTime = Timer
38.    
39.     ' 显示结果和执行时间
40.     MsgBox output & vbCrLf & "执行时间: " & FormatNumber(endTime - startTime, 2) & " 秒"
41. End Sub
43. OptimizeScriptPerformance()

复制代码

问题4：处理大文件时的内存问题

解决方案：

2. ' 处理大文件时避免内存问题
3. Sub ProcessLargeFile()
4.     Dim fso, inputFile, outputFile, line, linesProcessed
5.    
6.     Set fso = CreateObject("Scripting.FileSystemObject")
7.    
8.     ' 输入和输出文件路径
9.     Dim inputPath, outputPath
10.     inputPath = "C:\Temp\large_file.txt"
11.     outputPath = "C:\Temp\processed_file.txt"
12.    
13.     ' 检查输入文件是否存在
14.     If Not fso.FileExists(inputPath) Then
15.         MsgBox "输入文件不存在: " & inputPath
16.         Exit Sub
17.     End If
18.    
19.     ' 打开输入文件
20.     Set inputFile = fso.OpenTextFile(inputPath, 1)  ' 1 = 只读模式
21.    
22.     ' 创建输出文件
23.     Set outputFile = fso.CreateTextFile(outputPath, True)  ' True = 可覆盖
24.    
25.     ' 初始化计数器
26.     linesProcessed = 0
27.    
28.     ' 逐行处理文件（避免一次性读取整个文件）
29.     Do Until inputFile.AtEndOfStream
30.         line = inputFile.ReadLine
31.         
32.         ' 处理行（这里只是简单地将行写入输出文件）
33.         outputFile.WriteLine "Processed: " & line
34.         
35.         ' 更新计数器
36.         linesProcessed = linesProcessed + 1
37.         
38.         ' 每处理1000行显示一次进度
39.         If linesProcessed Mod 1000 = 0 Then
40.             WScript.Echo "已处理 " & linesProcessed & " 行..."
41.         End If
42.     Loop
43.    
44.     ' 关闭文件
45.     inputFile.Close
46.     outputFile.Close
47.    
48.     ' 显示完成消息
49.     MsgBox "文件处理完成!" & vbCrLf & _
50.            "输入文件: " & inputPath & vbCrLf & _
51.            "输出文件: " & outputPath & vbCrLf & _
52.            "处理行数: " & linesProcessed
53. End Sub
55. ProcessLargeFile()

复制代码

问题5：脚本在64位系统上的兼容性问题

解决方案：

2. ' 处理64位系统上的兼容性问题
3. Function Is64BitOS()
4.     On Error Resume Next
5.    
6.     Dim shell
7.     Set shell = CreateObject("WScript.Shell")
8.    
9.     ' 检查PROCESSOR_ARCHITECTURE环境变量
10.     Dim procArch
11.     procArch = shell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%")
12.    
13.     If InStr(1, procArch, "64", vbTextCompare) > 0 Then
14.         Is64BitOS = True
15.     Else
16.         ' 检查PROCESSOR_ARCHITEW6432环境变量
17.         Dim procArchW64
18.         procArchW64 = shell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITEW6432%")
19.         
20.         If InStr(1, procArchW64, "64", vbTextCompare) > 0 Then
21.             Is64BitOS = True
22.         Else
23.             Is64BitOS = False
24.         End If
25.     End If
26.    
27.     On Error GoTo 0
28. End Function
30. Sub Run32BitScriptOn64BitOS()
31.     If Is64BitOS() Then
32.         ' 检查当前是否在32位脚本宿主中运行
33.         Dim shell
34.         Set shell = CreateObject("WScript.Shell")
35.         
36.         Dim sysWow64
37.         sysWow64 = shell.ExpandEnvironmentStrings("%SystemRoot%") & "\SysWOW64"
38.         
39.         If Not fso.FolderExists(sysWow64) Then
40.             ' 32位子系统不存在，无法运行32位脚本
41.             MsgBox "无法在64位系统上运行32位脚本"
42.             Exit Sub
43.         End If
44.         
45.         ' 重新在32位脚本宿主中运行脚本
46.         Dim scriptPath
47.         scriptPath = WScript.ScriptFullName
48.         
49.         Dim command
50.         command = "%SystemRoot%\SysWOW64\wscript.exe """ & scriptPath & """"
51.         
52.         shell.Run command, 0, False
53.         
54.         ' 退出当前脚本
55.         WScript.Quit
56.     Else
57.         ' 在32位系统上直接运行
58.         MsgBox "正在32位系统上运行脚本"
59.     End If
60. End Sub
62. ' 在脚本开始处调用
63. Run32BitScriptOn64BitOS()

复制代码

结论

VBScript是一种强大而灵活的脚本语言，特别适合在Windows环境中实现自动化任务。通过本文的学习，您已经掌握了VBScript的基础知识、高级技巧以及实际应用案例。从简单的变量操作到复杂的系统管理，VBScript都能胜任。

要真正掌握VBScript，关键在于实践。尝试将日常工作中重复性的任务自动化，您将发现VBScript的强大之处。随着经验的积累，您将能够编写更复杂、更高效的脚本，进一步提高工作效率。

记住，学习编程是一个持续的过程。不断探索、实践和学习，您将成为一名出色的VBScript开发者，能够利用这一强大工具解决各种实际问题。