[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