[vb6.0]一个自用html标签属性存取数据的类

'/*
'类作用：类似html标签，在标签内属性存取内容
'约定：
'1.：所有标签、属性必须用小写
'2.：没有html标签嵌套，仅利用单个标签属性来存取内容
'3.：每个标签名字必须都不相同
'*/
'//////////////////////////// 定义属性
Private allContent As String, temp As String

'//所有内容
Public Function content(Optional str As String = "")
'//设置内容
If Len(str) > 0 Then
allContent = str
'//返回内容
Else
content = allContent
End If
End Function
'// 标签
Public Function label(lbName As String, Optional isAdd As Boolean = False)
'//取得标签
If isAdd = False Then
If Len(lbName) = 0 Then
label = ""
Exit Function
End If
Dim lbF, lbB
lbF = "<" & lbName
lbB = "</" & LCase(lbName) & ">"
If InStr(LCase(allContent), lbB) > 0 Then
'//取得标签内容
label = lbF & zq(allContent, lbF, lbB) & lbB
Else
label = ""
Exit Function
End If
End If
'//插入标签
If isAdd = True Then
If InStr(allContent, "</" & lbName & ">") = 0 Then
allContent = allContent & "<" & lbName & "></" & lbName & ">"
Else
MsgBox "<" & lbName & "></" & lbName & ">已存在，不能重复添加！", , "提示"
End If
End If
End Function
'//取得属性
Public Function attr(lb As String, strName As String, Optional strValue As String = "")
'//判断标签是否存在
If InStr(allContent, "</" & lb & ">") = 0 Then
Call label(lb, True) '//添加标签
End If
'//得取属性
If Len(strValue) = 0 Then
If InStr(eqNoSp(label(lb)), " " & strName & "=") <> 0 Then
attr = zq(eqNoSp(label(lb)), " " & strName & "=""", """")
Else
attr = ""
End If
'//设置属性
Else
Dim oldLb, newLb
'//取得原标签内容
oldLb = label(lb)
'//取得新标签内容
'//属性不存在则添加
If InStr(eqNoSp(label(lb)), Trim(strName) & "=""") = 0 Then
newLb = "<" & lb & " " & strName & "=""" & strValue & """" & Split(eqNoSp(label(lb)), "<" & lb)(1)
'//属性存在则修改之
Else
newLb = oneChange(eqNoSp(label(lb)), Trim(strName) & "=""", """", strValue)
End If
'//标签更新到 allContent 里面
allContent = Replace(allContent, oldLb, newLb)
End If
End Function

'// 截取一段字符串，如： abc:ss; 中取出ss，
'参数： ct ：传入内容，如：abc:ss;
'参数： f     : 断前，如： abc:
'参数： b    : 断后，如： ;
'参数： p    : 当有多个相同时候，0则取前面一个，否则取后面的
'返回：ss
'Private Function zq(ct, f, b, Optional p As Integer = 0)
'    Dim arr, a, n
'    n = 1
'    arr = Split(ct, f)
''    MsgBox "__" & ct
''    MsgBox "__" & f
''    MsgBox "__" & b
'    For a = 0 To UBound(arr)
'        If InStr(arr(a), b) Then
'            zq = Split(arr(a), b)(0)
'            If p = 0 Then Exit Function
'        End If
'    Next
'End Function
Private Function zq(allStr, sta, fin) As String

'////hex '截取函数
Dim arr
Dim I, c
arr = Split(allStr, sta)
For I = 1 To UBound(arr)
If InStr(arr(I), fin) Then c = Split(arr(I), fin)(0)
Next I
zq = c

End Function

'//作用：去掉等号左右空格键，如： href  =" 转成无空格： href="
Private Function eqNoSp(lb As String)
For I = 0 To 10
lb = Replace(lb, " =", "=")
lb = Replace(lb, "= ", "=")
Next
eqNoSp = lb
End Function
'作用：前后文修改内容，如将abc:520; 中，修改为：abc:114;
Private Function oneChange(c, f, b, r)
Dim oC, nC
oC = f & zq(c, f, b) & b
nC = f & r & b
'    MsgBox oC
'    MsgBox nC
oneChange = Replace(c, oC, nC)
End Function

Private Sub Command1_Click()
Dim d As clsData
Set d = New clsData
'// .content
d.content ("<a style=""color:#ff0000;""></a><b href=""zxpaipai.com""></b>") '设置全局标签内容
MsgBox "全部标签内容：" & d.content  '没有参数则为读取全部标签内容
'// .label
MsgBox "标签内容：" & d.label("a")  '一个参数为读取标签内容
Call d.label("c", True) '//两个参数，第二个为true则是添加一个c标签
MsgBox "全部标签内容：" & d.content
'// .attr
MsgBox "取得属性内容：" & d.attr("a", "style") '//取得a标签属性内容
Call d.attr("a", "style", "我要修改style属性") '//修改a标签style属性
Call d.attr("c", "data", "sorry") '//修改c标签data属性，因为data属性不存在，所以自动创建了一个属性
MsgBox "全部标签内容：" & d.content
End Sub