Author:水如烟
身份证的前6位就是表示开出身份证所在地的区划代码。
图:测试示图
类:
''' -----------------------------------------------------------------------------
''' Project : LzmTW.Common
''' Class : Common.RegionalCodeClass
'''
''' -----------------------------------------------------------------------------
''' <summary>
''' 全国县及县以上行政区划代码信息类
''' </summary>
''' <remarks>
''' 代码由六位数字组成,每两位数字一组共三组,即XX XX XX,意义如下:
'''首组,代表省;
'''中组,其中01-20、51-70表示省直辖市,21-50表示地区(州、盟);
'''尾组,01-18表示市辖区或地辖区,21-80表示县(旗),81-99表示省直辖县级市。
'''国家统计局设管司 2005-08-01 15:56:18;
'''最新数据截止2005年6月30日;
'''数据更新网址: http://www.stats.gov.cn/tjbz/xzqhdm/index.htm;
'''数据表明,实际应是:
'''首组,代表省;
'''中组,其中01-20、51-99表示省直辖市,21-50表示地区(州、盟);
'''尾组,01-20表示市辖区或地辖区,21-80表示县(旗),81-99表示省直辖县级市。
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Class RegionalCodeClassClass RegionalCodeClass
Private _Collection As RegionalCollection
Private _Enumerator As System.Collections.IDictionaryEnumerator
'默认数据文件
Private _TxtFile As String = System.AppDomain.CurrentDomain.BaseDirectory & "\全国行政区划代码.txt"
Private _XmlFile As String = System.AppDomain.CurrentDomain.BaseDirectory & "\全国行政区划代码.xml"
Sub New()Sub New()
_Collection = New RegionalCollection
End Sub
对外属性#Region "对外属性"
''' -----------------------------------------------------------------------------
''' <summary>
''' 区划信息
''' </summary>
''' <param name="iCode">代码</param>
''' <value>区划</value>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Default Public ReadOnly Property Item()Property Item(ByVal iCode As String) As Regional
Get
Return _Collection.Item(iCode)
End Get
End Property
''' -----------------------------------------------------------------------------
''' <summary>
''' 区划集
''' </summary>
''' <value>区划</value>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public ReadOnly Property Items()Property Items() As Regional()
Get
Dim tmp(_Collection.Count - 1) As Regional
Dim n As Integer = 0
_Enumerator = _Collection.GetEnumerator
With _Enumerator
While .MoveNext
tmp(n) = CType(.Value, Regional)
n += 1
End While
End With
Return tmp
End Get
End Property
#End Region
装入数据方式#Region "装入数据方式"
''' -----------------------------------------------------------------------------
''' <summary>
''' 从文本文件导入数据
''' </summary>
''' <remarks>
''' 默认文件为程序运行目录下的"全国行政区划代码.txt"
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub LoadFromTxt()Sub LoadFromTxt()
If Not System.IO.File.Exists(_TxtFile) Then
MsgBox("文件不存在!")
Exit Sub
End If
Me.Load_BeforBegin()
Dim fs As IO.FileStream = New IO.FileStream(_TxtFile, IO.FileMode.Open)
Dim sr As IO.StreamReader = New IO.StreamReader(fs, System.Text.Encoding.Default)
Dim Line As String
Dim tmpCode As String
Dim tmpName As String
While sr.Peek <> -1
Line = sr.ReadLine.Trim '除去前后空格
If Line.Length > 6 Then
tmpCode = Line.Substring(0, 6)
tmpName = Line.Substring(6)
Add(tmpCode, tmpName)
End If
End While
sr.Close()
fs.Close()
Me.Load_AfterDataFinish()
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 从文本文件导入数据
''' </summary>
''' <param name="FileName">文件名</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub LoadFromTxt()Sub LoadFromTxt(ByVal FileName As String)
_TxtFile = FileName
LoadFromTxt()
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 从DataTable导入数据
''' </summary>
''' <param name="Table">DataTable</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub LoadFromTable()Sub LoadFromTable(ByVal Table As DataTable)
If Table Is Nothing OrElse Table.Rows.Count = 0 Then
MsgBox("没数据!")
Exit Sub
End If
Me.Load_BeforBegin()
Dim tmpCode As String
Dim tmpName As String
For Each row As DataRow In Table.Rows
tmpCode = row.Item(0)
tmpName = row.Item(1)
Add(tmpCode, tmpName)
Next
Me.Load_AfterDataFinish()
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 从xml文件导入数据
''' </summary>
''' <remarks>
''' 默认文件为程序运行目录下的"全国行政区划代码.xml"
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub LoadFromXml()Sub LoadFromXml()
If Not System.IO.File.Exists(_XmlFile) Then
MsgBox("文件不存在!")
Exit Sub
End If
Dim tmpDataSet As New DataSet
tmpDataSet.ReadXml(_XmlFile)
If tmpDataSet.Tables.Count = 0 OrElse tmpDataSet.Tables(0).Rows.Count = 0 Then
MsgBox("没有数据,或文件不符!")
Exit Sub
End If
Me.LoadFromTable(tmpDataSet.Tables(0))
tmpDataSet.Clear()
tmpDataSet.Dispose()
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 从xml文件导入数据
''' </summary>
''' <param name="FileName">文件名</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub LoadFromXml()Sub LoadFromXml(ByVal FileName As String)
_XmlFile = FileName
LoadFromXml()
End Sub
Private Sub Add()Sub Add(ByVal iCode As String, ByVal iName As String)
iCode = iCode.Trim
iName = iName.Trim
If iCode.Length = 6 AndAlso Microsoft.VisualBasic.IsNumeric(iCode) Then '保证是六位数字
Dim tmp As Regional = New Regional(iCode, iName)
_Collection.Add(tmp)
End If
End Sub
'装入数据前的处理
Private Sub Load_BeforBegin()Sub Load_BeforBegin()
_Collection.Clear()
End Sub
'装入数据后的处理
Private Sub Load_AfterDataFinish()Sub Load_AfterDataFinish()
Dim tmp As Regional() = Me.Items
Me.Sort(tmp)
For Each o As Regional In tmp
Me.IniRegionalFullName(o)
Next
End Sub
'取全名
Private Sub IniRegionalFullName()Sub IniRegionalFullName(ByVal iRegional As Regional)
Dim iCode As String
iCode = iRegional.Code
Dim tmp1 As Regional
Dim tmp2 As Regional
Select Case Convert.ToInt16(iCode.Substring(2, 2)) '中组
Case 0 'XX00XX
Select Case Convert.ToInt16(iCode.Substring(4, 2)) '尾组
Case 0 'XX0000
iRegional.FullName = iRegional.Name
Case Else 'XX00--
'未定义
End Select
Case Else 'XX--XX
Select Case Convert.ToInt16(iCode.Substring(4, 2)) '尾组
Case 0 'XX--00
tmp1 = Me.Item(iCode.Substring(0, 2) & "0000")
If Not tmp1 Is Nothing Then iRegional.FullName = tmp1.Name & iRegional.Name
Case Else 'XX----
tmp1 = Me.Item(iCode.Substring(0, 2) & "0000")
If Not tmp1 Is Nothing Then
tmp2 = Me.Item(iCode.Substring(0, 4) & "00")
If Not tmp2 Is Nothing Then
If tmp1.Name.EndsWith("市") Then
iRegional.FullName = tmp1.Name & iRegional.Name
Else
iRegional.FullName = tmp2.FullName & iRegional.Name
End If
End If
End If
End Select
End Select
End Sub
#End Region
导出数据方式#Region "导出数据方式"
''' -----------------------------------------------------------------------------
''' <summary>
''' 导出到xml文件
''' </summary>
''' <remarks>
''' 默认文件为程序运行目录下的"全国行政区划代码.xml"
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub WriteXml()Sub WriteXml()
If _Collection.Count = 0 Then
MsgBox("没有数据!")
Exit Sub
End If
Dim tmpDataSet As New DataSet
Dim Table As New DataTable
Table.Columns.AddRange(New DataColumn() {New DataColumn("Code"), New DataColumn("Name")})
WriteTable(Table)
tmpDataSet.Tables.Add(Table)
Try
tmpDataSet.WriteXml(_XmlFile)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Table.Clear()
Table.Dispose()
tmpDataSet.Clear()
tmpDataSet.Dispose()
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 导出到xml文件
''' </summary>
''' <param name="FileName">文件名</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub WriteXml()Sub WriteXml(ByVal FileName As String)
_XmlFile = FileName
WriteXml()
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 导出到DataTable
''' </summary>
''' <param name="Table">DataTable</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub WriteTable()Sub WriteTable(ByVal Table As DataTable)
If _Collection.Count = 0 Then
MsgBox("没有数据!")
Exit Sub
End If
Table.Clear()
Sort(Me.Items)
With Table
.BeginInit()
For Each r As Regional In Me.Items
.Rows.Add(New String() {r.Code, r.Name})
Next
'不作AcceptChanges处理,便于上载到数据库
.EndInit()
End With
End Sub
#End Region
排序方式#Region "排序方式"
''' -----------------------------------------------------------------------------
''' <summary>
''' 排序
''' </summary>
''' <param name="Array">区划集</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub Sort()Sub Sort(ByVal Array As Regional())
If Array Is Nothing OrElse Array.Length = 0 Then Exit Sub
System.Array.Sort(Array, New RegionalCompare)
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 逆序
''' </summary>
''' <param name="Array">区划集</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub Reverse()Sub Reverse(ByVal Array As Regional())
If Array Is Nothing OrElse Array.Length = 0 Then Exit Sub
System.Array.Reverse(Array)
End Sub
#End Region
查找方式#Region "查找方式"
Dim sNowItems() As Regional
Dim sTmpRegion() As Regional
Dim sCount As Integer
Private Sub Search_Begin()Sub Search_Begin()
ReDim sTmpRegion(-1)
sCount = 0
snowitems = Me.Items
Me.Sort(sNowItems)
End Sub
Private Sub Search_Add()Sub Search_Add(ByVal sRegional As Regional)
ReDim Preserve sTmpRegion(sCount)
sTmpRegion(sCount) = sRegional
sCount += 1
End Sub
Private Sub Search_Way()Sub Search_Way(ByVal Value As String, ByVal Way As String)
For Each o As Regional In sNowItems
Select Case Way
Case "Code"
If o.Code Like Value Then
Search_Add(o)
End If
Case "Name"
If o.Name Like Value Then
Search_Add(o)
End If
Case "Kind"
If o.Kind.ToString Like Value Then
Search_Add(o)
End If
Case Else
End Select
Next
End Sub
Private Sub Search_Way()Sub Search_Way(ByVal Value As Regional.KindType)
For Each o As Regional In sNowItems
If o.Kind.Equals(Value) Then
Search_Add(o)
End If
Next
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 按代码查询
''' </summary>
''' <param name="iCode">代码</param>
''' <returns>区划集</returns>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Function SearchByCode()Function SearchByCode(ByVal iCode As String) As Regional()
Search_Begin()
Search_Way(iCode, "Code")
Return sTmpRegion
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' 按名称查询
''' </summary>
''' <param name="iName">名称</param>
''' <returns>区划集</returns>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Function SearchByName()Function SearchByName(ByVal iName As String) As Regional()
Search_Begin()
Search_Way(iName, "Name")
Return sTmpRegion
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' 按类型查询
''' </summary>
''' <param name="iKind">类型</param>
''' <returns>区划集</returns>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Function SearchByKind()Function SearchByKind(ByVal iKind As String) As Regional()
Search_Begin()
Search_Way(iKind, "Kind")
Return sTmpRegion
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' 按类型查询
''' </summary>
''' <param name="iKind">类型</param>
''' <returns>区划集</returns>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Function SearchByKind()Function SearchByKind(ByVal iKind As Regional.KindType) As Regional()
Search_Begin()
Search_Way(iKind)
Return sTmpRegion
End Function
#End Region
基本定义#Region "基本定义"
''' -----------------------------------------------------------------------------
''' Project : LzmTW.Common
''' Class : Common.RegionalCodeClass.RegionalCompare
'''
''' -----------------------------------------------------------------------------
''' <summary>
''' 按区划的代码排序
''' </summary>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Private Class RegionalCompareClass RegionalCompare
Implements System.Collections.IComparer
Public Function Compare()Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements System.Collections.IComparer.Compare
Return CType(x, Regional).Code.CompareTo(CType(y, Regional).Code)
End Function
End Class
''' -----------------------------------------------------------------------------
''' Project : LzmTW.Common
''' Class : Common.RegionalCodeClass.RegionalCollection
'''
''' -----------------------------------------------------------------------------
''' <summary>
''' 数据字典
''' </summary>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Private Class RegionalCollectionClass RegionalCollection
Inherits System.Collections.DictionaryBase
Public Sub Add()Sub Add(ByVal iItem As Regional)
Me.Dictionary.Add(iItem.Code, iItem)
End Sub
Public Sub Remove()Sub Remove(ByVal Code As String)
Me.Dictionary.Remove(Code)
End Sub
Default Public ReadOnly Property Item()Property Item(ByVal Code As String) As Regional
Get
Return CType(Me.Dictionary.Item(Code), Regional)
End Get
End Property
End Class
''' -----------------------------------------------------------------------------
''' Project : LzmTW.Common
''' Class : Common.RegionalCodeClass.Regional
'''
''' -----------------------------------------------------------------------------
''' <summary>
''' 区划定义
''' </summary>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Class RegionalClass Regional
Private _Code As String
Private _Name As String
Private _FullName As String
Private _Kind As KindType
''' -----------------------------------------------------------------------------
''' <summary>
''' New
''' </summary>
''' <param name="iCode">区划码</param>
''' <param name="iName">名称</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Sub New()Sub New(ByVal iCode As String, ByVal iName As String)
_Code = iCode
_Name = iName
_Kind = GetKind(iCode) '取类型
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 区划码
''' </summary>
''' <value></value>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public ReadOnly Property Code()Property Code() As String
Get
Return _Code
End Get
End Property
''' -----------------------------------------------------------------------------
''' <summary>
''' 名称
''' </summary>
''' <value></value>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public ReadOnly Property Name()Property Name() As String
Get
Return _Name
End Get
End Property
''' -----------------------------------------------------------------------------
''' <summary>
''' 全名
''' </summary>
''' <value></value>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Property FullName()Property FullName() As String
Get
Return _FullName
End Get
Set(ByVal Value As String)
_FullName = Value
End Set
End Property
''' -----------------------------------------------------------------------------
''' <summary>
''' 区划类型
''' </summary>
''' <value></value>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public ReadOnly Property Kind()Property Kind() As KindType
Get
Return _Kind
End Get
End Property
''' -----------------------------------------------------------------------------
''' <summary>
''' 转换数组
''' </summary>
''' <returns></returns>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Function ToArray()Function ToArray() As Array
Return New String() {_Code, _Name, _FullName, _Kind.ToString}
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' 基本信息
''' </summary>
''' <returns></returns>
''' <remarks>
''' 如:110107 北京市石景山区
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Overrides Function ToString()Function ToString() As String
Return _Code & " " & _FullName
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' 取区划类型
''' </summary>
''' <param name="iCode"></param>
''' <returns></returns>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Private Function GetKind()Function GetKind(ByVal iCode As String) As KindType
Dim Result As KindType = KindType.未定义
Select Case Convert.ToInt16(iCode.Substring(2, 2)) '中组
Case 0 'XX00XX
Select Case Convert.ToInt16(iCode.Substring(4, 2)) '尾组
Case 0 'XX0000
Result = KindType.省
Case Else 'XX00--
'未定义
End Select
Case Else 'XX--XX
Select Case Convert.ToInt16(iCode.Substring(4, 2)) '尾组
Case 0 'XX--00
Select Case Convert.ToInt16(iCode.Substring(2, 2)) '中组
Case 1 To 20
Result = KindType.省直辖市
Case 21 To 50
Result = KindType.地区含州或盟
Case 51 To 99
Result = KindType.省直辖市
End Select
'XX----
Case 1 To 20
Result = KindType.市辖区或地辖区
Case 21 To 80
Result = KindType.县或旗
Case 81 To 99
Result = KindType.省直辖县级市
Case Else
'未定义
End Select
End Select
Return Result
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' 区划类型
''' </summary>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Enum KindTypeEnum KindType
省
省直辖市
地区含州或盟
市辖区或地辖区
县或旗
省直辖县级市
未定义
End Enum
End Class
#End Region
End Class
''' Project : LzmTW.Common
''' Class : Common.RegionalCodeClass
'''
''' -----------------------------------------------------------------------------
''' <summary>
''' 全国县及县以上行政区划代码信息类
''' </summary>
''' <remarks>
''' 代码由六位数字组成,每两位数字一组共三组,即XX XX XX,意义如下:
'''首组,代表省;
'''中组,其中01-20、51-70表示省直辖市,21-50表示地区(州、盟);
'''尾组,01-18表示市辖区或地辖区,21-80表示县(旗),81-99表示省直辖县级市。
'''国家统计局设管司 2005-08-01 15:56:18;
'''最新数据截止2005年6月30日;
'''数据更新网址: http://www.stats.gov.cn/tjbz/xzqhdm/index.htm;
'''数据表明,实际应是:
'''首组,代表省;
'''中组,其中01-20、51-99表示省直辖市,21-50表示地区(州、盟);
'''尾组,01-20表示市辖区或地辖区,21-80表示县(旗),81-99表示省直辖县级市。
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Class RegionalCodeClassClass RegionalCodeClass
Private _Collection As RegionalCollection
Private _Enumerator As System.Collections.IDictionaryEnumerator
'默认数据文件
Private _TxtFile As String = System.AppDomain.CurrentDomain.BaseDirectory & "\全国行政区划代码.txt"
Private _XmlFile As String = System.AppDomain.CurrentDomain.BaseDirectory & "\全国行政区划代码.xml"
Sub New()Sub New()
_Collection = New RegionalCollection
End Sub
对外属性#Region "对外属性"
''' -----------------------------------------------------------------------------
''' <summary>
''' 区划信息
''' </summary>
''' <param name="iCode">代码</param>
''' <value>区划</value>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Default Public ReadOnly Property Item()Property Item(ByVal iCode As String) As Regional
Get
Return _Collection.Item(iCode)
End Get
End Property
''' -----------------------------------------------------------------------------
''' <summary>
''' 区划集
''' </summary>
''' <value>区划</value>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public ReadOnly Property Items()Property Items() As Regional()
Get
Dim tmp(_Collection.Count - 1) As Regional
Dim n As Integer = 0
_Enumerator = _Collection.GetEnumerator
With _Enumerator
While .MoveNext
tmp(n) = CType(.Value, Regional)
n += 1
End While
End With
Return tmp
End Get
End Property
#End Region
装入数据方式#Region "装入数据方式"
''' -----------------------------------------------------------------------------
''' <summary>
''' 从文本文件导入数据
''' </summary>
''' <remarks>
''' 默认文件为程序运行目录下的"全国行政区划代码.txt"
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub LoadFromTxt()Sub LoadFromTxt()
If Not System.IO.File.Exists(_TxtFile) Then
MsgBox("文件不存在!")
Exit Sub
End If
Me.Load_BeforBegin()
Dim fs As IO.FileStream = New IO.FileStream(_TxtFile, IO.FileMode.Open)
Dim sr As IO.StreamReader = New IO.StreamReader(fs, System.Text.Encoding.Default)
Dim Line As String
Dim tmpCode As String
Dim tmpName As String
While sr.Peek <> -1
Line = sr.ReadLine.Trim '除去前后空格
If Line.Length > 6 Then
tmpCode = Line.Substring(0, 6)
tmpName = Line.Substring(6)
Add(tmpCode, tmpName)
End If
End While
sr.Close()
fs.Close()
Me.Load_AfterDataFinish()
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 从文本文件导入数据
''' </summary>
''' <param name="FileName">文件名</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub LoadFromTxt()Sub LoadFromTxt(ByVal FileName As String)
_TxtFile = FileName
LoadFromTxt()
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 从DataTable导入数据
''' </summary>
''' <param name="Table">DataTable</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub LoadFromTable()Sub LoadFromTable(ByVal Table As DataTable)
If Table Is Nothing OrElse Table.Rows.Count = 0 Then
MsgBox("没数据!")
Exit Sub
End If
Me.Load_BeforBegin()
Dim tmpCode As String
Dim tmpName As String
For Each row As DataRow In Table.Rows
tmpCode = row.Item(0)
tmpName = row.Item(1)
Add(tmpCode, tmpName)
Next
Me.Load_AfterDataFinish()
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 从xml文件导入数据
''' </summary>
''' <remarks>
''' 默认文件为程序运行目录下的"全国行政区划代码.xml"
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub LoadFromXml()Sub LoadFromXml()
If Not System.IO.File.Exists(_XmlFile) Then
MsgBox("文件不存在!")
Exit Sub
End If
Dim tmpDataSet As New DataSet
tmpDataSet.ReadXml(_XmlFile)
If tmpDataSet.Tables.Count = 0 OrElse tmpDataSet.Tables(0).Rows.Count = 0 Then
MsgBox("没有数据,或文件不符!")
Exit Sub
End If
Me.LoadFromTable(tmpDataSet.Tables(0))
tmpDataSet.Clear()
tmpDataSet.Dispose()
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 从xml文件导入数据
''' </summary>
''' <param name="FileName">文件名</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub LoadFromXml()Sub LoadFromXml(ByVal FileName As String)
_XmlFile = FileName
LoadFromXml()
End Sub
Private Sub Add()Sub Add(ByVal iCode As String, ByVal iName As String)
iCode = iCode.Trim
iName = iName.Trim
If iCode.Length = 6 AndAlso Microsoft.VisualBasic.IsNumeric(iCode) Then '保证是六位数字
Dim tmp As Regional = New Regional(iCode, iName)
_Collection.Add(tmp)
End If
End Sub
'装入数据前的处理
Private Sub Load_BeforBegin()Sub Load_BeforBegin()
_Collection.Clear()
End Sub
'装入数据后的处理
Private Sub Load_AfterDataFinish()Sub Load_AfterDataFinish()
Dim tmp As Regional() = Me.Items
Me.Sort(tmp)
For Each o As Regional In tmp
Me.IniRegionalFullName(o)
Next
End Sub
'取全名
Private Sub IniRegionalFullName()Sub IniRegionalFullName(ByVal iRegional As Regional)
Dim iCode As String
iCode = iRegional.Code
Dim tmp1 As Regional
Dim tmp2 As Regional
Select Case Convert.ToInt16(iCode.Substring(2, 2)) '中组
Case 0 'XX00XX
Select Case Convert.ToInt16(iCode.Substring(4, 2)) '尾组
Case 0 'XX0000
iRegional.FullName = iRegional.Name
Case Else 'XX00--
'未定义
End Select
Case Else 'XX--XX
Select Case Convert.ToInt16(iCode.Substring(4, 2)) '尾组
Case 0 'XX--00
tmp1 = Me.Item(iCode.Substring(0, 2) & "0000")
If Not tmp1 Is Nothing Then iRegional.FullName = tmp1.Name & iRegional.Name
Case Else 'XX----
tmp1 = Me.Item(iCode.Substring(0, 2) & "0000")
If Not tmp1 Is Nothing Then
tmp2 = Me.Item(iCode.Substring(0, 4) & "00")
If Not tmp2 Is Nothing Then
If tmp1.Name.EndsWith("市") Then
iRegional.FullName = tmp1.Name & iRegional.Name
Else
iRegional.FullName = tmp2.FullName & iRegional.Name
End If
End If
End If
End Select
End Select
End Sub
#End Region
导出数据方式#Region "导出数据方式"
''' -----------------------------------------------------------------------------
''' <summary>
''' 导出到xml文件
''' </summary>
''' <remarks>
''' 默认文件为程序运行目录下的"全国行政区划代码.xml"
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub WriteXml()Sub WriteXml()
If _Collection.Count = 0 Then
MsgBox("没有数据!")
Exit Sub
End If
Dim tmpDataSet As New DataSet
Dim Table As New DataTable
Table.Columns.AddRange(New DataColumn() {New DataColumn("Code"), New DataColumn("Name")})
WriteTable(Table)
tmpDataSet.Tables.Add(Table)
Try
tmpDataSet.WriteXml(_XmlFile)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Table.Clear()
Table.Dispose()
tmpDataSet.Clear()
tmpDataSet.Dispose()
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 导出到xml文件
''' </summary>
''' <param name="FileName">文件名</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub WriteXml()Sub WriteXml(ByVal FileName As String)
_XmlFile = FileName
WriteXml()
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 导出到DataTable
''' </summary>
''' <param name="Table">DataTable</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub WriteTable()Sub WriteTable(ByVal Table As DataTable)
If _Collection.Count = 0 Then
MsgBox("没有数据!")
Exit Sub
End If
Table.Clear()
Sort(Me.Items)
With Table
.BeginInit()
For Each r As Regional In Me.Items
.Rows.Add(New String() {r.Code, r.Name})
Next
'不作AcceptChanges处理,便于上载到数据库
.EndInit()
End With
End Sub
#End Region
排序方式#Region "排序方式"
''' -----------------------------------------------------------------------------
''' <summary>
''' 排序
''' </summary>
''' <param name="Array">区划集</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub Sort()Sub Sort(ByVal Array As Regional())
If Array Is Nothing OrElse Array.Length = 0 Then Exit Sub
System.Array.Sort(Array, New RegionalCompare)
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 逆序
''' </summary>
''' <param name="Array">区划集</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub Reverse()Sub Reverse(ByVal Array As Regional())
If Array Is Nothing OrElse Array.Length = 0 Then Exit Sub
System.Array.Reverse(Array)
End Sub
#End Region
查找方式#Region "查找方式"
Dim sNowItems() As Regional
Dim sTmpRegion() As Regional
Dim sCount As Integer
Private Sub Search_Begin()Sub Search_Begin()
ReDim sTmpRegion(-1)
sCount = 0
snowitems = Me.Items
Me.Sort(sNowItems)
End Sub
Private Sub Search_Add()Sub Search_Add(ByVal sRegional As Regional)
ReDim Preserve sTmpRegion(sCount)
sTmpRegion(sCount) = sRegional
sCount += 1
End Sub
Private Sub Search_Way()Sub Search_Way(ByVal Value As String, ByVal Way As String)
For Each o As Regional In sNowItems
Select Case Way
Case "Code"
If o.Code Like Value Then
Search_Add(o)
End If
Case "Name"
If o.Name Like Value Then
Search_Add(o)
End If
Case "Kind"
If o.Kind.ToString Like Value Then
Search_Add(o)
End If
Case Else
End Select
Next
End Sub
Private Sub Search_Way()Sub Search_Way(ByVal Value As Regional.KindType)
For Each o As Regional In sNowItems
If o.Kind.Equals(Value) Then
Search_Add(o)
End If
Next
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 按代码查询
''' </summary>
''' <param name="iCode">代码</param>
''' <returns>区划集</returns>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Function SearchByCode()Function SearchByCode(ByVal iCode As String) As Regional()
Search_Begin()
Search_Way(iCode, "Code")
Return sTmpRegion
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' 按名称查询
''' </summary>
''' <param name="iName">名称</param>
''' <returns>区划集</returns>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Function SearchByName()Function SearchByName(ByVal iName As String) As Regional()
Search_Begin()
Search_Way(iName, "Name")
Return sTmpRegion
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' 按类型查询
''' </summary>
''' <param name="iKind">类型</param>
''' <returns>区划集</returns>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Function SearchByKind()Function SearchByKind(ByVal iKind As String) As Regional()
Search_Begin()
Search_Way(iKind, "Kind")
Return sTmpRegion
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' 按类型查询
''' </summary>
''' <param name="iKind">类型</param>
''' <returns>区划集</returns>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Function SearchByKind()Function SearchByKind(ByVal iKind As Regional.KindType) As Regional()
Search_Begin()
Search_Way(iKind)
Return sTmpRegion
End Function
#End Region
基本定义#Region "基本定义"
''' -----------------------------------------------------------------------------
''' Project : LzmTW.Common
''' Class : Common.RegionalCodeClass.RegionalCompare
'''
''' -----------------------------------------------------------------------------
''' <summary>
''' 按区划的代码排序
''' </summary>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Private Class RegionalCompareClass RegionalCompare
Implements System.Collections.IComparer
Public Function Compare()Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements System.Collections.IComparer.Compare
Return CType(x, Regional).Code.CompareTo(CType(y, Regional).Code)
End Function
End Class
''' -----------------------------------------------------------------------------
''' Project : LzmTW.Common
''' Class : Common.RegionalCodeClass.RegionalCollection
'''
''' -----------------------------------------------------------------------------
''' <summary>
''' 数据字典
''' </summary>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Private Class RegionalCollectionClass RegionalCollection
Inherits System.Collections.DictionaryBase
Public Sub Add()Sub Add(ByVal iItem As Regional)
Me.Dictionary.Add(iItem.Code, iItem)
End Sub
Public Sub Remove()Sub Remove(ByVal Code As String)
Me.Dictionary.Remove(Code)
End Sub
Default Public ReadOnly Property Item()Property Item(ByVal Code As String) As Regional
Get
Return CType(Me.Dictionary.Item(Code), Regional)
End Get
End Property
End Class
''' -----------------------------------------------------------------------------
''' Project : LzmTW.Common
''' Class : Common.RegionalCodeClass.Regional
'''
''' -----------------------------------------------------------------------------
''' <summary>
''' 区划定义
''' </summary>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-24 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Class RegionalClass Regional
Private _Code As String
Private _Name As String
Private _FullName As String
Private _Kind As KindType
''' -----------------------------------------------------------------------------
''' <summary>
''' New
''' </summary>
''' <param name="iCode">区划码</param>
''' <param name="iName">名称</param>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Sub New()Sub New(ByVal iCode As String, ByVal iName As String)
_Code = iCode
_Name = iName
_Kind = GetKind(iCode) '取类型
End Sub
''' -----------------------------------------------------------------------------
''' <summary>
''' 区划码
''' </summary>
''' <value></value>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public ReadOnly Property Code()Property Code() As String
Get
Return _Code
End Get
End Property
''' -----------------------------------------------------------------------------
''' <summary>
''' 名称
''' </summary>
''' <value></value>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public ReadOnly Property Name()Property Name() As String
Get
Return _Name
End Get
End Property
''' -----------------------------------------------------------------------------
''' <summary>
''' 全名
''' </summary>
''' <value></value>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Property FullName()Property FullName() As String
Get
Return _FullName
End Get
Set(ByVal Value As String)
_FullName = Value
End Set
End Property
''' -----------------------------------------------------------------------------
''' <summary>
''' 区划类型
''' </summary>
''' <value></value>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public ReadOnly Property Kind()Property Kind() As KindType
Get
Return _Kind
End Get
End Property
''' -----------------------------------------------------------------------------
''' <summary>
''' 转换数组
''' </summary>
''' <returns></returns>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Function ToArray()Function ToArray() As Array
Return New String() {_Code, _Name, _FullName, _Kind.ToString}
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' 基本信息
''' </summary>
''' <returns></returns>
''' <remarks>
''' 如:110107 北京市石景山区
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Overrides Function ToString()Function ToString() As String
Return _Code & " " & _FullName
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' 取区划类型
''' </summary>
''' <param name="iCode"></param>
''' <returns></returns>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Private Function GetKind()Function GetKind(ByVal iCode As String) As KindType
Dim Result As KindType = KindType.未定义
Select Case Convert.ToInt16(iCode.Substring(2, 2)) '中组
Case 0 'XX00XX
Select Case Convert.ToInt16(iCode.Substring(4, 2)) '尾组
Case 0 'XX0000
Result = KindType.省
Case Else 'XX00--
'未定义
End Select
Case Else 'XX--XX
Select Case Convert.ToInt16(iCode.Substring(4, 2)) '尾组
Case 0 'XX--00
Select Case Convert.ToInt16(iCode.Substring(2, 2)) '中组
Case 1 To 20
Result = KindType.省直辖市
Case 21 To 50
Result = KindType.地区含州或盟
Case 51 To 99
Result = KindType.省直辖市
End Select
'XX----
Case 1 To 20
Result = KindType.市辖区或地辖区
Case 21 To 80
Result = KindType.县或旗
Case 81 To 99
Result = KindType.省直辖县级市
Case Else
'未定义
End Select
End Select
Return Result
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' 区划类型
''' </summary>
''' <remarks>
''' </remarks>
''' <history>
''' [lzmtw] 2005-10-23 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Enum KindTypeEnum KindType
省
省直辖市
地区含州或盟
市辖区或地辖区
县或旗
省直辖县级市
未定义
End Enum
End Class
#End Region
End Class
测试代码:
数据文件: 全国行政区划代码.txt