module1.bas

二叉树的遍历、线索化、遍历线索化二叉树等算法；深度搜索优先、广度搜索优先算法

Attribute VB_Name = "Module1"
Public Enum NodeType
    eNormalProject
    eVertexData
    eArcData
End Enum

Type Vertex
    vID As Integer
    sVerName As String
    fPosX As Single
    fPosY As Single
    iFlag As Integer
End Type

Type ArcTable
    iStartNode As Integer
    iEndNode As Integer
    iLink As Integer
End Type
Public sServer As String
Public cn As New Connection
Public RS As New ADODB.Recordset
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public sUserName As String
Public SelNodeID As String
Public Const R = 100
Public MyVer() As Vertex
Public MyArc() As ArcTable
Public iVertexNum As Integer
Public iArcNum As Integer
Public sCurNode As String
Public sCurPNode As String
Public iProjectType As NodeType
Function ConnectDataBase(ByVal sUserName As String, ByVal sPassword As String, ByVal sServer As String, ByVal sDBName As String) As Integer
    On Error GoTo errp:
    cn.ConnectionTimeout = 50                                       ' 访问数据库不得超过20毫秒
    cn.Provider = "sqloledb"                                        ' 使用 OLE DB 属性
    cn.Properties("Data Source").Value = sServer                    ' 设置 SQLOLEDB 连接属性
    cn.Properties("Initial Catalog").Value = sDBName                ' 设置 SQLOLEDB 连接属性
    cn.Properties("Integrated Security").Value = "SSPI"             ' 设置 SQLOLEDB 连接属性
    cn.Open
    ConnectDataBase = 0
    Exit Function
errp:
    ConnectDataBase = -1
End Function
Function rsLen(ByVal RS As ADODB.Recordset) As Long
Dim n As Long
n = 0
If RS.EOF And RS.BOF Then
    n = 0
Else
    While Not RS.EOF
        n = n + 1
        RS.MoveNext
    Wend
    RS.MoveFirst
End If
rsLen = n
End Function
Function sInsertRec(ByVal sSql As String) As String
On Error GoTo erp
sInsertRec = ""
cn.BeginTrans
cn.Execute sSql
sql_s = "SELECT @@IDENTITY AS 'Id'"
Set RS = cn.Execute(sql_s)
sInsertRec = Trim(LTrim(Str$(RS("ID").Value)))
RS.Close
cn.CommitTrans
Exit Function
erp:
    sInsertRec = ""
    If RS.State <> 0 Then
        RS.Close
        cn.CommitTrans
    End If
    Err.Clear
End Function