Author：水如烟
正式代码 示例代码
关于数据实体类的定义：
注意使用Serializable修饰，那是复制和存储数据文件所必需的。
属性值不要使用数组。
保留New()构造函数。
形式已限定为属性类型。
例如菜单项信息，可以定样定义：
<Serializable()> _
Public Class MenuItem
Inherits LzmTW.uSystem.uCollection.SinceLink.SinceLinkItemBase(Of Integer)
Private gText As String
Private gToolTipText As String
Private gShortcut As Integer
Private gClickAction As String
Private gVisible As Boolean
Private gEnabled As Boolean
Public Property Text() As String
Get
Return gText
End Get
Set(ByVal value As String)
gText = value
End Set
End Property
Public Property ToolTipText() As String
Get
Return gToolTipText
End Get
Set(ByVal value As String)
gToolTipText = value
End Set
End Property
Public Property Shortcut() As Integer
Get
Return gShortcut
End Get
Set(ByVal value As Integer)
gShortcut = value
End Set
End Property
Public Property ClickAction() As String
Get
Return gClickAction
End Get
Set(ByVal value As String)
gClickAction = value
End Set
End Property
Public Property Visible() As Boolean
Get
Return gVisible
End Get
Set(ByVal value As Boolean)
gVisible = value
End Set
End Property
Public Property Enabled() As Boolean
Get
Return gEnabled
End Get
Set(ByVal value As Boolean)
gEnabled = value
End Set
End Property
End Class
以下为树和自联表（正式叫法应该是关联表吧）部分的全部代码。它现在可以处理树、(Code,Name)、自联表三种情形的数据。
在后面一篇中，将分别对这三种情形给出示例代码。
如果代码需要修改补充，我也将在此文中进行更新。
如果您使用了这个类，有什么建议，敬请在此回贴指出。
辅助类：
Namespace LzmTW.uSystem.uReflection
Public Class CommonFunction
Private Sub New()
End Sub
Public Shared Function TypeHasFields(ByVal t As Type) As Boolean
Return t.GetFields.Length > 0
End Function
Public Shared Function TypeHasMember(ByVal t As Type, ByVal memberName As String) As Boolean
Return t.GetMember(memberName) IsNot Nothing
End Function
Public Shared Function CreateTableFromType(ByVal t As Type) As DataTable
Dim tmpTable As New DataTable
If TypeHasFields(t) Then
For Each f As Reflection.FieldInfo In t.GetFields
tmpTable.Columns.Add(f.Name, f.FieldType)
Next
Else
For Each p As Reflection.PropertyInfo In t.GetProperties
If p.CanRead Then tmpTable.Columns.Add(p.Name, p.PropertyType)
Next
End If
Return tmpTable
End Function
Public Shared Function ItemToDataRow(Of T)(ByVal item As T, ByVal table As DataTable) As DataRow
Dim tmpRow As DataRow = table.NewRow
Dim mName As String
Dim mType As Type = GetType(T)
For Each c As DataColumn In table.Columns
mName = c.ColumnName
If TypeHasFields(mType) Then
tmpRow(mName) = mType.GetField(mName).GetValue(item)
Else
tmpRow(mName) = mType.GetProperty(mName).GetValue(item, Nothing)
End If
Next
Return tmpRow
End Function
Public Shared Sub ItemAppendToTable(Of T)(ByVal item As T, ByVal table As DataTable)
table.Rows.Add(ItemToDataRow(Of T)(item, table))
End Sub
Public Shared Sub ItemAppendToTable(Of T)(ByVal items() As T, ByVal table As DataTable)
For Each item As T In items
ItemAppendToTable(Of T)(item, table)
Next
End Sub
Public Shared Function ItemsToTable(Of T)(ByVal items() As T) As DataTable
Dim mTable As DataTable = CreateTableFromType(GetType(T))
If items Is Nothing Then Return mTable
ItemAppendToTable(Of T)(items, mTable)
Return mTable
End Function
End Class
End Namespace
Public Class CommonFunction
Private Sub New()
End Sub
Public Shared Function TypeHasFields(ByVal t As Type) As Boolean
Return t.GetFields.Length > 0
End Function
Public Shared Function TypeHasMember(ByVal t As Type, ByVal memberName As String) As Boolean
Return t.GetMember(memberName) IsNot Nothing
End Function
Public Shared Function CreateTableFromType(ByVal t As Type) As DataTable
Dim tmpTable As New DataTable
If TypeHasFields(t) Then
For Each f As Reflection.FieldInfo In t.GetFields
tmpTable.Columns.Add(f.Name, f.FieldType)
Next
Else
For Each p As Reflection.PropertyInfo In t.GetProperties
If p.CanRead Then tmpTable.Columns.Add(p.Name, p.PropertyType)
Next
End If
Return tmpTable
End Function
Public Shared Function ItemToDataRow(Of T)(ByVal item As T, ByVal table As DataTable) As DataRow
Dim tmpRow As DataRow = table.NewRow
Dim mName As String
Dim mType As Type = GetType(T)
For Each c As DataColumn In table.Columns
mName = c.ColumnName
If TypeHasFields(mType) Then
tmpRow(mName) = mType.GetField(mName).GetValue(item)
Else
tmpRow(mName) = mType.GetProperty(mName).GetValue(item, Nothing)
End If
Next
Return tmpRow
End Function
Public Shared Sub ItemAppendToTable(Of T)(ByVal item As T, ByVal table As DataTable)
table.Rows.Add(ItemToDataRow(Of T)(item, table))
End Sub
Public Shared Sub ItemAppendToTable(Of T)(ByVal items() As T, ByVal table As DataTable)
For Each item As T In items
ItemAppendToTable(Of T)(item, table)
Next
End Sub
Public Shared Function ItemsToTable(Of T)(ByVal items() As T) As DataTable
Dim mTable As DataTable = CreateTableFromType(GetType(T))
If items Is Nothing Then Return mTable
ItemAppendToTable(Of T)(items, mTable)
Return mTable
End Function
End Class
End Namespace
Namespace LzmTW.uSystem.uRuntime.uSerialization
Public Class SerializeHelper
Private Sub New()
End Sub
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
Public Shared Function ItemToXml(Of T)(ByVal obj As T) As String
Dim mResult As String = ""
Dim mSerializer As New System.Xml.Serialization.XmlSerializer(GetType(T))
Dim mStringWriter As New System.IO.StringWriter
Using mStringWriter
mSerializer.Serialize(mStringWriter, obj)
mResult = mStringWriter.ToString
mStringWriter.Close()
End Using
Return mResult
End Function
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
Public Shared Function XmlToItem(Of T)(ByVal xml As String) As T
Dim mSerializer As New System.Xml.Serialization.XmlSerializer(GetType(T))
Dim mStringReader As New System.IO.StringReader(xml)
Return CType(mSerializer.Deserialize(mStringReader), T)
End Function
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
Public Shared Sub ItemToXmlFile(Of T)(ByVal filename As String, ByVal obj As T)
Dim XmlWriter As New System.IO.StreamWriter(filename, False, System.Text.Encoding.Default)
Using XmlWriter
XmlWriter.Write(ItemToXml(obj))
XmlWriter.Close()
End Using
End Sub
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
Public Shared Function XmlFileToItem(Of T)(ByVal filename As String) As T
Dim XmlReader As New System.IO.StreamReader(filename, System.Text.Encoding.Default)
Dim mObj As T
Using XmlReader
mObj = XmlToItem(Of T)(XmlReader.ReadToEnd)
XmlReader.Close()
End Using
Return mObj
End Function
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
Public Shared Sub ItemToFormatterFile(Of T)(ByVal filename As String, ByVal formatter As System.Runtime.Serialization.IFormatter, ByVal obj As T)
Dim mFileStream As System.IO.Stream = System.IO.File.Open(filename, System.IO.FileMode.Create)
Using mFileStream
formatter.Serialize(mFileStream, obj)
mFileStream.Close()
End Using
End Sub
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
Public Shared Function FormatterFileToItem(Of T)(ByVal FileName As String, ByVal formatter As System.Runtime.Serialization.IFormatter) As T
Dim mFileStream As System.IO.Stream = System.IO.File.Open(FileName, System.IO.FileMode.Open)
Dim mObj As T
Using mFileStream
mObj = CType(formatter.Deserialize(mFileStream), T)
mFileStream.Close()
End Using
Return mObj
End Function
Public Shared Function Clone(Of T)(ByVal obj As T) As T
Dim tmpT As T
Dim mFormatter As New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
Dim mMemoryStream As New System.IO.MemoryStream
Using mMemoryStream
mFormatter.Serialize(mMemoryStream, obj)
mMemoryStream.Position = 0
tmpT = CType(mFormatter.Deserialize(mMemoryStream), T)
mMemoryStream.Close()
End Using
Return tmpT
End Function
Public Shared Sub Save(Of T)(ByVal filename As String, ByVal formattype As FormatType, ByVal obj As T)
SyncLock InternalSyncObject
Select Case formattype
Case formattype.Binary
ItemToFormatterFile(filename, New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter, obj)
Case formattype.Soap
ItemToFormatterFile(filename, New System.Runtime.Serialization.Formatters.Soap.SoapFormatter, obj)
Case formattype.Xml
ItemToXmlFile(filename, obj)
End Select
End SyncLock
End Sub
Public Shared Function Load(Of T)(ByVal filename As String, ByVal formattype As FormatType) As T
SyncLock InternalSyncObject
Select Case formattype
Case formattype.Binary
Return FormatterFileToItem(Of T)(filename, New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter)
Case formattype.Soap
Return FormatterFileToItem(Of T)(filename, New System.Runtime.Serialization.Formatters.Soap.SoapFormatter)
Case formattype.Xml
Return XmlFileToItem(Of T)(filename)
End Select
End SyncLock
End Function
Private Shared ReadOnly Property InternalSyncObject() As Object
Get
If gInternalSyncObject Is Nothing Then
Dim tmpObj As New Object
System.Threading.Interlocked.CompareExchange(gInternalSyncObject, tmpObj, Nothing)
End If
Return gInternalSyncObject
End Get
End Property
Private Shared gInternalSyncObject As Object
End Class
Public Enum FormatType
Xml
Binary
Soap
End Enum
End Namespace
Public Class SerializeHelper
Private Sub New()
End Sub
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
Public Shared Function ItemToXml(Of T)(ByVal obj As T) As String
Dim mResult As String = ""
Dim mSerializer As New System.Xml.Serialization.XmlSerializer(GetType(T))
Dim mStringWriter As New System.IO.StringWriter
Using mStringWriter
mSerializer.Serialize(mStringWriter, obj)
mResult = mStringWriter.ToString
mStringWriter.Close()
End Using
Return mResult
End Function
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
Public Shared Function XmlToItem(Of T)(ByVal xml As String) As T
Dim mSerializer As New System.Xml.Serialization.XmlSerializer(GetType(T))
Dim mStringReader As New System.IO.StringReader(xml)
Return CType(mSerializer.Deserialize(mStringReader), T)
End Function
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
Public Shared Sub ItemToXmlFile(Of T)(ByVal filename As String, ByVal obj As T)
Dim XmlWriter As New System.IO.StreamWriter(filename, False, System.Text.Encoding.Default)
Using XmlWriter
XmlWriter.Write(ItemToXml(obj))
XmlWriter.Close()
End Using
End Sub
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
Public Shared Function XmlFileToItem(Of T)(ByVal filename As String) As T
Dim XmlReader As New System.IO.StreamReader(filename, System.Text.Encoding.Default)
Dim mObj As T
Using XmlReader
mObj = XmlToItem(Of T)(XmlReader.ReadToEnd)
XmlReader.Close()
End Using
Return mObj
End Function
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
Public Shared Sub ItemToFormatterFile(Of T)(ByVal filename As String, ByVal formatter As System.Runtime.Serialization.IFormatter, ByVal obj As T)
Dim mFileStream As System.IO.Stream = System.IO.File.Open(filename, System.IO.FileMode.Create)
Using mFileStream
formatter.Serialize(mFileStream, obj)
mFileStream.Close()
End Using
End Sub
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
Public Shared Function FormatterFileToItem(Of T)(ByVal FileName As String, ByVal formatter As System.Runtime.Serialization.IFormatter) As T
Dim mFileStream As System.IO.Stream = System.IO.File.Open(FileName, System.IO.FileMode.Open)
Dim mObj As T
Using mFileStream
mObj = CType(formatter.Deserialize(mFileStream), T)
mFileStream.Close()
End Using
Return mObj
End Function
Public Shared Function Clone(Of T)(ByVal obj As T) As T
Dim tmpT As T
Dim mFormatter As New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
Dim mMemoryStream As New System.IO.MemoryStream
Using mMemoryStream
mFormatter.Serialize(mMemoryStream, obj)
mMemoryStream.Position = 0
tmpT = CType(mFormatter.Deserialize(mMemoryStream), T)
mMemoryStream.Close()
End Using
Return tmpT
End Function
Public Shared Sub Save(Of T)(ByVal filename As String, ByVal formattype As FormatType, ByVal obj As T)
SyncLock InternalSyncObject
Select Case formattype
Case formattype.Binary
ItemToFormatterFile(filename, New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter, obj)
Case formattype.Soap
ItemToFormatterFile(filename, New System.Runtime.Serialization.Formatters.Soap.SoapFormatter, obj)
Case formattype.Xml
ItemToXmlFile(filename, obj)
End Select
End SyncLock
End Sub
Public Shared Function Load(Of T)(ByVal filename As String, ByVal formattype As FormatType) As T
SyncLock InternalSyncObject
Select Case formattype
Case formattype.Binary
Return FormatterFileToItem(Of T)(filename, New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter)
Case formattype.Soap
Return FormatterFileToItem(Of T)(filename, New System.Runtime.Serialization.Formatters.Soap.SoapFormatter)
Case formattype.Xml
Return XmlFileToItem(Of T)(filename)
End Select
End SyncLock
End Function
Private Shared ReadOnly Property InternalSyncObject() As Object
Get
If gInternalSyncObject Is Nothing Then
Dim tmpObj As New Object
System.Threading.Interlocked.CompareExchange(gInternalSyncObject, tmpObj, Nothing)
End If
Return gInternalSyncObject
End Get
End Property
Private Shared gInternalSyncObject As Object
End Class
Public Enum FormatType
Xml
Binary
Soap
End Enum
End Namespace
树类：
Namespace LzmTW.uSystem.uCollection
''' <summary>
''' 树节点
''' </summary>
''' <remarks>LzmTW 20061111</remarks>
<Serializable()> _
Public Class Node(Of T)
Friend gIsRoot As Boolean = True
Friend gParent As Node(Of T)
''' <summary>
''' 当前节点的父节点
''' </summary>
Public ReadOnly Property Parent() As Node(Of T)
Get
If Me.IsRoot Then
Return Nothing
End If
Return gParent
End Get
End Property
''' <summary>
''' 树的深度
''' </summary>
Public ReadOnly Property Level() As Integer
Get
If Me.IsRoot Then
Return 0
End If
Return Me.Parent.Level + 1
End Get
End Property
''' <summary>
''' 当前节点是否是根节点
''' </summary>
Public ReadOnly Property IsRoot() As Boolean
Get
Return gIsRoot
End Get
End Property
Private gUserData As Object
''' <summary>
''' 获取或设置包含树节点有关数据的对象
''' </summary>
Public Property Tag() As Object
Get
Return gUserData
End Get
Set(ByVal value As Object)
gUserData = value
End Set
End Property
Private gItem As T
Public Property Item() As T
Get
Return gItem
End Get
Set(ByVal value As T)
gItem = value
End Set
End Property
Friend gChildren As NodeCollection(Of T)
''' <summary>
''' 获取第一个子树节点
''' </summary>
Public ReadOnly Property FirstNode() As Node(Of T)
Get
If gChildren.Count = 0 Then
Return Nothing
End If
Return gChildren(0)
End Get
End Property
''' <summary>
''' 获取最后一个子树节点
''' </summary>
Public ReadOnly Property LastNode() As Node(Of T)
Get
If gChildren.Count = 0 Then
Return Nothing
End If
Return gChildren(gChildren.Count - 1)
End Get
End Property
Private gNodes As NodeCollection(Of T)
''' <summary>
''' 当前节点的节点集合
''' </summary>
Public ReadOnly Property Nodes() As NodeCollection(Of T)
Get
Return gNodes
End Get
End Property
''' <summary>
''' 当前节点在节点集合中的位置
''' </summary>
Public ReadOnly Property Index() As Integer
Get
Return GetIndex()
End Get
End Property
Private Function GetIndex() As Integer
If Me.IsRoot Then
Return 0
End If
Return Me.Parent.Nodes.IndexOf(Me)
End Function
''' <summary>
''' 获取下一个同级树节点
''' </summary>
Public ReadOnly Property NextNode() As Node(Of T)
Get
If Me.IsRoot OrElse Me.Index + 1 > Me.Parent.Nodes.Count Then
Return Nothing
End If
Return Me.Parent.Nodes.Item(Me.Index + 1)
End Get
End Property
''' <summary>
''' 获取上一个同级树节点
''' </summary>
Public ReadOnly Property PrevNode() As Node(Of T)
Get
If Me.IsRoot OrElse Me.Index - 1 < 0 Then
Return Nothing
End If
Return Me.Parent.Nodes.Item(Me.Index - 1)
End Get
End Property
Private Sub Initialzie()
gNodes = New NodeCollection(Of T)(Me)
gChildren = New NodeCollection(Of T)(Me)
gByProperty = Not uSystem.uReflection.CommonFunction.TypeHasFields(GetType(T))
End Sub
Sub New()
Initialzie()
End Sub
Sub New(ByVal item As T)
gItem = item
Initialzie()
End Sub
Public Function GetNodeCount(ByVal includeSubNodes As Boolean) As Integer
Dim mCount As Integer = gChildren.Count
If includeSubNodes Then
Dim mIndex As Integer = 0
Do While mIndex < gChildren.Count
mCount += gChildren(mIndex).GetNodeCount(True)
mIndex += 1
Loop
End If
Return mCount
End Function
Public Sub Remove()
If Me.IsRoot Then
Throw New Exception("不能移除根节点")
End If
Me.Parent.Nodes.RemoveAt(Me.Index)
End Sub
Private gTable As DataTable
Private gByProperty As Boolean
''' <summary>
''' 将当前节点树转换为表
''' </summary>
''' <param name="includeSubNodes">是否包括子节点的T对象</param>
Public Function ConvertToDataTable(ByVal includeSubNodes As Boolean) As DataTable
gTable = uSystem.uReflection.CommonFunction.CreateTableFromType(GetType(T))
If gTable.Columns.Count = 0 Then
If gByProperty Then
Throw New Exception("对象无属性列")
Else
Throw New Exception("对象无字段列")
End If
End If
Me.ForEach(New Action(Of T)(AddressOf GetDataTableDatasAction), includeSubNodes)
gTable.AcceptChanges()
Return gTable
End Function
Private Sub GetDataTableDatasAction(ByVal item As T)
uSystem.uReflection.CommonFunction.ItemAppendToTable(Of T)(item, gTable)
End Sub
''' <summary>
''' 将当前节点树转换为TreeNode
''' </summary>
''' <param name="NameOfTreeNodeText">TreeNode的Text值对应的T对象属性名或字段名</param>
''' <param name="includeSubNodes">是否包括子节点</param>
''' <remarks>TreeNode的Tag存T对象值</remarks>
Public Function ConvertToTreeNode(ByVal nameOfTreeNodeText As String, ByVal includeSubNodes As Boolean) As Windows.Forms.TreeNode
CheckValid(gByProperty, nameOfTreeNodeText)
Dim mTreeNode As System.Windows.Forms.TreeNode = ConvertToTreeNode(Me, gByProperty, nameOfTreeNodeText)
If includeSubNodes Then AppendTreeNode(mTreeNode, Me, gByProperty, nameOfTreeNodeText)
Return mTreeNode
End Function
Private Shared Sub AppendTreeNode(ByVal treeNode As Windows.Forms.TreeNode, ByVal node As Node(Of T), ByVal byProperty As Boolean, ByVal nameOfTreeNodeText As String)
For Each n As Node(Of T) In node.gChildren
Dim mCurrentTreeNode As Windows.Forms.TreeNode = ConvertToTreeNode(n, byProperty, nameOfTreeNodeText)
treeNode.Nodes.Add(mCurrentTreeNode)
AppendTreeNode(mCurrentTreeNode, n, byProperty, nameOfTreeNodeText)
Next
End Sub
Private Shared Function ConvertToTreeNode(ByVal node As Node(Of T), ByVal byProperty As Boolean, ByVal nameOfTreeNodeText As String) As System.Windows.Forms.TreeNode
Dim mTextValue As Object
If byProperty Then
mTextValue = GetType(T).GetProperty(nameOfTreeNodeText).GetValue(node.Item, Nothing)
Else
mTextValue = GetType(T).GetField(nameOfTreeNodeText).GetValue(node.Item)
End If
If mTextValue Is Nothing Then
mTextValue = "Root"
End If
Dim mTreeNode As New System.Windows.Forms.TreeNode(mTextValue.ToString)
mTreeNode.Tag = node.Item
Return mTreeNode
End Function
Private Sub CheckValid(ByVal byProperty As Boolean, ByVal nameOfTreeNodeText As String)
If byProperty Then
Dim mPropertyInfo As System.Reflection.PropertyInfo = GetType(T).GetProperty(nameOfTreeNodeText)
If mPropertyInfo Is Nothing Then
Throw New Exception("属性名无效")
If Not mPropertyInfo.CanRead Then
Throw New Exception("属性名不可读")
End If
End If
Else
Dim mFieldInfo As System.Reflection.FieldInfo = GetType(T).GetField(nameOfTreeNodeText)
If mFieldInfo Is Nothing Then
Throw New Exception("字段名无效")
End If
End If
End Sub
''' <summary>
''' 对每个节点执行指定操作
''' </summary>
''' <param name="action">对指定的对象执行操作的方法</param>
''' <param name="includeSubNodes">是否包括子节点</param>
Public Sub ForEach(ByVal action As Action(Of Node(Of T)), ByVal includeSubNodes As Boolean)
Node(Of T).ForEach(Me, action, includeSubNodes)
End Sub
Public Shared Sub ForEach(ByVal node As Node(Of T), ByVal action As Action(Of Node(Of T)), ByVal includeSubNodes As Boolean)
For Each n As Node(Of T) In node.gChildren
action.Invoke(n)
If includeSubNodes Then ForEach(n, action, True)
Next
End Sub
''' <summary>
''' 对每个T对象执行指定操作
''' </summary>
''' <param name="action">对指定的对象执行操作的方法</param>
''' <param name="includeSubNodes">是否包括子节点的T对象</param>
Public Sub ForEach(ByVal action As Action(Of T), ByVal includeSubNodes As Boolean)
Node(Of T).ForEach(Me, action, includeSubNodes)
End Sub
Public Shared Sub ForEach(ByVal node As Node(Of T), ByVal action As Action(Of T), ByVal includeSubNodes As Boolean)
For Each n As Node(Of T) In node.gChildren
action.Invoke(n.Item)
If includeSubNodes Then ForEach(n, action, True)
Next
End Sub
Public Function FindFirstNode(ByVal memberName As String, ByVal value As Object) As Node(Of T)
Dim mType As Type = GetType(T)
If Not uSystem.uReflection.CommonFunction.TypeHasMember(mType, memberName) Then
Throw New Exception(String.Format("无此成员名 :{0}", memberName))
End If
If gByProperty Then
If Not mType.GetProperty(memberName).CanRead Then
Throw New Exception(String.Format("成员名不可读 :{0}", memberName))
End If
End If
Dim mResult As Node(Of T) = Nothing
FindFirstNode(mType, memberName, value, Me, mResult)
Return mResult
End Function
Private Sub FindFirstNode(ByVal t As Type, ByVal memberName As String, ByVal Value As Object, ByVal node As Node(Of T), ByRef result As Node(Of T))
For Each n As Node(Of T) In node.gChildren
If gByProperty Then
If t.GetProperty(memberName).GetValue(n.Item, Nothing).Equals(Value) Then
result = n
Exit Sub
End If
Else
If t.GetField(memberName).GetValue(n.Item).Equals(Value) Then
result = n
Exit Sub
End If
End If
FindFirstNode(t, memberName, Value, n, result)
Next
End Sub
Public Function Clone() As Node(Of T)
Return uSystem.uRuntime.uSerialization.SerializeHelper.Clone(Of Node(Of T))(Me)
End Function
End Class
End Namespace
''' <summary>
''' 树节点
''' </summary>
''' <remarks>LzmTW 20061111</remarks>
<Serializable()> _
Public Class Node(Of T)
Friend gIsRoot As Boolean = True
Friend gParent As Node(Of T)
''' <summary>
''' 当前节点的父节点
''' </summary>
Public ReadOnly Property Parent() As Node(Of T)
Get
If Me.IsRoot Then
Return Nothing
End If
Return gParent
End Get
End Property
''' <summary>
''' 树的深度
''' </summary>
Public ReadOnly Property Level() As Integer
Get
If Me.IsRoot Then
Return 0
End If
Return Me.Parent.Level + 1
End Get
End Property
''' <summary>
''' 当前节点是否是根节点
''' </summary>
Public ReadOnly Property IsRoot() As Boolean
Get
Return gIsRoot
End Get
End Property
Private gUserData As Object
''' <summary>
''' 获取或设置包含树节点有关数据的对象
''' </summary>
Public Property Tag() As Object
Get
Return gUserData
End Get
Set(ByVal value As Object)
gUserData = value
End Set
End Property
Private gItem As T
Public Property Item() As T
Get
Return gItem
End Get
Set(ByVal value As T)
gItem = value
End Set
End Property
Friend gChildren As NodeCollection(Of T)
''' <summary>
''' 获取第一个子树节点
''' </summary>
Public ReadOnly Property FirstNode() As Node(Of T)
Get
If gChildren.Count = 0 Then
Return Nothing
End If
Return gChildren(0)
End Get
End Property
''' <summary>
''' 获取最后一个子树节点
''' </summary>
Public ReadOnly Property LastNode() As Node(Of T)
Get
If gChildren.Count = 0 Then
Return Nothing
End If
Return gChildren(gChildren.Count - 1)
End Get
End Property
Private gNodes As NodeCollection(Of T)
''' <summary>
''' 当前节点的节点集合
''' </summary>
Public ReadOnly Property Nodes() As NodeCollection(Of T)
Get
Return gNodes
End Get
End Property
''' <summary>
''' 当前节点在节点集合中的位置
''' </summary>
Public ReadOnly Property Index() As Integer
Get
Return GetIndex()
End Get
End Property
Private Function GetIndex() As Integer
If Me.IsRoot Then
Return 0
End If
Return Me.Parent.Nodes.IndexOf(Me)
End Function
''' <summary>
''' 获取下一个同级树节点
''' </summary>
Public ReadOnly Property NextNode() As Node(Of T)
Get
If Me.IsRoot OrElse Me.Index + 1 > Me.Parent.Nodes.Count Then
Return Nothing
End If
Return Me.Parent.Nodes.Item(Me.Index + 1)
End Get
End Property
''' <summary>
''' 获取上一个同级树节点
''' </summary>
Public ReadOnly Property PrevNode() As Node(Of T)
Get
If Me.IsRoot OrElse Me.Index - 1 < 0 Then
Return Nothing
End If
Return Me.Parent.Nodes.Item(Me.Index - 1)
End Get
End Property
Private Sub Initialzie()
gNodes = New NodeCollection(Of T)(Me)
gChildren = New NodeCollection(Of T)(Me)
gByProperty = Not uSystem.uReflection.CommonFunction.TypeHasFields(GetType(T))
End Sub
Sub New()
Initialzie()
End Sub
Sub New(ByVal item As T)
gItem = item
Initialzie()
End Sub
Public Function GetNodeCount(ByVal includeSubNodes As Boolean) As Integer
Dim mCount As Integer = gChildren.Count
If includeSubNodes Then
Dim mIndex As Integer = 0
Do While mIndex < gChildren.Count
mCount += gChildren(mIndex).GetNodeCount(True)
mIndex += 1
Loop
End If
Return mCount
End Function
Public Sub Remove()
If Me.IsRoot Then
Throw New Exception("不能移除根节点")
End If
Me.Parent.Nodes.RemoveAt(Me.Index)
End Sub
Private gTable As DataTable
Private gByProperty As Boolean
''' <summary>
''' 将当前节点树转换为表
''' </summary>
''' <param name="includeSubNodes">是否包括子节点的T对象</param>
Public Function ConvertToDataTable(ByVal includeSubNodes As Boolean) As DataTable
gTable = uSystem.uReflection.CommonFunction.CreateTableFromType(GetType(T))
If gTable.Columns.Count = 0 Then
If gByProperty Then
Throw New Exception("对象无属性列")
Else
Throw New Exception("对象无字段列")
End If
End If
Me.ForEach(New Action(Of T)(AddressOf GetDataTableDatasAction), includeSubNodes)
gTable.AcceptChanges()
Return gTable
End Function
Private Sub GetDataTableDatasAction(ByVal item As T)
uSystem.uReflection.CommonFunction.ItemAppendToTable(Of T)(item, gTable)
End Sub
''' <summary>
''' 将当前节点树转换为TreeNode
''' </summary>
''' <param name="NameOfTreeNodeText">TreeNode的Text值对应的T对象属性名或字段名</param>
''' <param name="includeSubNodes">是否包括子节点</param>
''' <remarks>TreeNode的Tag存T对象值</remarks>
Public Function ConvertToTreeNode(ByVal nameOfTreeNodeText As String, ByVal includeSubNodes As Boolean) As Windows.Forms.TreeNode
CheckValid(gByProperty, nameOfTreeNodeText)
Dim mTreeNode As System.Windows.Forms.TreeNode = ConvertToTreeNode(Me, gByProperty, nameOfTreeNodeText)
If includeSubNodes Then AppendTreeNode(mTreeNode, Me, gByProperty, nameOfTreeNodeText)
Return mTreeNode
End Function
Private Shared Sub AppendTreeNode(ByVal treeNode As Windows.Forms.TreeNode, ByVal node As Node(Of T), ByVal byProperty As Boolean, ByVal nameOfTreeNodeText As String)
For Each n As Node(Of T) In node.gChildren
Dim mCurrentTreeNode As Windows.Forms.TreeNode = ConvertToTreeNode(n, byProperty, nameOfTreeNodeText)
treeNode.Nodes.Add(mCurrentTreeNode)
AppendTreeNode(mCurrentTreeNode, n, byProperty, nameOfTreeNodeText)
Next
End Sub
Private Shared Function ConvertToTreeNode(ByVal node As Node(Of T), ByVal byProperty As Boolean, ByVal nameOfTreeNodeText As String) As System.Windows.Forms.TreeNode
Dim mTextValue As Object
If byProperty Then
mTextValue = GetType(T).GetProperty(nameOfTreeNodeText).GetValue(node.Item, Nothing)
Else
mTextValue = GetType(T).GetField(nameOfTreeNodeText).GetValue(node.Item)
End If
If mTextValue Is Nothing Then
mTextValue = "Root"
End If
Dim mTreeNode As New System.Windows.Forms.TreeNode(mTextValue.ToString)
mTreeNode.Tag = node.Item
Return mTreeNode
End Function
Private Sub CheckValid(ByVal byProperty As Boolean, ByVal nameOfTreeNodeText As String)
If byProperty Then
Dim mPropertyInfo As System.Reflection.PropertyInfo = GetType(T).GetProperty(nameOfTreeNodeText)
If mPropertyInfo Is Nothing Then
Throw New Exception("属性名无效")
If Not mPropertyInfo.CanRead Then
Throw New Exception("属性名不可读")
End If
End If
Else
Dim mFieldInfo As System.Reflection.FieldInfo = GetType(T).GetField(nameOfTreeNodeText)
If mFieldInfo Is Nothing Then
Throw New Exception("字段名无效")
End If
End If
End Sub
''' <summary>
''' 对每个节点执行指定操作
''' </summary>
''' <param name="action">对指定的对象执行操作的方法</param>
''' <param name="includeSubNodes">是否包括子节点</param>
Public Sub ForEach(ByVal action As Action(Of Node(Of T)), ByVal includeSubNodes As Boolean)
Node(Of T).ForEach(Me, action, includeSubNodes)
End Sub
Public Shared Sub ForEach(ByVal node As Node(Of T), ByVal action As Action(Of Node(Of T)), ByVal includeSubNodes As Boolean)
For Each n As Node(Of T) In node.gChildren
action.Invoke(n)
If includeSubNodes Then ForEach(n, action, True)
Next
End Sub
''' <summary>
''' 对每个T对象执行指定操作
''' </summary>
''' <param name="action">对指定的对象执行操作的方法</param>
''' <param name="includeSubNodes">是否包括子节点的T对象</param>
Public Sub ForEach(ByVal action As Action(Of T), ByVal includeSubNodes As Boolean)
Node(Of T).ForEach(Me, action, includeSubNodes)
End Sub
Public Shared Sub ForEach(ByVal node As Node(Of T), ByVal action As Action(Of T), ByVal includeSubNodes As Boolean)
For Each n As Node(Of T) In node.gChildren
action.Invoke(n.Item)
If includeSubNodes Then ForEach(n, action, True)
Next
End Sub
Public Function FindFirstNode(ByVal memberName As String, ByVal value As Object) As Node(Of T)
Dim mType As Type = GetType(T)
If Not uSystem.uReflection.CommonFunction.TypeHasMember(mType, memberName) Then
Throw New Exception(String.Format("无此成员名 :{0}", memberName))
End If
If gByProperty Then
If Not mType.GetProperty(memberName).CanRead Then
Throw New Exception(String.Format("成员名不可读 :{0}", memberName))
End If
End If
Dim mResult As Node(Of T) = Nothing
FindFirstNode(mType, memberName, value, Me, mResult)
Return mResult
End Function
Private Sub FindFirstNode(ByVal t As Type, ByVal memberName As String, ByVal Value As Object, ByVal node As Node(Of T), ByRef result As Node(Of T))
For Each n As Node(Of T) In node.gChildren
If gByProperty Then
If t.GetProperty(memberName).GetValue(n.Item, Nothing).Equals(Value) Then
result = n
Exit Sub
End If
Else
If t.GetField(memberName).GetValue(n.Item).Equals(Value) Then
result = n
Exit Sub
End If
End If
FindFirstNode(t, memberName, Value, n, result)
Next
End Sub
Public Function Clone() As Node(Of T)
Return uSystem.uRuntime.uSerialization.SerializeHelper.Clone(Of Node(Of T))(Me)
End Function
End Class
End Namespace
Namespace LzmTW.uSystem.uCollection
''' <summary>
''' 树节点集合
''' </summary>
''' <remarks>LzmTW 20061111</remarks>
<Serializable()> _
Public Class NodeCollection(Of T)
Inherits System.Collections.ObjectModel.Collection(Of Node(Of T))
Private gOwner As Node(Of T)
Friend Sub New(ByVal node As Node(Of T))
gOwner = node
End Sub
Public Shadows Function Add(ByVal Value As T) As Node(Of T)
Dim mNode As New Node(Of T)(Value)
Add(mNode)
gOwner.gChildren.Add(mNode)
Return mNode
End Function
Private Shadows Sub Add(ByVal item As Node(Of T))
With item
.gParent = gOwner
.gIsRoot = False
End With
MyBase.Add(item)
End Sub
Public Shadows Sub RemoveAt(ByVal index As Integer)
If Not IsValidIndex(index) Then
Throw New Exception("索引无效")
End If
Dim mNode As Node(Of T) = Me.Item(index)
Remove(mNode)
gOwner.gChildren.Remove(mNode)
End Sub
Public Shadows Sub Remove(ByVal index As Integer)
Me.RemoveAt(index)
End Sub
Private Shadows Function Remove(ByVal item As Node(Of T)) As Boolean
Return MyBase.Remove(item)
End Function
Public Shadows Sub Insert(ByVal index As Integer, ByVal Value As T)
If Not IsValidIndex(index) Then
Throw New Exception("索引无效")
End If
Dim mNode As New Node(Of T)(Value)
Insert(index, mNode)
gOwner.gChildren.Insert(index, mNode)
End Sub
Private Shadows Sub Insert(ByVal index As Integer, ByVal item As Node(Of T))
With item
.gParent = gOwner
.gIsRoot = False
End With
MyBase.Insert(index, item)
End Sub
Public Overloads Sub Clear()
MyBase.Clear()
If gOwner.gChildren.Count > 0 Then gOwner.gChildren.Clear()
End Sub
Private Function IsValidIndex(ByVal index As Integer) As Boolean
If index >= 0 Then
Return index < Me.Count
End If
Return False
End Function
End Class
End Namespace
''' <summary>
''' 树节点集合
''' </summary>
''' <remarks>LzmTW 20061111</remarks>
<Serializable()> _
Public Class NodeCollection(Of T)
Inherits System.Collections.ObjectModel.Collection(Of Node(Of T))
Private gOwner As Node(Of T)
Friend Sub New(ByVal node As Node(Of T))
gOwner = node
End Sub
Public Shadows Function Add(ByVal Value As T) As Node(Of T)
Dim mNode As New Node(Of T)(Value)
Add(mNode)
gOwner.gChildren.Add(mNode)
Return mNode
End Function
Private Shadows Sub Add(ByVal item As Node(Of T))
With item
.gParent = gOwner
.gIsRoot = False
End With
MyBase.Add(item)
End Sub
Public Shadows Sub RemoveAt(ByVal index As Integer)
If Not IsValidIndex(index) Then
Throw New Exception("索引无效")
End If
Dim mNode As Node(Of T) = Me.Item(index)
Remove(mNode)
gOwner.gChildren.Remove(mNode)
End Sub
Public Shadows Sub Remove(ByVal index As Integer)
Me.RemoveAt(index)
End Sub
Private Shadows Function Remove(ByVal item As Node(Of T)) As Boolean
Return MyBase.Remove(item)
End Function
Public Shadows Sub Insert(ByVal index As Integer, ByVal Value As T)
If Not IsValidIndex(index) Then
Throw New Exception("索引无效")
End If
Dim mNode As New Node(Of T)(Value)
Insert(index, mNode)
gOwner.gChildren.Insert(index, mNode)
End Sub
Private Shadows Sub Insert(ByVal index As Integer, ByVal item As Node(Of T))
With item
.gParent = gOwner
.gIsRoot = False
End With
MyBase.Insert(index, item)
End Sub
Public Overloads Sub Clear()
MyBase.Clear()
If gOwner.gChildren.Count > 0 Then gOwner.gChildren.Clear()
End Sub
Private Function IsValidIndex(ByVal index As Integer) As Boolean
If index >= 0 Then
Return index < Me.Count
End If
Return False
End Function
End Class
End Namespace
自联表数据实体派生类：
Namespace LzmTW.uSystem.uCollection.SinceLink
''' <summary>
''' 自联表数据类的派生类
''' </summary>
''' <typeparam name="T_ID_DataType">自联表键类型,或是Integer或是String</typeparam>
''' <remarks>LzmTW 20061111</remarks>
<Serializable()> _
Public MustInherit Class SinceLinkItemBase(Of T_ID_DataType)
Private gName As String
Friend gCode As String
<NonSerialized()> _
Private gCodeInformation As SinceLinkCodeInformation
Sub New()
End Sub
Sub New(ByVal code As String, ByVal name As String)
gName = name
gCode = code
End Sub
Public ReadOnly Property Code() As String
Get
Return gCode
End Get
End Property
Public Property Name() As String
Get
Return gName
End Get
Set(ByVal value As String)
gName = value
End Set
End Property
Friend Sub UpdateInformations(ByVal codeFormat As String)
gCodeInformation = New SinceLinkCodeInformation(codeFormat)
gCodeInformation.SetCode(gCode)
End Sub
Friend Function GetLevel() As Integer
Return gCodeInformation.Level
End Function
Friend Function GetID() As T_ID_DataType
Return CType(System.Convert.ChangeType(gCodeInformation.ID, GetType(T_ID_DataType)), T_ID_DataType)
End Function
Friend Function GetParentID() As T_ID_DataType
Return CType(System.Convert.ChangeType(gCodeInformation.ParentID, GetType(T_ID_DataType)), T_ID_DataType)
End Function
Friend Function GetParentKey() As String
Return gCodeInformation.ParentKey
End Function
Friend Function GetLevels() As Integer
Return gCodeInformation.Levels
End Function
Public Function Clone() As SinceLinkItemBase(Of T_ID_DataType)
Return uSystem.uRuntime.uSerialization.SerializeHelper.Clone(Of SinceLinkItemBase(Of T_ID_DataType))(Me)
End Function
End Class
End Namespace
''' <summary>
''' 自联表数据类的派生类
''' </summary>
''' <typeparam name="T_ID_DataType">自联表键类型,或是Integer或是String</typeparam>
''' <remarks>LzmTW 20061111</remarks>
<Serializable()> _
Public MustInherit Class SinceLinkItemBase(Of T_ID_DataType)
Private gName As String
Friend gCode As String
<NonSerialized()> _
Private gCodeInformation As SinceLinkCodeInformation
Sub New()
End Sub
Sub New(ByVal code As String, ByVal name As String)
gName = name
gCode = code
End Sub
Public ReadOnly Property Code() As String
Get
Return gCode
End Get
End Property
Public Property Name() As String
Get
Return gName
End Get
Set(ByVal value As String)
gName = value
End Set
End Property
Friend Sub UpdateInformations(ByVal codeFormat As String)
gCodeInformation = New SinceLinkCodeInformation(codeFormat)
gCodeInformation.SetCode(gCode)
End Sub
Friend Function GetLevel() As Integer
Return gCodeInformation.Level
End Function
Friend Function GetID() As T_ID_DataType
Return CType(System.Convert.ChangeType(gCodeInformation.ID, GetType(T_ID_DataType)), T_ID_DataType)
End Function
Friend Function GetParentID() As T_ID_DataType
Return CType(System.Convert.ChangeType(gCodeInformation.ParentID, GetType(T_ID_DataType)), T_ID_DataType)
End Function
Friend Function GetParentKey() As String
Return gCodeInformation.ParentKey
End Function
Friend Function GetLevels() As Integer
Return gCodeInformation.Levels
End Function
Public Function Clone() As SinceLinkItemBase(Of T_ID_DataType)
Return uSystem.uRuntime.uSerialization.SerializeHelper.Clone(Of SinceLinkItemBase(Of T_ID_DataType))(Me)
End Function
End Class
End Namespace
自联表数据集合：
Namespace LzmTW.uSystem.uCollection.SinceLink
''' <summary>
''' 自联表数据集合。如果加载的数据是Code,Name形式,须调用New(codeFormat)构造函数以指定codeFormat形式.
''' </summary>
''' <typeparam name="T_ID_DataType">自联表键类型,或是Integer或是String</typeparam>
''' <typeparam name="T">自联表数据类</typeparam>
''' <remarks>LzmTW 20061111</remarks>
<Serializable()> _
Public Class SinceLinkItemCollection(Of T_ID_DataType, T As SinceLinkItemBase(Of T_ID_DataType))
Inherits System.Collections.ObjectModel.Collection(Of T)
<NonSerialized()> _
Private gNode As Node(Of T)
Private gCodeFormat As String
Private gFileName As String = AppDomain.CurrentDomain.BaseDirectory & "{0}.{1}s.dat"
Sub New()
gFileName = String.Format(gFileName, System.Reflection.Assembly.GetEntryAssembly.ManifestModule.Name, GetType(T).Name)
End Sub
''' <param name="codeFormat">形如“00,000,0000”</param>
Sub New(ByVal codeFormat As String)
gCodeFormat = codeFormat
gFileName = String.Format(gFileName, System.Reflection.Assembly.GetEntryAssembly.ManifestModule.Name, GetType(T).Name)
End Sub
Public ReadOnly Property Node() As Node(Of T)
Get
If gNode Is Nothing Then
Me.RefleshNode()
End If
Return gNode
End Get
End Property
Public Shadows Function Add(ByVal code As String, ByVal name As String) As T
Dim mItem As T = CType(System.Activator.CreateInstance(GetType(T), New Object() {code, name}), T)
Me.Add(mItem)
Return mItem
End Function
Public Shadows Sub Add(ByVal items As T())
For Each item As T In items
Add(item)
Next
End Sub
Public Shadows Function Add(ByVal item As T) As T
item.UpdateInformations(gCodeFormat)
MyBase.Add(item)
Return item
End Function
''' <summary>
''' 从自联表加载数据,表必须有ID,ParentID,Name字段,并且,有一项数据Name字段的值为“Root”以申明为根。
''' </summary>
Public Sub AppendFromSinceLinkTable(ByVal sinceLinkTable As DataTable)
Dim mSinceLinkTable As New SinceLinkTable(Of T_ID_DataType, T)
With mSinceLinkTable
.Input(sinceLinkTable)
gCodeFormat = .CodeFormat
Add(.Items)
End With
End Sub
''' <summary>
''' 从树中加载数据
''' </summary>
Public Sub AppendFromBlankCodeNode(ByVal node As Node(Of T))
Dim mSinceLinkBlankNode As New SinceLinkBlankCodeNode(Of T_ID_DataType, T)
With mSinceLinkBlankNode
.SetNode(node)
gCodeFormat = .CodeFormat
Add(.Items)
End With
End Sub
Public Sub RefleshNode()
gNode = GetNode()
End Sub
Private Function GetNode() As Node(Of T)
If Me.Count = 0 Then Return Nothing
Dim mItem As T = CType(System.Activator.CreateInstance(GetType(T)), T)
With mItem
.gCode = New String("0"c, gCodeFormat.Replace(","c, "").Length)
.Name = "Root"
End With
mItem.UpdateInformations(gCodeFormat)
Dim mNode As New Node(Of T)(mItem)
Dim mCurrentNode As Node(Of T)
'加首级
For Each item As T In Me.Items
If item.GetLevel = 1 Then
mCurrentNode = mNode.Nodes.Add(item)
'加子级
AppendItem(mCurrentNode)
End If
Next
Return mNode
End Function
Private Sub AppendItem(ByRef node As Node(Of T))
Dim mCurrentNode As Node(Of T)
For Each item As T In GetChildItem(node.Item)
mCurrentNode = node.Nodes.Add(item)
AppendItem(mCurrentNode)
Next
End Sub
Public Function GetChildItem(ByVal item As T) As System.Collections.ObjectModel.Collection(Of T)
Dim mList As New System.Collections.ObjectModel.Collection(Of T)
If item.GetLevel = item.GetLevels Then Return mList
For Each value As T In Me.Items
If item.Code.StartsWith(value.GetParentKey) AndAlso value.GetParentID.Equals(item.GetID) AndAlso item.GetLevel = value.GetLevel - 1 Then
mList.Add(value)
End If
Next
Return mList
End Function
Public Function Find(ByVal memberName As String, ByVal Value As Object) As T
Dim mType As Type = GetType(T)
Dim mPropertyInfo As Reflection.PropertyInfo = mType.GetProperty(memberName)
If mPropertyInfo Is Nothing Then
Throw New Exception(String.Format("无此成员名 :{0}", memberName))
Else
If Not mPropertyInfo.CanRead Then
Throw New Exception(String.Format("成员名不可读 :{0}", memberName))
End If
End If
Dim mResult As T = Nothing
For Each item As T In Me.Items
If mPropertyInfo.GetValue(item, Nothing).Equals(Value) Then
mResult = item
Exit For
End If
Next
Return mResult
End Function
Public Sub CopyFrom(ByVal collection As SinceLinkItemCollection(Of T_ID_DataType, T))
With collection
Me.Clear()
Me.gCodeFormat = .gCodeFormat
Me.gFileName = .gFileName
For Each item As T In .Items
Me.Add(CType(item.Clone, T))
Next
End With
End Sub
#Region "文件数据的存储和读取"
Public Sub Read(ByVal file As String)
gFileName = file
Read()
End Sub
Public Sub Save(ByVal file As String)
gFileName = file
Save()
End Sub
Public Sub Read()
ReadInternal()
End Sub
Public Sub Save()
SaveInternal()
End Sub
Private Sub SaveInternal()
uSystem.uRuntime.uSerialization.SerializeHelper.Save(Of SinceLinkItemCollection(Of T_ID_DataType, T))(gFileName, uRuntime.uSerialization.FormatType.Binary, Me)
End Sub
Private Sub ReadInternal()
Dim tmp As SinceLinkItemCollection(Of T_ID_DataType, T)
tmp = uSystem.uRuntime.uSerialization.SerializeHelper.Load(Of SinceLinkItemCollection(Of T_ID_DataType, T))(gFileName, uRuntime.uSerialization.FormatType.Binary)
Me.CopyFrom(tmp)
tmp.Clear()
tmp = Nothing
End Sub
#End Region
End Class
End Namespace
''' <summary>
''' 自联表数据集合。如果加载的数据是Code,Name形式,须调用New(codeFormat)构造函数以指定codeFormat形式.
''' </summary>
''' <typeparam name="T_ID_DataType">自联表键类型,或是Integer或是String</typeparam>
''' <typeparam name="T">自联表数据类</typeparam>
''' <remarks>LzmTW 20061111</remarks>
<Serializable()> _
Public Class SinceLinkItemCollection(Of T_ID_DataType, T As SinceLinkItemBase(Of T_ID_DataType))
Inherits System.Collections.ObjectModel.Collection(Of T)
<NonSerialized()> _
Private gNode As Node(Of T)
Private gCodeFormat As String
Private gFileName As String = AppDomain.CurrentDomain.BaseDirectory & "{0}.{1}s.dat"
Sub New()
gFileName = String.Format(gFileName, System.Reflection.Assembly.GetEntryAssembly.ManifestModule.Name, GetType(T).Name)
End Sub
''' <param name="codeFormat">形如“00,000,0000”</param>
Sub New(ByVal codeFormat As String)
gCodeFormat = codeFormat
gFileName = String.Format(gFileName, System.Reflection.Assembly.GetEntryAssembly.ManifestModule.Name, GetType(T).Name)
End Sub
Public ReadOnly Property Node() As Node(Of T)
Get
If gNode Is Nothing Then
Me.RefleshNode()
End If
Return gNode
End Get
End Property
Public Shadows Function Add(ByVal code As String, ByVal name As String) As T
Dim mItem As T = CType(System.Activator.CreateInstance(GetType(T), New Object() {code, name}), T)
Me.Add(mItem)
Return mItem
End Function
Public Shadows Sub Add(ByVal items As T())
For Each item As T In items
Add(item)
Next
End Sub
Public Shadows Function Add(ByVal item As T) As T
item.UpdateInformations(gCodeFormat)
MyBase.Add(item)
Return item
End Function
''' <summary>
''' 从自联表加载数据,表必须有ID,ParentID,Name字段,并且,有一项数据Name字段的值为“Root”以申明为根。
''' </summary>
Public Sub AppendFromSinceLinkTable(ByVal sinceLinkTable As DataTable)
Dim mSinceLinkTable As New SinceLinkTable(Of T_ID_DataType, T)
With mSinceLinkTable
.Input(sinceLinkTable)
gCodeFormat = .CodeFormat
Add(.Items)
End With
End Sub
''' <summary>
''' 从树中加载数据
''' </summary>
Public Sub AppendFromBlankCodeNode(ByVal node As Node(Of T))
Dim mSinceLinkBlankNode As New SinceLinkBlankCodeNode(Of T_ID_DataType, T)
With mSinceLinkBlankNode
.SetNode(node)
gCodeFormat = .CodeFormat
Add(.Items)
End With
End Sub
Public Sub RefleshNode()
gNode = GetNode()
End Sub
Private Function GetNode() As Node(Of T)
If Me.Count = 0 Then Return Nothing
Dim mItem As T = CType(System.Activator.CreateInstance(GetType(T)), T)
With mItem
.gCode = New String("0"c, gCodeFormat.Replace(","c, "").Length)
.Name = "Root"
End With
mItem.UpdateInformations(gCodeFormat)
Dim mNode As New Node(Of T)(mItem)
Dim mCurrentNode As Node(Of T)
'加首级
For Each item As T In Me.Items
If item.GetLevel = 1 Then
mCurrentNode = mNode.Nodes.Add(item)
'加子级
AppendItem(mCurrentNode)
End If
Next
Return mNode
End Function
Private Sub AppendItem(ByRef node As Node(Of T))
Dim mCurrentNode As Node(Of T)
For Each item As T In GetChildItem(node.Item)
mCurrentNode = node.Nodes.Add(item)
AppendItem(mCurrentNode)
Next
End Sub
Public Function GetChildItem(ByVal item As T) As System.Collections.ObjectModel.Collection(Of T)
Dim mList As New System.Collections.ObjectModel.Collection(Of T)
If item.GetLevel = item.GetLevels Then Return mList
For Each value As T In Me.Items
If item.Code.StartsWith(value.GetParentKey) AndAlso value.GetParentID.Equals(item.GetID) AndAlso item.GetLevel = value.GetLevel - 1 Then
mList.Add(value)
End If
Next
Return mList
End Function
Public Function Find(ByVal memberName As String, ByVal Value As Object) As T
Dim mType As Type = GetType(T)
Dim mPropertyInfo As Reflection.PropertyInfo = mType.GetProperty(memberName)
If mPropertyInfo Is Nothing Then
Throw New Exception(String.Format("无此成员名 :{0}", memberName))
Else
If Not mPropertyInfo.CanRead Then
Throw New Exception(String.Format("成员名不可读 :{0}", memberName))
End If
End If
Dim mResult As T = Nothing
For Each item As T In Me.Items
If mPropertyInfo.GetValue(item, Nothing).Equals(Value) Then
mResult = item
Exit For
End If
Next
Return mResult
End Function
Public Sub CopyFrom(ByVal collection As SinceLinkItemCollection(Of T_ID_DataType, T))
With collection
Me.Clear()
Me.gCodeFormat = .gCodeFormat
Me.gFileName = .gFileName
For Each item As T In .Items
Me.Add(CType(item.Clone, T))
Next
End With
End Sub
#Region "文件数据的存储和读取"
Public Sub Read(ByVal file As String)
gFileName = file
Read()
End Sub
Public Sub Save(ByVal file As String)
gFileName = file
Save()
End Sub
Public Sub Read()
ReadInternal()
End Sub
Public Sub Save()
SaveInternal()
End Sub
Private Sub SaveInternal()
uSystem.uRuntime.uSerialization.SerializeHelper.Save(Of SinceLinkItemCollection(Of T_ID_DataType, T))(gFileName, uRuntime.uSerialization.FormatType.Binary, Me)
End Sub
Private Sub ReadInternal()
Dim tmp As SinceLinkItemCollection(Of T_ID_DataType, T)
tmp = uSystem.uRuntime.uSerialization.SerializeHelper.Load(Of SinceLinkItemCollection(Of T_ID_DataType, T))(gFileName, uRuntime.uSerialization.FormatType.Binary)
Me.CopyFrom(tmp)
tmp.Clear()
tmp = Nothing
End Sub
#End Region
End Class
End Namespace
Namespace LzmTW.uSystem.uCollection.SinceLink
''' <summary>
''' 处理数据本身是自联表
''' </summary>
''' <typeparam name="T_ID_DataType">自联表键类型,或是Integer或是String</typeparam>
''' <typeparam name="T">自联表数据类</typeparam>
''' <remarks>LzmTW 20061111</remarks>
Friend Class SinceLinkTable(Of T_ID_DataType, T As SinceLinkItemBase(Of T_ID_DataType))
Private gDataTable As DataTable
Private gFilterFormat As String
Private gNode As Node(Of T)
Private gBlankNode As New SinceLinkBlankCodeNode(Of T_ID_DataType, T)
Public ReadOnly Property Items() As T()
Get
Return gBlankNode.Items
End Get
End Property
Public ReadOnly Property CodeFormat() As String
Get
Return gBlankNode.CodeFormat
End Get
End Property
Sub New()
If GetType(T).GetMethod("GetID", Reflection.BindingFlags.NonPublic Or Reflection.BindingFlags.Instance).ReturnType Is GetType(String) Then
gFilterFormat = "ParentID = '{0}'"
Else
gFilterFormat = "ParentID = {0}"
End If
End Sub
Public Sub Input(ByVal table As DataTable)
If Not Me.IsSinceLinkTable(table) Then Throw New Exception("表不是自联表.若是,需有ID、ParentID字段和Name字段.")
If table.Rows.Count = 0 Then Throw New Exception("无数据")
Me.Copy(table)
Me.CreateNode()
gBlankNode.SetNode(gNode)
Me.Clear()
End Sub
Private Function IsSinceLinkTable(ByVal table As DataTable) As Boolean
With table.Columns
If .Contains("ID") Then
If .Contains("ParentID") Then
Return .Contains("Name")
End If
End If
End With
Return False
End Function
Private Sub Copy(ByVal table As DataTable)
gDataTable = table.Clone
gDataTable.Load(table.CreateDataReader)
gDataTable.AcceptChanges()
End Sub
Private Sub CreateNode()
Dim mMainView As DataView = New DataView(gDataTable, Nothing, "ID", DataViewRowState.CurrentRows)
If Not mMainView.Item(0).Item("Name").ToString.ToLower.Equals("root") Then
Throw New Exception("首位ID数据行的Name字段须有Root值示为根")
End If
Dim mItem As T = CType(System.Activator.CreateInstance(GetType(T)), T)
mItem.Name = "Root"
gNode = New Node(Of T)(mItem)
AppendNode(mMainView.Item(0).Item("ID"), gNode)
End Sub
Private Sub AppendNode(ByVal ParentID As Object, ByVal node As Node(Of T))
Dim mDataView As DataView = GetDataView(ParentID)
Dim mCount As Integer = mDataView.Count
If mCount = 0 Then Exit Sub
Dim mNode As Node(Of T) = Nothing
For Each rowView As DataRowView In mDataView
mNode = node.Nodes.Add(CreateItem(rowView))
AppendNode(rowView.Item("ID"), mNode)
Next
End Sub
Private Function GetDataView(ByVal ParentID As Object) As DataView
Return New DataView(gDataTable, String.Format(gFilterFormat, ParentID), "ID", DataViewRowState.CurrentRows)
End Function
Private Function CreateItem(ByVal rowView As DataRowView) As T
Dim mItem As T
mItem = CType(System.Activator.CreateInstance(GetType(T)), T)
For Each p As Reflection.PropertyInfo In GetType(T).GetProperties
If p.CanWrite Then
If rowView.DataView.Table.Columns.Contains(p.Name) Then
p.SetValue(mItem, rowView.Item(p.Name), Nothing)
End If
End If
Next
Return mItem
End Function
Private Sub Clear()
gDataTable.Clear()
gDataTable.Dispose()
gNode.Nodes.Clear()
End Sub
End Class
End Namespace
''' <summary>
''' 处理数据本身是自联表
''' </summary>
''' <typeparam name="T_ID_DataType">自联表键类型,或是Integer或是String</typeparam>
''' <typeparam name="T">自联表数据类</typeparam>
''' <remarks>LzmTW 20061111</remarks>
Friend Class SinceLinkTable(Of T_ID_DataType, T As SinceLinkItemBase(Of T_ID_DataType))
Private gDataTable As DataTable
Private gFilterFormat As String
Private gNode As Node(Of T)
Private gBlankNode As New SinceLinkBlankCodeNode(Of T_ID_DataType, T)
Public ReadOnly Property Items() As T()
Get
Return gBlankNode.Items
End Get
End Property
Public ReadOnly Property CodeFormat() As String
Get
Return gBlankNode.CodeFormat
End Get
End Property
Sub New()
If GetType(T).GetMethod("GetID", Reflection.BindingFlags.NonPublic Or Reflection.BindingFlags.Instance).ReturnType Is GetType(String) Then
gFilterFormat = "ParentID = '{0}'"
Else
gFilterFormat = "ParentID = {0}"
End If
End Sub
Public Sub Input(ByVal table As DataTable)
If Not Me.IsSinceLinkTable(table) Then Throw New Exception("表不是自联表.若是,需有ID、ParentID字段和Name字段.")
If table.Rows.Count = 0 Then Throw New Exception("无数据")
Me.Copy(table)
Me.CreateNode()
gBlankNode.SetNode(gNode)
Me.Clear()
End Sub
Private Function IsSinceLinkTable(ByVal table As DataTable) As Boolean
With table.Columns
If .Contains("ID") Then
If .Contains("ParentID") Then
Return .Contains("Name")
End If
End If
End With
Return False
End Function
Private Sub Copy(ByVal table As DataTable)
gDataTable = table.Clone
gDataTable.Load(table.CreateDataReader)
gDataTable.AcceptChanges()
End Sub
Private Sub CreateNode()
Dim mMainView As DataView = New DataView(gDataTable, Nothing, "ID", DataViewRowState.CurrentRows)
If Not mMainView.Item(0).Item("Name").ToString.ToLower.Equals("root") Then
Throw New Exception("首位ID数据行的Name字段须有Root值示为根")
End If
Dim mItem As T = CType(System.Activator.CreateInstance(GetType(T)), T)
mItem.Name = "Root"
gNode = New Node(Of T)(mItem)
AppendNode(mMainView.Item(0).Item("ID"), gNode)
End Sub
Private Sub AppendNode(ByVal ParentID As Object, ByVal node As Node(Of T))
Dim mDataView As DataView = GetDataView(ParentID)
Dim mCount As Integer = mDataView.Count
If mCount = 0 Then Exit Sub
Dim mNode As Node(Of T) = Nothing
For Each rowView As DataRowView In mDataView
mNode = node.Nodes.Add(CreateItem(rowView))
AppendNode(rowView.Item("ID"), mNode)
Next
End Sub
Private Function GetDataView(ByVal ParentID As Object) As DataView
Return New DataView(gDataTable, String.Format(gFilterFormat, ParentID), "ID", DataViewRowState.CurrentRows)
End Function
Private Function CreateItem(ByVal rowView As DataRowView) As T
Dim mItem As T
mItem = CType(System.Activator.CreateInstance(GetType(T)), T)
For Each p As Reflection.PropertyInfo In GetType(T).GetProperties
If p.CanWrite Then
If rowView.DataView.Table.Columns.Contains(p.Name) Then
p.SetValue(mItem, rowView.Item(p.Name), Nothing)
End If
End If
Next
Return mItem
End Function
Private Sub Clear()
gDataTable.Clear()
gDataTable.Dispose()
gNode.Nodes.Clear()
End Sub
End Class
End Namespace
Namespace LzmTW.uSystem.uCollection.SinceLink
''' <summary>
''' 处理树情形的数据,转换为Code,Name形式
''' </summary>
''' <typeparam name="T_ID_DataType">自联表键类型,或是Integer或是String</typeparam>
''' <typeparam name="T">自联表数据类</typeparam>
''' <remarks>LzmTW 20061111</remarks>
Friend Class SinceLinkBlankCodeNode(Of T_ID_DataType, T As SinceLinkItemBase(Of T_ID_DataType))
Private gList As New ArrayList
Private gItems As T()
Private gCodeFormat As String
Private gNode As Node(Of T)
Private gLevelLengths(0) As Integer
Public ReadOnly Property Items() As T()
Get
Return gItems
End Get
End Property
Public ReadOnly Property CodeFormat() As String
Get
Return gCodeFormat
End Get
End Property
Public Sub SetNode(ByVal node As Node(Of T))
gNode = node
GetlevelLengths()
UpdateCode()
Clear()
End Sub
Private Sub GetlevelLengths()
Dim mLevels As Integer = 0
GetLevelLengths(0, gNode, gLevelLengths, mLevels)
Dim tmpFormat(mLevels - 1) As String
For i As Integer = 0 To mLevels - 1
gLevelLengths(i) = gLevelLengths(i).ToString.Length
tmpFormat(i) = New String("0"c, gLevelLengths(i))
Next
gCodeFormat = String.Join(",", tmpFormat)
End Sub
Private Sub GetLevelLengths(ByVal ParentID As Object, ByVal node As Node(Of T), ByRef levelengths() As Integer, ByRef levels As Integer)
Dim mCount As Integer = node.Nodes.Count
If mCount = 0 Then Exit Sub
Dim mNode As Node(Of T) = Nothing
For Each mNode In node.gChildren
GetLevelLengths(node.Index, mNode, levelengths, levels)
Next
If mNode.Level > node.Level Then
If mNode.Level > levels Then
levels = mNode.Level
ReDim Preserve levelengths(levels - 1)
levelengths(mNode.Level - 1) = mCount
Else
levelengths(mNode.Level - 1) = Math.Max(mCount, levelengths(mNode.Level - 1))
End If
Else
levelengths(mNode.Level - 1) = Math.Max(mCount, levelengths(mNode.Level - 1))
End If
End Sub
Private Sub UpdateCode()
gNode.Item.gCode = ""
UpdateCode(gNode)
gNode.Item.gCode = New String("0"c, RightLength(0))
ReDim gItems(gList.Count - 1)
gList.CopyTo(gItems)
End Sub
Private Sub UpdateCode(ByVal node As Node(Of T))
For Each n As Node(Of T) In node.Nodes
n.Item.gCode = GetCode(n.Parent.Item.Code, n.Level, n.Index)
gList.Add(n.Item)
UpdateCode(n)
Next
End Sub
Private Function GetCode(ByVal parentCode As String, ByVal level As Integer, ByVal index As Integer) As String
Return String.Concat(GetParentKey(parentCode, level), GetCurrentID(index, level))
End Function
Private Function GetParentKey(ByVal parentCode As String, ByVal level As Integer) As String
Return parentCode.Substring(0, LeftLength(level - 1))
End Function
Private Function GetCurrentID(ByVal index As Integer, ByVal level As Integer) As String
Return (index + 1).ToString.PadLeft(gLevelLengths(level - 1), "0"c).PadRight(RightLength(level - 1), "0"c)
End Function
Private Function LeftLength(ByVal level As Integer) As Integer
Dim tmp As Integer = 0
For i As Integer = 0 To level - 1
tmp += gLevelLengths(i)
Next
Return tmp
End Function
Private Function RightLength(ByVal level As Integer) As Integer
Dim tmp As Integer = 0
For i As Integer = level To gLevelLengths.Length - 1
tmp += gLevelLengths(i)
Next
Return tmp
End Function
Private Sub Clear()
' gNode.Nodes.Clear()
gList.Clear()
gLevelLengths = Nothing
End Sub
End Class
End Namespace
''' <summary>
''' 处理树情形的数据,转换为Code,Name形式
''' </summary>
''' <typeparam name="T_ID_DataType">自联表键类型,或是Integer或是String</typeparam>
''' <typeparam name="T">自联表数据类</typeparam>
''' <remarks>LzmTW 20061111</remarks>
Friend Class SinceLinkBlankCodeNode(Of T_ID_DataType, T As SinceLinkItemBase(Of T_ID_DataType))
Private gList As New ArrayList
Private gItems As T()
Private gCodeFormat As String
Private gNode As Node(Of T)
Private gLevelLengths(0) As Integer
Public ReadOnly Property Items() As T()
Get
Return gItems
End Get
End Property
Public ReadOnly Property CodeFormat() As String
Get
Return gCodeFormat
End Get
End Property
Public Sub SetNode(ByVal node As Node(Of T))
gNode = node
GetlevelLengths()
UpdateCode()
Clear()
End Sub
Private Sub GetlevelLengths()
Dim mLevels As Integer = 0
GetLevelLengths(0, gNode, gLevelLengths, mLevels)
Dim tmpFormat(mLevels - 1) As String
For i As Integer = 0 To mLevels - 1
gLevelLengths(i) = gLevelLengths(i).ToString.Length
tmpFormat(i) = New String("0"c, gLevelLengths(i))
Next
gCodeFormat = String.Join(",", tmpFormat)
End Sub
Private Sub GetLevelLengths(ByVal ParentID As Object, ByVal node As Node(Of T), ByRef levelengths() As Integer, ByRef levels As Integer)
Dim mCount As Integer = node.Nodes.Count
If mCount = 0 Then Exit Sub
Dim mNode As Node(Of T) = Nothing
For Each mNode In node.gChildren
GetLevelLengths(node.Index, mNode, levelengths, levels)
Next
If mNode.Level > node.Level Then
If mNode.Level > levels Then
levels = mNode.Level
ReDim Preserve levelengths(levels - 1)
levelengths(mNode.Level - 1) = mCount
Else
levelengths(mNode.Level - 1) = Math.Max(mCount, levelengths(mNode.Level - 1))
End If
Else
levelengths(mNode.Level - 1) = Math.Max(mCount, levelengths(mNode.Level - 1))
End If
End Sub
Private Sub UpdateCode()
gNode.Item.gCode = ""
UpdateCode(gNode)
gNode.Item.gCode = New String("0"c, RightLength(0))
ReDim gItems(gList.Count - 1)
gList.CopyTo(gItems)
End Sub
Private Sub UpdateCode(ByVal node As Node(Of T))
For Each n As Node(Of T) In node.Nodes
n.Item.gCode = GetCode(n.Parent.Item.Code, n.Level, n.Index)
gList.Add(n.Item)
UpdateCode(n)
Next
End Sub
Private Function GetCode(ByVal parentCode As String, ByVal level As Integer, ByVal index As Integer) As String
Return String.Concat(GetParentKey(parentCode, level), GetCurrentID(index, level))
End Function
Private Function GetParentKey(ByVal parentCode As String, ByVal level As Integer) As String
Return parentCode.Substring(0, LeftLength(level - 1))
End Function
Private Function GetCurrentID(ByVal index As Integer, ByVal level As Integer) As String
Return (index + 1).ToString.PadLeft(gLevelLengths(level - 1), "0"c).PadRight(RightLength(level - 1), "0"c)
End Function
Private Function LeftLength(ByVal level As Integer) As Integer
Dim tmp As Integer = 0
For i As Integer = 0 To level - 1
tmp += gLevelLengths(i)
Next
Return tmp
End Function
Private Function RightLength(ByVal level As Integer) As Integer
Dim tmp As Integer = 0
For i As Integer = level To gLevelLengths.Length - 1
tmp += gLevelLengths(i)
Next
Return tmp
End Function
Private Sub Clear()
' gNode.Nodes.Clear()
gList.Clear()
gLevelLengths = Nothing
End Sub
End Class
End Namespace
Namespace LzmTW.uSystem.uCollection.SinceLink
''' <summary>
''' 析取Code的信息以生成树
''' </summary>
''' <remarks>LzmTW 20061111</remarks>
Friend Class SinceLinkCodeInformation
Private gCode As String
Private gCodeFormat As String = "00,00,00"
'当前层级
Private gLevel As Integer
'层数
Private gLevels As Integer
Private gID As String
Private gParentID As String
'代码的各组ID位数
Private gIDLengths() As Integer
Private gParentKey As String
Sub New(ByVal codeFormat As String)
gCodeFormat = codeFormat
Dim mIDArray() As String = gCodeFormat.Split(","c)
ReDim gIDLengths(mIDArray.Length - 1)
For i As Integer = 0 To mIDArray.Length - 1
gIDLengths(i) = mIDArray(i).Length
Next
gLevels = gIDLengths.Length
End Sub
Public ReadOnly Property Level() As Integer
Get
Return gLevel
End Get
End Property
Public ReadOnly Property Levels() As Integer
Get
Return gLevels
End Get
End Property
Public ReadOnly Property ID() As String
Get
Return gID
End Get
End Property
Public ReadOnly Property ParentID() As String
Get
Return gParentID
End Get
End Property
Public ReadOnly Property ParentKey() As String
Get
Return gParentKey
End Get
End Property
Public Sub SetCode(ByVal code As String)
gCode = code
GetIDInfos()
End Sub
Private Sub GetIDInfos()
Dim tmpIDInfos(gLevels - 1) As String
Dim mCurrentIndex As Integer = 0
For i As Integer = 0 To gLevels - 1
tmpIDInfos(i) = gCode.Substring(mCurrentIndex, gIDLengths(i))
mCurrentIndex += gIDLengths(i)
Next
For i As Integer = gLevels - 1 To 0 Step -1
If Not System.Text.RegularExpressions.Regex.IsMatch(tmpIDInfos(i), "^0+$") Then
gLevel = i + 1
gID = tmpIDInfos(i)
If i = 0 Then
gParentID = New String("0"c, gIDLengths(0))
gParentKey = New String("0"c, gIDLengths(0))
Else
gParentID = tmpIDInfos(i - 1)
For k As Integer = 0 To i - 1
gParentKey += tmpIDInfos(k)
Next
End If
Exit For
End If
Next
End Sub
End Class
End Namespace
''' <summary>
''' 析取Code的信息以生成树
''' </summary>
''' <remarks>LzmTW 20061111</remarks>
Friend Class SinceLinkCodeInformation
Private gCode As String
Private gCodeFormat As String = "00,00,00"
'当前层级
Private gLevel As Integer
'层数
Private gLevels As Integer
Private gID As String
Private gParentID As String
'代码的各组ID位数
Private gIDLengths() As Integer
Private gParentKey As String
Sub New(ByVal codeFormat As String)
gCodeFormat = codeFormat
Dim mIDArray() As String = gCodeFormat.Split(","c)
ReDim gIDLengths(mIDArray.Length - 1)
For i As Integer = 0 To mIDArray.Length - 1
gIDLengths(i) = mIDArray(i).Length
Next
gLevels = gIDLengths.Length
End Sub
Public ReadOnly Property Level() As Integer
Get
Return gLevel
End Get
End Property
Public ReadOnly Property Levels() As Integer
Get
Return gLevels
End Get
End Property
Public ReadOnly Property ID() As String
Get
Return gID
End Get
End Property
Public ReadOnly Property ParentID() As String
Get
Return gParentID
End Get
End Property
Public ReadOnly Property ParentKey() As String
Get
Return gParentKey
End Get
End Property
Public Sub SetCode(ByVal code As String)
gCode = code
GetIDInfos()
End Sub
Private Sub GetIDInfos()
Dim tmpIDInfos(gLevels - 1) As String
Dim mCurrentIndex As Integer = 0
For i As Integer = 0 To gLevels - 1
tmpIDInfos(i) = gCode.Substring(mCurrentIndex, gIDLengths(i))
mCurrentIndex += gIDLengths(i)
Next
For i As Integer = gLevels - 1 To 0 Step -1
If Not System.Text.RegularExpressions.Regex.IsMatch(tmpIDInfos(i), "^0+$") Then
gLevel = i + 1
gID = tmpIDInfos(i)
If i = 0 Then
gParentID = New String("0"c, gIDLengths(0))
gParentKey = New String("0"c, gIDLengths(0))
Else
gParentID = tmpIDInfos(i - 1)
For k As Integer = 0 To i - 1
gParentKey += tmpIDInfos(k)
Next
End If
Exit For
End If
Next
End Sub
End Class
End Namespace
LzmTW 20061111
