技术宅的结界

 找回密码
 立即注册→加入我们

QQ登录

只需一步,快速开始

搜索
热搜: 下载 VB C 实现 编写
查看: 346|回复: 3
收起左侧

【VB】调用JDK源码中的红黑树实现高效插入删除查询

[复制链接]

6

主题

13

帖子

377

积分

用户组: 中·技术宅

UID
5181
精华
3
威望
38 点
宅币
216 个
贡献
57 次
宅之契约
0 份
在线时间
35 小时
注册时间
2019-7-25
发表于 2020-11-8 19:51:46 | 显示全部楼层 |阅读模式

欢迎访问技术宅的结界,请注册或者登录吧。

您需要 登录 才可以下载或查看,没有帐号?立即注册→加入我们

x
本帖最后由 天马座 于 2020-11-15 01:11 编辑

VB自带容器没有查找树并且字典也不是高效的实现,所以本人想给VB造个轮子
那么当然要选择红黑树了,因为红黑树实现比较复杂(本人抄代码都抄3小时,连复制再粘贴)
所以本人直接把JDK TreeMap源码移植到vb了,好处是JDK的实现相对来说比较可靠
红黑树的核心代码就是插入和删除,其他所有操作接口跟普通二叉搜索树完全一样
本人对vb编辑器不太熟悉,用它打字慢,所以直接用按键编辑器写成vbs版本了,大家简单修改一下就变成vb了
下面代码vb和vbs版本区别就是变量没有定义类型,还有就是Entry类中的成员名left,right vb无法定义得改名,用记事本批量替换一下就可以 其他一样,后续我有时间上网会同步更新完善

2020年11月13日更新完善了所有接口 并且添加VB6版本的代码生成器 在附件下载
全部写完之后测试效率有点低,原因是用类写的节点,Set语句会频繁COM的AddRef,QueryInterface,Release
如果想要高效的实现请改为数组版用6个数组模拟RBEntry 参考 https://www.0xaa55.com/thread-26178-1-1.html


[Visual Basic] 纯文本查看 复制代码
Class RBEntry
    Public key
    Public value
    Public parent
    Public leftChild
    Public rightChild
    Public color
End Class
Class KVPair
    Public key
    Public value
End Class
Class BasicCompare
    Public Function compare(ByVal a, ByVal b)
        If a < b Then
            compare = - 1
        ElseIf b < a Then
            compare = 1
        Else
            compare = 0
        End If
    End Function
End Class
Class BasicEqual
    Public Function equal(ByVal a, ByVal b)
        If a = b Then
            equal = true
        Else
            equal = false
        End If
    End Function
End Class
Class TreeMap
    Private RED, BLACK
    Private root
    Private size
    Private a
    Private keyCpr
    Private valueCpr
    Private Sub Class_Initialize()
        RED   = false
        BLACK = true
        Set root = Nothing
        Set keyCpr = New BasicCompare
        Set valueCpr = New BasicEqual
        size = 0
    End Sub
    Private Sub Class_Terminate()
        Call clear()
    End Sub
    Private Function newEntry(ByRef key, ByRef value, ByVal parent)
        Dim o
        Set o = New RBEntry
        Call setKey(o,key)
        Call setValue(o,value)
        Set o.parent = parent
        Set o.leftChild = Nothing
        Set o.rightChild = Nothing
        o.color = BLACK
        Set newEntry = o
    End Function
    Public Function clone()
        Dim o
        Set o = New TreeMap
        o.setKeyCompare keyCpr
	o.setValueCompare valueCpr
        Dim p
        Set p = getFirstEntry()
        Do While Not (p Is Nothing) 
            o.add p.key, p.value
            Set p = successor(p)
        Loop
        Set clone = o
    End Function
    Public Sub setKeyCompare(ByVal newCpr)
        If newCpr Is Nothing Then Exit Sub
        Set keyCpr = newCpr
        Call clear()
    End Sub
    Public Sub setValueCompare(ByVal newCpr)
        If newCpr Is Nothing Then Exit Sub
        Set valueCpr = newCpr
        Call clear()
    End Sub
    Public Property Get count()
    	count = size
    End Property
    Public Function isEmpty()
        isEmpty = (size = 0)
    End Function
    Public Function newEnum()
        If size = 0 Then
            newEnum = array()
            Exit Function
        End If
        ReDim a(size-1)
        Dim p
        Dim i
        i = 0
        Set p = getFirstEntry()
        Do While Not (p Is Nothing) 
            Set a(i) = New KVPair
            Call setKey(a(i), p.key)
            Call setValue(a(i), p.value)
            Set p=successor(p)
            i = i + 1
        Loop
        newEnum = a
        Erase a
    End Function
    Public Sub clear()
        Call unlink(root)
        Set root = Nothing
        size = 0
    End Sub
    Public Function getValue(ByVal key)    
    	Dim p
    	Set p = getEntry(key)
    	If p Is Nothing Then
        	Exit Function 
    	End If
    	If VarType(p.value) = vbObject Then 
            Set getValue = p.value
        Else 
            getValue = p.value
        End If
    End Function 
    Public Sub add(ByVal key, ByVal value)
        Dim t
        Set t = root
        If t Is Nothing Then
            Set root = newEntry(key, value, Nothing)
            size = 1
            Exit Sub
        End If
        Dim parent
        Dim cmp
        Do
            Set parent = t
            cmp = keyCpr.compare(key, t.key)
            If cmp < 0 Then
                Set t = t.leftChild
            ElseIf cmp > 0 Then
                Set t = t.rightChild
            Else
                Call setValue(t,value)
                Exit Sub
            End If
        Loop While Not(t Is Nothing) 
        Set e = newEntry(key, value, parent)
        If cmp < 0 Then
            Set parent.leftChild = e
        Else
            Set parent.rightChild = e
        End If
        Call fixAfterInsertion(e)
        size = size + 1
    End Sub
    Public Sub remove(ByVal key)
        Dim p
        Set p = getEntry(key)
        If p Is Nothing Then
            Exit Sub
        End If
        Call deleteEntry(p)
    End Sub
    Private Sub fixAfterInsertion(ByVal x)
        Dim y
        x.color = RED
        Do While Not (x Is Nothing)  And Not (x Is root) 
            If x.parent.color <> RED Then
                Exit Do
            End If
            If parentOf(x) Is leftChildOf(parentOf(parentOf(x))) Then
                Set y = rightChildOf(parentOf(parentOf(x)))
                If colorOf(y) = RED Then
                    Call setColor(parentOf(x), BLACK)
                    Call setColor(y, BLACK)
                    Call setColor(parentOf(parentOf(x)), RED)
                    Set x = parentOf(parentOf(x))
                Else
                    If x Is rightChildOf(parentOf(x)) Then
                        Set x = parentOf(x)
                        Call rotateLeft(x)
                    End If
                    Call setColor(parentOf(x), BLACK)
                    Call setColor(parentOf(parentOf(x)), RED)
                    Call rotateRight(parentOf(parentOf(x)))
                End If
            Else
                Set y = leftChildOf(parentOf(parentOf(x)))
                If colorOf(y) = RED Then
                    Call setColor(parentOf(x), BLACK)
                    Call setColor(y, BLACK)
                    Call setColor(parentOf(parentOf(x)), RED)
                    Set x = parentOf(parentOf(x))
                Else
                    If x Is leftChildOf(parentOf(x)) Then
                        Set x = parentOf(x)
                        Call rotateRight(x)
                    End If
                    Call setColor(parentOf(x), BLACK)
                    Call setColor(parentOf(parentOf(x)), RED)
                    Call rotateLeft(parentOf(parentOf(x)))
                End If
            End If
        Loop
        root.color = BLACK
    End Sub
    Private Sub deleteEntry(ByVal p)
        size = size - 1
        Dim replacement
        If Not (p.leftChild Is Nothing)  And Not (p.rightChild Is Nothing)  Then
            Dim s
            Set s = successor(p)
            Call setKey(p,s.key)
            Call setValue(p,s.value)
            Set p = s
        End If
        If Not (p.leftChild Is Nothing)  Then
            Set replacement = p.leftChild
        Else
            Set replacement = p.rightChild
        End If
        If Not (replacement Is Nothing)  Then
            Set replacement.parent = p.parent
            If p.parent Is Nothing Then
                Set root = replacement
            ElseIf p Is p.parent.leftChild Then
                Set p.parent.leftChild  = replacement
            Else
                Set p.parent.rightChild = replacement
            End If
            Set p.parent = Nothing
            Set p.rightChild = Nothing
            Set p.leftChild = Nothing
            If p.color = BLACK Then
                Call fixAfterDeletion(replacement)
            End If
        ElseIf p.parent Is Nothing Then
            Set root = Nothing
        Else
            If p.color = BLACK Then
                Call fixAfterDeletion(p)
            End If
            If Not (p.parent Is Nothing)  Then
                If p Is p.parent.leftChild Then
                    Set p.parent.leftChild = Nothing
                ElseIf p Is p.parent.rightChild Then
                    Set p.parent.rightChild = Nothing
                End If
                Set p.parent = Nothing
            End If
        End If
    End Sub
    Private Sub fixAfterDeletion(ByVal x)
        Dim sib
        Do While Not (x Is root)  And colorOf(x) = BLACK
            If x Is leftChildOf(parentOf(x)) Then
                Set sib = rightChildOf(parentOf(x))
                If colorOf(sib) = RED Then
                    Call setColor(sib, BLACK)
                    Call setColor(parentOf(x), RED)
                    Call rotateLeft(parentOf(x))
                    Set sib = rightChildOf(parentOf(x))
                End If
                If colorOf(leftChildOf(sib)) = BLACK And colorOf(rightChildOf(sib)) = BLACK Then
                    Call setColor(sib, RED)
                    Set x = parentOf(x)
                Else
                    If colorOf(rightChildOf(sib)) = BLACK Then
                        Call setColor(leftChildOf(sib), BLACK)
                        Call setColor(sib, RED)
                        Call rotateRight(sib)
                        Set sib = rightChildOf(parentOf(x))
                    End If
                    Call setColor(sib, colorOf(parentOf(x)))
                    Call setColor(parentOf(x), BLACK)
                    Call setColor(rightChildOf(sib), BLACK)
                    Call rotateLeft(parentOf(x))
                    Set x = root
                End If
            Else
                Set sib = leftChildOf(parentOf(x))
                If colorOf(sib) = RED Then
                    Call setColor(sib, BLACK)
                    Call setColor(parentOf(x), RED)
                    Call rotateRight(parentOf(x))
                    Set sib = leftChildOf(parentOf(x))
                End If
                If colorOf(rightChildOf(sib)) = BLACK And colorOf(leftChildOf(sib)) = BLACK Then
                    Call setColor(sib, RED)
                    Set x = parentOf(x)
                Else
                    If colorOf(leftChildOf(sib)) = BLACK Then
                        Call setColor(rightChildOf(sib), BLACK)
                        Call setColor(sib, RED)
                        Call rotateLeft(sib)
                        Set sib = leftChildOf(parentOf(x))
                    End If
                    Call setColor(sib, colorOf(parentOf(x)))
                    Call setColor(parentOf(x), BLACK)
                    Call setColor(leftChildOf(sib), BLACK)
                    Call rotateRight(parentOf(x))
                    Set x = root
                End If
            End If
        Loop
        Call setColor(x, BLACK)
    End Sub
    Private Sub rotateLeft(ByVal p)
        Dim r
        if Not (p Is Nothing) Then
            Set r = p.rightChild
            Set p.rightChild = r.leftChild
            If Not (r.leftChild Is Nothing)  Then
                Set r.leftChild.parent = p
            End If
            Set r.parent = p.parent
            If p.parent Is Nothing Then
                Set root = r
            ElseIf p.parent.leftChild Is p Then
                Set p.parent.leftChild = r
            Else
                Set p.parent.rightChild = r
            End If
            Set r.leftChild = p
            Set p.parent = r
        End If
    End Sub
    Private Sub rotateRight(ByVal p)
        Dim l
        If Not (p Is Nothing)  Then
            Set l = p.leftChild
            Set p.leftChild = l.rightChild
            If Not (l.rightChild Is Nothing)  Then
                Set l.rightChild.parent = p
            End If
            Set l.parent = p.parent
            If p.parent Is Nothing Then
                Set root = l
            ElseIf p.parent.rightChild Is p Then
                Set p.parent.rightChild = l
            Else
                Set p.parent.leftChild = l
            End If
            Set l.rightChild = p
            Set p.parent = l
        End If
    End Sub
    Private Sub setKey(ByVal p,ByRef key)
        If VarType(key) = vbObject Then 
            Set p.key = key
        Else 
            p.key = key
        End If
    End Sub
    Private Sub setValue(ByVal p,ByRef value)
        If VarType(value) = vbObject Then 
            Set p.value = value
        Else 
            p.value = value
        End If
    End Sub
    Private Sub setColor(ByVal p, ByVal c)
        If Not (p Is Nothing)  Then
            p.color = c 
        End If
    End Sub
    Private Function colorOf(ByVal p)
        If p Is Nothing Then
            colorOf = BLACK 
        Else
            colorOf = p.color
        End If
    End Function
    Private Function parentOf(ByVal p)
        If p Is Nothing Then
            Set parentOf = Nothing
        Else
            Set parentOf = p.parent
        End If
    End Function
    Private Function leftChildOf(ByVal p)
        If p Is Nothing Then
            Set leftChildOf = Nothing
        Else
            Set leftChildOf = p.leftChild
        End If
    End Function
    Private Function rightChildOf(ByVal p)
        If p Is Nothing Then
            Set rightChildOf = Nothing
        Else
            Set rightChildOf = p.rightChild
        End If
    End Function
    '二叉树操作函数
    Public Function containsKey(ByVal key)
        containsKey = Not (getEntry(key) Is Nothing)
    End Function
    Public Function containsValue(ByVal value)
        Dim p
        Set p = getFirstEntry()
        Do While Not (p Is Nothing) 
            If valueCpr.equal(value,p.value) Then
                containsValue = true
                Exit Function
            End If
            Set p = successor(p)
        Loop
        containsValue = false
    End Function
    Public Function firstKey()
        Dim p
        Set p = getFirstEntry()
        If p Is Nothing Then
            Exit Function
        End If
        If VarType(p.key) = vbObject Then 
            Set firstKey = p.key
        Else 
            firstKey = p.key
        End If
    End Function 
    Public Function lastKey()
        Dim p
        Set p = getLastEntry()
        If p Is Nothing Then
            Exit Function
        End If
        If VarType(p.key) = vbObject Then 
            Set lastKey = p.key
        Else 
            lastKey = p.key
        End If
    End Function
    Public Function higherKey(ByVal key)
        Dim p
        Set p = getHigherEntry(key)
        If p Is Nothing Then
            Exit Function
        End If
        If VarType(p.key) = vbObject Then 
            Set higherKey = p.key
        Else 
            higherKey = p.key
        End If
    End Function 
    Public Function lowerKey(ByVal key)
        Dim p
        Set p = getLowerEntry(key)
        If p Is Nothing Then
            Exit Function
        End If
        If VarType(p.key) = vbObject Then 
            Set lowerKey = p.key
        Else 
            lowerKey = p.key
        End If
    End Function
    Public Function ceilingKey(ByVal key)
        Dim p
        Set p = getCeilingEntry(key)
        If p Is Nothing Then
            Exit Function
        End If
        If VarType(p.key) = vbObject Then 
            Set ceilingKey = p.key
        Else 
            ceilingKey = p.key
        End If
    End Function
    Public Function floorKey(ByVal key)
        Dim p
        Set p = getFloorEntry(key)
        If p Is Nothing Then
            Exit Function
        End If
        If VarType(p.key) = vbObject Then 
            Set floorKey = p.key
        Else 
            floorKey = p.key
        End If
    End Function
    Public Function selectKey(ByVal index)
        Dim p
        Set p = selectEntry(index)
        If p Is Nothing Then
            Exit Function
        End If
        If VarType(p.key) = vbObject Then 
            Set selectKey = p.key
        Else 
            selectKey = p.key
        End If
    End Function
    Public Function indexOf(ByVal key)
        Dim p
        Dim i
        Set p = getFirstEntry()
        i = 0
        Do While not (p Is Nothing)
            If keyCpr.compare(key,p.key) = 0 Then
                indexOf = i
                Exit Function
            End If
            Set p = successor(p)
            i = i + 1
        Loop
        indexOf = - 1
    End Function
    Private Function getEntry(ByRef key)
        Dim p
        Dim cmp
        Set p = root
        Do While not (p Is Nothing)
            cmp = keyCpr.compare(key,p.key)
            If cmp < 0 Then
                Set p = p.leftChild
            ElseIf cmp > 0 Then
                Set p = p.rightChild
            Else
                Set getEntry = p
                Exit Function
            End If 
        Loop
        Set getEntry = Nothing
    End Function
    Private Function successor(ByVal t)
        Dim p, ch
        If t Is Nothing Then
            Set successor = Nothing
        ElseIf not (t.rightChild Is Nothing)  Then
            Set p = t.rightChild
            Do While not (p.leftChild Is Nothing) 
                Set p = p.leftChild
            Loop
            Set successor = p
        Else
            Set p = t.parent
            Set ch = t
            Do While not (p Is Nothing)
                If Not (ch Is p.rightChild) Then Exit do
                Set ch = p
                Set p = p.parent
            Loop
            Set successor = p
        End If
    End Function
    Private Function predecessor(ByVal t)
        Dim p, ch
        If t Is Nothing Then
            Set predecessor = Nothing
        ElseIf not (t.leftChild Is Nothing)  Then
            Set p = t.leftChild
            Do While not (p.rightChild Is Nothing) 
                Set p = p.rightChild
            Loop
            Set predecessor = p
        Else
            Set p = t.parent
            Set ch = t
            Do While not (p Is Nothing)
                If Not (ch Is p.leftChild) Then Exit do
                Set ch = p
                Set p = p.parent
            Loop
            Set predecessor = p
        End If
    End Function
    Private Function getFirstEntry()
        Dim p
        Set p = root
        If Not (p Is Nothing)  Then
            Do While Not (p.leftChild Is Nothing) 
                Set p = p.leftChild  
            Loop
        End If
        Set getFirstEntry = p
    End Function
    Private Function getLastEntry()
        Dim p
        Set p = root
        If Not (p Is Nothing)  Then
            Do While Not (p.rightChild Is Nothing) 
                Set p = p.rightChild 
            Loop
        End If
        Set getLastEntry = p
    End Function
    Private Function getHigherEntry(ByRef key)
        Dim cmp
        Dim p, parent, ch
        Set p = root
        Do While Not (p Is Nothing) 
            cmp = keyCpr.compare(key, p.key)
            If cmp < 0 Then
                If Not (p.leftChild Is Nothing)  Then
                    Set p = p.leftChild
                Else
                    Set getHigherEntry = p
                    Exit Function
                End If
            Else
                If Not (p.rightChild Is Nothing)  Then
                    Set p = p.rightChild
                Else
                    Set parent = p.parent
                    Set ch = p
                    Do While Not (parent Is Nothing) 
                        If Not (ch Is parent.rightChild) Then Exit Do
                        Set ch = parent
                        Set parent = parent.parent
                    Loop
                    Set getHigherEntry = parent
                    Exit Function
                End If
            End If
        Loop
        Set getHigherEntry = Nothing
    End Function
    Private Function getLowerEntry(ByRef key)
        Dim cmp
        Dim p, parent, ch
        Set p = root
        Do While Not (p Is Nothing)
            cmp = keyCpr.compare(key, p.key)
            If cmp > 0 Then
                If Not (p.rightChild Is Nothing)  Then
                    Set p = p.rightChild
                Else
                    Set getLowerEntry = p
                    Exit Function
                End If
            Else
                If Not (p.leftChild  Is Nothing)  Then
                    Set p = p.leftChild 
                Else
                    Set parent = p.parent
                    Set ch = p
                    Do While Not (parent Is Nothing) 
                        If Not (ch Is parent.leftChild) Then Exit Do
                        Set ch = parent
                        Set parent = parent.parent
                    Loop
                    Set getLowerEntry = parent
                    Exit Function
                End If
            End If
        Loop
        Set getLowerEntry = Nothing
    End Function
    Private Function getCeilingEntry(ByRef key)
        Dim cmp
        Dim p, parent, ch
        Set p = root
        Do While Not (p Is Nothing)
            cmp = keyCpr.compare(key, p.key)
            If cmp < 0 Then
                If not (p.leftChild Is Nothing)  Then
                    Set p = p.leftChild
                Else
                    Set getCeilingEntry = p
                    Exit Function
                End If
            ElseIf cmp > 0 Then
                If not (p.rightChild Is Nothing)  Then
                    Set p = p.rightChild
                Else
                    Set parent = p.parent
                    Set ch = p
                    Do While Not (parent Is Nothing) 
                        If Not (ch Is parent.rightChild) Then Exit Do
                        Set ch = parent
                        Set parent = parent.parent
                    Loop
                    Set getCeilingEntry = parent
                    Exit Function
                End If
            Else
                Set getCeilingEntry = p
                Exit Function
            End If
        Loop
        Set getCeilingEntry = Nothing
    End Function
    Private Function getFloorEntry(ByRef key)
        Dim cmp
        Dim p, parent, ch
        Set p = root
        Do While Not (p Is Nothing)
            cmp = keyCpr.compare(key, p.key)
            If cmp > 0 Then
                If not (p.rightChild  Is Nothing)  Then
                    Set p = p.rightChild 
                Else
                    Set getFloorEntry = p
                    Exit Function
                End If
            ElseIf cmp < 0 Then
                If not (p.leftChild Is Nothing)  Then
                    Set p = p.leftChild
                Else
                    Set parent = p.parent
                    Set ch = p
                    Do While Not (parent Is Nothing) 
                        If Not (ch Is parent.leftChild) Then Exit Do
                        Set ch = parent
                        Set parent = parent.parent
                    Loop
                    Set getFloorEntry = parent
                    Exit Function
                End If
            Else
                Set getFloorEntry = p
                Exit Function
            End If
        Loop
        Set getFloorEntry = Nothing
    End Function
    Private Function selectEntry(ByVal index)
        If index < 0 or index >= size Then
            Set selectEntry = Nothing
            Exit Function
        End If
        Dim p
        dim i
        If index < size \ 2 Then
            i = 0
            Set p = getFirstEntry()
            Do While Not (p Is Nothing)
                If i = index Then
                    Set selectEntry = p
                    Exit Function
                End If
                Set p = successor(p)
                i = i + 1
            Loop
            Set selectEntry = Nothing
        Else
            i = size - 1
            Set p = getLastEntry()
            Do While Not (p Is Nothing)
                If i = index Then
                    Set selectEntry = p
                    Exit Function
                End If
                Set p = predecessor(p)
                i = i - 1
            Loop
            Set selectEntry = Nothing
        End If
    End Function
    Private Sub unlink(ByVal p)
        If p Is Nothing Then
            Exit Sub
        End If
        Call unlink(p.leftChild)
        Call unlink(p.rightChild)
        Set p.parent = Nothing
    End Sub
End Class

'测试
Set o = New TreeMap'创建一个红黑树
'o.setKeyCompare keyCpr 设置key比较器 这里注释掉 使用默认比较器
'o.setValueCompare valueEQ 设置value比较器 这里注释掉 使用默认比较器
For i = 10 To 0 Step - 1 '插入11个键值对 key value
    o.add i, i
Next
key = 5
value = 5
i = 5
WScript.Echo o.isEmpty'判断树是否为空
WScript.Echo o.count'获取键值对数量
WScript.Echo o.containsKey(key)'判断key是否存在
WScript.Echo o.containsValue(value)'判断key是否存在
WScript.Echo o.getValue(key)'key对应的value
WScript.Echo o.higherKey(key)'刚好大于key的key
WScript.Echo o.lowerKey(key)'刚好小于key的key
WScript.Echo o.ceilingKey(key)'刚好大于等于key的key
WScript.Echo o.floorKey(key)'刚好小于等于key的key
WScript.Echo o.indexOf(key)'key的排名
WScript.Echo o.selectKey(i)'排名i对应的key
WScript.Echo o.firstKey '最小的key
WScript.Echo o.lastKey '最大的key
o.remove 6'删除key
For Each x In o.newEnum'顺序遍历
    WScript.Echo x.key & "=" & x.value
Next
o.clear '清空树
WScript.Echo o.isEmpty'判断树是否为空
Set oo = o.clone'克隆该对象

TreeMapVB6代码生成器.rar

10.09 KB, 下载次数: 6

评分

参与人数 1威望 +5 宅币 +10 贡献 +5 收起 理由
0xAA55 + 5 + 10 + 5 干货

查看全部评分

本帖被以下淘专辑推荐:

回复

使用道具 举报

1072

主题

2492

帖子

6万

积分

用户组: 管理员

一只技术宅

UID
1
精华
223
威望
420 点
宅币
20164 个
贡献
41913 次
宅之契约
0 份
在线时间
1908 小时
注册时间
2014-1-26
发表于 2020-11-8 20:46:40 | 显示全部楼层
这种要是改,会改成VB.NET比较合适

4

主题

79

帖子

1197

积分

用户组: 上·技术宅

UID
4293
精华
4
威望
12 点
宅币
841 个
贡献
233 次
宅之契约
0 份
在线时间
86 小时
注册时间
2018-9-19
发表于 2020-11-9 09:50:50 | 显示全部楼层
原来是VBS哦,不错不错,但是有个很严重的问题,那就是VBS是基于COM的计数引用机制,对象之间循环会导致无法被释放BUG。
改成VB.NET的话肯定不错,.NET是GC引用机制可以避免这个问题,至于Left和Right被关键字占用的问题,VB.NET可以用方括号解决:Public [Left] As XXX, [Right] As XXX。

6

主题

13

帖子

377

积分

用户组: 中·技术宅

UID
5181
精华
3
威望
38 点
宅币
216 个
贡献
57 次
宅之契约
0 份
在线时间
35 小时
注册时间
2019-7-25
 楼主| 发表于 2020-11-9 10:40:05 | 显示全部楼层
系统消息 发表于 2020-11-9 09:50
原来是VBS哦,不错不错,但是有个很严重的问题,那就是VBS是基于COM的计数引用机制,对象之间循环会导致无 ...

可以释放,删除节点x 删除后x的引用计数为0,清空所有节点,需要写一个递归函数就可以

本版积分规则

QQ|申请友链||Archiver|手机版|小黑屋|技术宅的结界 ( 滇ICP备16008837号 )|网站地图  

GMT+8, 2020-11-28 03:43 , Processed in 0.108580 second(s), 36 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表