Skip to content

Tools - 字典工具类

cToolsDic - 字典操作工具

概述

提供 Dictionary 对象的扩展操作方法,包括表单编码转换、嵌套字典操作、字典合并、深拷贝等。


Form URL-Encoded 转换

ToWwwFormUrlencoded

将字典转换为 application/x-www-form-urlencoded 格式字符串。

vb
Public Function ToWwwFormUrlencoded(Dic As Scripting.Dictionary) As String

参数:

参数名类型说明
DicScripting.Dictionary要转换的字典

返回值:

URL 编码格式的字符串,如 key1=value1&key2=value2

说明:

  • 简单实现版本,直接拼接键值对
  • 暂不支持数组类型值

示例:

vb
Dim Dic As New Scripting.Dictionary
Dic.Add "name", "张三"
Dic.Add "age", "25"

Dim FormData As String
FormData = VBMAN.ToolsDic.ToWwwFormUrlencoded(Dic)
Debug.Print FormData  ' 输出: name=张三&age=25

FromWwwFormUrlencoded

解析 application/x-www-form-urlencoded 格式字符串到字典。

vb
Public Function FromWwwFormUrlencoded(Content As String, Dic As Scripting.Dictionary) As Boolean

参数:

参数名类型说明
ContentStringURL 编码格式的字符串
DicScripting.Dictionary存储结果的字典(ByRef)

返回值:

  • True - 解析成功

示例:

vb
Dim Dic As New Scripting.Dictionary
Dim Success As Boolean

Success = VBMAN.ToolsDic.FromWwwFormUrlencoded("name=张三&age=25", Dic)

Debug.Print Dic("name")  ' 输出: 张三
Debug.Print Dic("age")   ' 输出: 25

嵌套字典操作

TowLevelDicAssign

双层嵌套字典赋值辅助方法。

vb
Public Sub TowLevelDicAssign(Dic As Scripting.Dictionary, Lv1Name As String, Lv2Name As String, Value As Variant)

说明:

自动创建第一层字典(如果不存在),然后在第二层字典中赋值。

参数:

参数名类型说明
DicScripting.Dictionary目标字典
Lv1NameString第一层键名
Lv2NameString第二层键名
ValueVariant要赋的值

示例:

vb
Dim Dic As New Scripting.Dictionary

' 自动创建 "user" 子字典,并设置 "name" 值
VBMAN.ToolsDic.TowLevelDicAssign Dic, "user", "name", "张三"
VBMAN.ToolsDic.TowLevelDicAssign Dic, "user", "age", 25

' 结果: Dic("user")("name") = "张三"
'       Dic("user")("age") = 25

Debug.Print Dic("user")("name")  ' 输出: 张三
Debug.Print Dic("user")("age")   ' 输出: 25

' 也可以操作更深层的字典
VBMAN.ToolsDic.TowLevelDicAssign Dic, "settings", "theme", "dark"
VBMAN.ToolsDic.TowLevelDicAssign Dic, "settings", "lang", "zh-CN"

Debug.Print Dic("settings")("theme")  ' 输出: dark

字典合并

OverWrite

合并源字典到目标字典。

vb
Public Sub OverWrite(DistDic As Scripting.Dictionary, srcDic As Scripting.Dictionary, Optional OnlyKey As Boolean = True)

参数:

参数名类型说明
DistDicScripting.Dictionary目标字典
srcDicScripting.Dictionary源字典
OnlyKeyBoolean仅覆盖已存在的键(默认 True)

说明:

  • 支持递归合并嵌套字典
  • 对象类型使用递归合并
  • 非对象类型直接赋值

示例:

vb
Dim Target As New Scripting.Dictionary
Dim Source As New Scripting.Dictionary

Target.Add "a", "old_a"
Target.Add "b", "old_b"

Source.Add "a", "new_a"
Source.Add "c", "new_c"

' OnlyKey=True:只覆盖已存在的键(a)
VBMAN.ToolsDic.OverWrite Target, Source, True
' 结果: Target("a") = "new_a"
'       Target("b") = "old_b"
'       Target("c") = 不存在

' OnlyKey=False:覆盖所有并添加新键
Dim Target2 As New Scripting.Dictionary
Target2.Add "a", "old_a"
Target2.Add "b", "old_b"

VBMAN.ToolsDic.OverWrite Target2, Source, False
' 结果: Target2("a") = "new_a"
'       Target2("b") = "old_b"
'       Target2("c") = "new_c"

' 嵌套字典合并示例
Dim NestedTarget As New Scripting.Dictionary
Dim NestedSource As New Scripting.Dictionary
Dim UserDic As New Scripting.Dictionary
Dim SettingsDic As New Scripting.Dictionary

UserDic.Add "name", "张三"
UserDic.Add "age", 20
NestedTarget.Add "user", UserDic

SettingsDic.Add "theme", "light"
NestedSource.Add "user", SettingsDic

VBMAN.ToolsDic.OverWrite NestedTarget, NestedSource, False
' NestedTarget("user") 包含 name, age, theme

字典拷贝

DeepCopy

深拷贝字典对象。

vb
Public Function DeepCopy(srcDic As Scripting.Dictionary) As Scripting.Dictionary

参数:

参数名类型说明
srcDicScripting.Dictionary源字典

返回值:

新的字典对象,包含源字典的所有键值对。

说明:

  • 目前仅实现单层拷贝(第一层键值对)
  • 对象类型使用 Set 赋值
  • 非对象类型使用 Let 赋值
  • TODO: 需要改为递归实现深层对象赋值

示例:

vb
Dim Original As New Scripting.Dictionary
Original.Add "name", "张三"
Original.Add "age", 25

' 创建深拷贝
Dim Copy As Scripting.Dictionary
Set Copy = VBMAN.ToolsDic.DeepCopy(Original)

' 修改拷贝不影响原字典
Copy("name") = "李四"

Debug.Print Original("name")  ' 输出: 张三
Debug.Print Copy("name")      ' 输出: 李四

' 注意:对于嵌套字典,目前仍是浅拷贝
Dim Nested As New Scripting.Dictionary
Dim Inner As New Scripting.Dictionary
Inner.Add "key", "value"
Nested.Add "inner", Inner

Dim NestedCopy As Scripting.Dictionary
Set NestedCopy = VBMAN.ToolsDic.DeepCopy(Nested)

' 修改嵌套字典会影响原字典(因为是引用)
NestedCopy("inner")("key") = "new_value"
Debug.Print Nested("inner")("key")  ' 输出: new_value

完整示例

vb
Private Sub DictionaryDemo()
    ' ===== Form URL-Encoded 操作 =====
    
    Dim Params As New Scripting.Dictionary
    Params.Add "username", "admin"
    Params.Add "password", "123456"
    Params.Add "remember", "true"
    
    ' 编码为 Form 格式
    Dim FormData As String
    FormData = VBMAN.ToolsDic.ToWwwFormUrlencoded(Params)
    Debug.Print "Form数据: " & FormData
    
    ' 解码回字典
    Dim Parsed As New Scripting.Dictionary
    VBMAN.ToolsDic.FromWwwFormUrlencoded FormData, Parsed
    Debug.Print "用户名: " & Parsed("username")
    
    ' ===== 嵌套字典操作 =====
    
    Dim Config As New Scripting.Dictionary
    
    ' 使用 TowLevelDicAssign 快速创建嵌套结构
    VBMAN.ToolsDic.TowLevelDicAssign Config, "database", "host", "localhost"
    VBMAN.ToolsDic.TowLevelDicAssign Config, "database", "port", 3306
    VBMAN.ToolsDic.TowLevelDicAssign Config, "database", "name", "mydb"
    
    VBMAN.ToolsDic.TowLevelDicAssign Config, "cache", "enabled", True
    VBMAN.ToolsDic.TowLevelDicAssign Config, "cache", "ttl", 3600
    
    Debug.Print "数据库主机: " & Config("database")("host")
    Debug.Print "缓存TTL: " & Config("cache")("ttl")
    
    ' ===== 字典合并 =====
    
    Dim Defaults As New Scripting.Dictionary
    Defaults.Add "theme", "light"
    Defaults.Add "lang", "en"
    Defaults.Add "notifications", True
    
    Dim UserSettings As New Scripting.Dictionary
    UserSettings.Add "theme", "dark"
    
    ' 合并:用户设置覆盖默认值
    VBMAN.ToolsDic.OverWrite Defaults, UserSettings, False
    
    Debug.Print "主题: " & Defaults("theme")        ' dark(用户设置)
    Debug.Print "语言: " & Defaults("lang")         ' en(默认值)
    Debug.Print "通知: " & Defaults("notifications") ' True(默认值)
    
    ' ===== 深拷贝 =====
    
    Dim Original As New Scripting.Dictionary
    Original.Add "key1", "value1"
    Original.Add "key2", 12345
    
    Dim Cloned As Scripting.Dictionary
    Set Cloned = VBMAN.ToolsDic.DeepCopy(Original)
    
    ' 验证是独立副本
    Cloned("key1") = "modified"
    Debug.Print "Original: " & Original("key1")  ' value1
    Debug.Print "Cloned: " & Cloned("key1")      ' modified
End Sub

方法对比表

方法用途复杂度
ToWwwFormUrlencoded字典转查询字符串O(n)
FromWwwFormUrlencoded查询字符串转字典O(n)
TowLevelDicAssign双层嵌套赋值O(1)
OverWrite字典合并O(n)
DeepCopy字典深拷贝O(n)

VB6及其LOGO版权为微软公司所有