行政区划程序的设计(十二)

Author：水如烟

总目录：行政区划数据方案设计

 上一篇，行政区划程序的设计(十一)

这篇是 IClientProvideServices的实现，代码稍长。

如何从网上下载数据，方法多多，因人因境不一样（我直接用复制粘贴成文本再处理也成）。
这里，我还是沿用Excel的QueryTable方法。

因为这个方法的代码仅适合于这个项目，因此类限定为Friend，命名空间为NET。
在这里，也考虑了Excel的安全退出。下面两个类不依赖任何项目。

NetInformation.vb

Imports System.Net
Imports System.IO
Imports System.Text.RegularExpressions

Namespace NET
    Friend Class NetInformation
        Private gNetUpdateInformations(-1) As NetUpdateInformationItem
        Private gUpdateInformationsTable As DataTable

        ''' <summary>
        ''' 可利用的下载信息
        ''' </summary>
        ''' <remarks>表列名分别是:Address,数据网址;LastDate,版本日期</remarks>
        Public ReadOnly Property UpdateInformationsTable() As DataTable
            Get
                Return gUpdateInformationsTable
            End Get
        End Property

        ''' <summary>
        ''' 从政府发布网页中取下载信息
        ''' </summary>
        ''' <param name="issueNetAddress">发布网页地址</param>
        ''' <remarks></remarks>
        Public Sub DownloadInformationsFromNet(ByVal issueNetAddress As String)

            Dim mNetUpdateItems As NetUpdateItem() = GetNetUpdateItems(issueNetAddress)
            Dim mNetUpdateInformationItem As NetUpdateInformationItem

            Dim mRegex As New Regex("(?<date>2.*日)")
            Dim tmp As NetUpdateItem
            '由于后两个不合规则，舍去不用。最后一个没有日期，倒数第二个提供的是附件数据。
            For i As Integer = 0 To mNetUpdateItems.Length - 1 - 2
                tmp = mNetUpdateItems(i)

                mNetUpdateInformationItem = New NetUpdateInformationItem
                With mNetUpdateInformationItem
                    .Address = tmp.Address
                    .LastDate = CType(mRegex.Match(tmp.Content).Value, Date).ToString("yyyyMMdd")
                End With

                AppendItem(Of NetUpdateInformationItem)(mNetUpdateInformationItem, gNetUpdateInformations)
            Next

            gUpdateInformationsTable = Me.GetUpdateInformationsTable
        End Sub

        Private Function GetNetUpdateItems(ByVal issueNetAddress As String) As NetUpdateItem()

            Dim mResult(-1) As NetUpdateItem

            Dim mRegex As New Regex("<a href='(?<href>.*)' target='_blank' >(?<content>.*行政区划代码.*)</a>")
            Dim mCollection As MatchCollection

            Dim mClient As New WebClient()

            Dim mStream As Stream = mClient.OpenRead(issueNetAddress)
            Dim mReader As New StreamReader(mStream, System.Text.Encoding.Default)
            Dim mText As String = mReader.ReadToEnd

            mReader.Close()
            mStream.Close()
            mClient.Dispose()

            mCollection = mRegex.Matches(mText)

            Dim tmpItem As NetUpdateItem
            For Each m As Match In mCollection
                tmpItem = New NetUpdateItem
                With tmpItem
                    .Address = IIf(issueNetAddress.EndsWith("/"), issueNetAddress, issueNetAddress & "/").ToString & m.Groups(1).Value
                    .Content = m.Groups(2).Value
                End With

                AppendItem(Of NetUpdateItem)(tmpItem, mResult)
            Next

            Return mResult
        End Function

        Private Structure NetUpdateItem
            Public Address As String
            Public Content As String
        End Structure

        Private Structure NetUpdateInformationItem
            Public Address As String
            Public LastDate As String
        End Structure

        Private Sub AppendItem(Of T)(ByVal value As T, ByRef array As T())
            ReDim Preserve array(array.Length)
            array(array.Length - 1) = value
        End Sub

        Private Function GetUpdateInformationsTable() As DataTable
            Dim mDataTable As New DataTable("UpdateInformations")
            With mDataTable
                .Columns.Add("Address")
                .Columns.Add("VersionDate")
                For Each item As NetUpdateInformationItem In gNetUpdateInformations
                    .Rows.Add(New String() {item.Address, item.LastDate})
                Next
                .AcceptChanges()
            End With
            Return mDataTable
        End Function

    End Class

End Namespace

ExcelQueryTable.vb

Option Strict Off

Namespace NET
    Friend Class ExcelQueryTable
        Private gExcelApplication As Object
        Private gWorkbook As Object
        Private gWorksheet As Object
        Private gQueryTable As Object

        Private gConnectionString As String = "URL;{0}"

        '以下参数使当前ExcelApplication完全退出
        Private gBeforeProcessStartTime As DateTime
        Private gAfterProcessStartTime As DateTime

        Sub New()
            Initialize()
        End Sub

        Private Sub Initialize()
            '登记进程生成的前后时间
            gBeforeProcessStartTime = Now
            gExcelApplication = CreateObject("Excel.Application")
            gAfterProcessStartTime = Now

            gExcelApplication.DisplayAlerts = False '使退出时不询问是否存盘
            gWorkbook = gExcelApplication.Workbooks.Add
            gWorksheet = gWorkbook.Worksheets.Add

            gQueryTable = gWorksheet.QueryTables.Add( _
               Connection:="URL;", _
               Destination:=gWorksheet.Range("A1"))
        End Sub

        Public Sub Close()

            gQueryTable.Delete()
            System.Runtime.InteropServices.Marshal.ReleaseComObject(gQueryTable)
            gQueryTable = Nothing

            gWorkbook.Close()

            System.Runtime.InteropServices.Marshal.ReleaseComObject(gWorksheet)
            gWorksheet = Nothing

            System.Runtime.InteropServices.Marshal.ReleaseComObject(gWorkbook)
            gWorkbook = Nothing

            gExcelApplication.DisplayAlerts = True
            gExcelApplication.Quit()
            System.Runtime.InteropServices.Marshal.ReleaseComObject(gExcelApplication)
            gExcelApplication = Nothing

            System.Threading.Thread.Sleep(500)
            LzmTW.uSystem.uDiagnostics.uProcess.ProcessServices.Kill("EXCEL", gBeforeProcessStartTime, gAfterProcessStartTime)
        End Sub

        ''' <summary>
        ''' 下载网上区划码数据至Datatable
        ''' </summary>
        ''' <param name="address">数据所在网页地址</param>
        ''' <param name="webtableIndex">对应Excel中QueryTable的WebTable参数</param>
        ''' <param name="outputTable">数据输出所在的DataTable</param>
        ''' <remarks>outputTable有两列,列名分别为Code,Name；不适合多线程</remarks>
        Public Sub Query(ByVal address As String, ByVal webtableIndex As Integer, ByVal outputTable As DataTable)

            gWorksheet.Cells.Clear()

            With gQueryTable
                .Connection = String.Format(gConnectionString, address)
                .WebTables = webtableIndex
                .Refresh(BackgroundQuery:=False)
            End With


            Dim mCell As Object
            Dim mMaxRowIndex As Integer
            Dim line As Object

            mMaxRowIndex = gWorksheet.Cells.SpecialCells(11).Row 'Excel.XlCellType.xlCellTypeLastCell=11
            mCell = gWorksheet.Range("A1")

            For i As Integer = 0 To mMaxRowIndex
                line = mCell.Offset(i, 0).Value
                If line IsNot Nothing Then
                    AddRow(outputTable, line.ToString)
                End If
            Next

        End Sub

        Private Sub AddRow(ByVal table As DataTable, ByVal line As String)
            line = line.Trim
            If line.Length < 7 Then Exit Sub

            Dim tmpCode As String
            Dim tmpName As String

            tmpCode = line.Substring(0, 6)
            tmpName = line.Substring(6).Trim

            If Not IsNumeric(tmpCode) Then Exit Sub '前六位需是数字

            '去掉名称中间的空格
            table.Rows.Add(New String() {tmpCode, tmpName.Replace(" ", "")})
        End Sub

    End Class
End Namespace

上面用到的类：LzmTW.uSystem.uDiagnostics.uProcess.ProcessServices

 ProcessServices.vb

Namespace uSystem.uDiagnostics.uProcess
    Public Class ProcessServices
        Private Sub New()
        End Sub


        ''' <summary>
        ''' 停止进程
        ''' </summary>
        ''' <param name="processName">进程名称</param>
        ''' <param name="beforeStartTime">进程启动前的时间</param>
        ''' <param name="afterStartTime">里程启动后的时间</param>
        ''' <remarks></remarks>
        Public Shared Sub Kill(ByVal processName As String, ByVal beforeStartTime As DateTime, ByVal afterStartTime As DateTime)

            Dim mProcessList As Process()
            Dim mProcessStartTime As DateTime

            mProcessList = Process.GetProcessesByName(processName)

            For Each tmpProcess As Process In mProcessList
                mProcessStartTime = tmpProcess.StartTime
                If mProcessStartTime.CompareTo(beforeStartTime) > 0 AndAlso mProcessStartTime.CompareTo(afterStartTime) < 0 Then
                    tmpProcess.Kill()
                End If
            Next

        End Sub

        ''' <summary>
        ''' 停止进程
        ''' </summary>
        ''' <param name="processName">进程名称</param>
        ''' <remarks></remarks>
        Public Shared Sub Kill(ByVal processName As String)

            Dim mProcessList As Process()

            mProcessList = Process.GetProcessesByName(processName)

            For Each tmpProcess As Process In mProcessList
                tmpProcess.Kill()
            Next

        End Sub
    End Class
End Namespace

 

下面实现接口IClientProvideServices：
类的环境，ClientServices.vb

Namespace Services
    Public Class ClientServices
        Implements RegionalCodeCommon.Interface.IClientProvideServices

        Public Event ServiceMessage(ByVal sender As Object, ByVal message As String) Implements RegionalCodeCommon.Interface.IClientProvideServices.ServiceMessage
        Private gNetCurrentInformations As RegionalCodeCommon.NetCurrentInformations

        Sub New()
            gNetCurrentInformations = RegionalCodeCommon.NetCurrentInformations.DefaultInstance
        End Sub

        Private Function NetworkIsValid() As Boolean
            Dim mResult As Boolean = False
            mResult = My.Computer.Network.IsAvailable

            If Not mResult Then
                SendMessage("本地连接无效")

            Else
                mResult = My.Computer.Network.Ping(gNetCurrentInformations.GovernmentDefaultAddress)

                If Not mResult Then
                    SendMessage(String.Format("本机没有连接Internet或发布网址{0}无效", gNetCurrentInformations.GovernmentDataIssueAddress))
                End If
            End If

            Return mResult
        End Function

        Protected Sub SendMessage(ByVal message As String)
            RaiseEvent ServiceMessage(Nothing, message)
        End Sub

    End Class
End Namespace

可供下载的版本信息，ClientServices.NetDataVersions.vb

 

Namespace Services
    Partial Class ClientServices

        Private gNetDownloadInformationsTable As New RegionalCodeCommon.Database.dsNetDownload.DownloadInformationsDataTable

        Private gNetInformation As New NET.NetInformation

        Public ReadOnly Property NetDownloadInformationsTable() As RegionalCodeCommon.Database.dsNetDownload.DownloadInformationsDataTable Implements RegionalCodeCommon.Interface.IClientProvideServices.NetDownloadInformationsTable
            Get
                Return gNetDownloadInformationsTable
            End Get
        End Property

        Public Sub DownloadNetDataVersions() Implements RegionalCodeCommon.Interface.IClientProvideServices.DownloadNetDataVersions
            If Not Me.NetworkIsValid Then Exit Sub

            SendMessage("正在获取下载信息...")
            gNetInformation.DownloadInformationsFromNet(Me.gNetCurrentInformations.GovernmentDataIssueAddress)

            If gNetInformation.UpdateInformationsTable.Rows.Count = 0 Then
                SendMessage(String.Format("取不到数据。请检查发布网址是否是:{0}", gNetCurrentInformations.GovernmentDataIssueAddress))
                Exit Sub
            End If

            With gNetDownloadInformationsTable
                .Clear()
                .Load(gNetInformation.UpdateInformationsTable.CreateDataReader)
                .AcceptChanges()
            End With

            SendMessage("下载完毕")
        End Sub

    End Class
End Namespace

各版本或全部版本的数据，ClientServices.NetRegionalCodeDatas.vb

 

Namespace Services
    Partial Class ClientServices

        Private gNetRegionalCodeTableDictionary As New System.Collections.Generic.Dictionary(Of String, RegionalCodeCommon.Database.dsNetDownload.RegionalCodeDataTable)

        Private gExcelQueryTable As NET.ExcelQueryTable

        Public ReadOnly Property NetRegionalCodeTableDictionary() As System.Collections.Generic.Dictionary(Of String, RegionalCodeCommon.Database.dsNetDownload.RegionalCodeDataTable) Implements RegionalCodeCommon.Interface.IClientProvideServices.NetRegionalCodeTableDictionary
            Get
                Return gNetRegionalCodeTableDictionary
            End Get
        End Property

        ''' <summary>
        ''' 下载指定版本日期的数据
        ''' </summary>
        ''' <param name="versionDate">版本日期</param>
        ''' <remarks>只能是单线程使用，不适用多线程</remarks>
        Public Sub DownLoadNetRegionalCodeDatas(ByVal versionDate As String) Implements RegionalCodeCommon.Interface.IClientProvideServices.DownLoadNetRegionalCodeDatas

            Dim mAddress As String = ""

            If Me.NetDownloadInformationsTable.Count = 0 Then
                SendMessage("下载区划码数据前请先获取下载信息")
                Exit Sub
            Else

                Dim tmpRows() As RegionalCodeCommon.Database.dsNetDownload.DownloadInformationsRow
                tmpRows = CType(Me.NetDownloadInformationsTable.Select(String.Format("VersionDate = '{0}'", versionDate)), RegionalCodeCommon.Database.dsNetDownload.DownloadInformationsRow())

                If tmpRows.Length <> 1 Then
                    SendMessage(String.Format("版本日期{0}无效", versionDate))
                    Exit Sub

                Else

                    mAddress = tmpRows(0).Address
                End If

            End If

            If Not Me.NetworkIsValid Then Exit Sub
            If Not ExcelIsValid() Then Exit Sub

            Dim tmpTable As New RegionalCodeCommon.Database.dsNetDownload.RegionalCodeDataTable
            tmpTable.TableName = versionDate

            SendMessage(String.Format("正在下载{0}版本数据...", versionDate))
            gExcelQueryTable.Query(mAddress, Me.gNetCurrentInformations.ExcelQueryTableWebTableIndex, tmpTable)
            SendMessage("下载完成")

            If gNetRegionalCodeTableDictionary.ContainsKey(versionDate) Then

                gNetRegionalCodeTableDictionary(versionDate).Clear()
                gNetRegionalCodeTableDictionary(versionDate).Merge(tmpTable)
            Else

                gNetRegionalCodeTableDictionary.Add(versionDate, tmpTable)
            End If

            gNetRegionalCodeTableDictionary(versionDate).AcceptChanges()
        End Sub

        Public Sub DownLoadAllNetRegionalCodeDatas()
            If Me.NetDownloadInformationsTable.Count = 0 Then
                SendMessage("下载区划码数据前请先获取下载信息")
                Exit Sub
            End If

            If Not Me.NetworkIsValid Then Exit Sub
            If Not ExcelIsValid() Then Exit Sub

            gNetRegionalCodeTableDictionary.Clear()

            Dim tmpTable As RegionalCodeCommon.Database.dsNetDownload.RegionalCodeDataTable
            For Each row As RegionalCodeCommon.Database.dsNetDownload.DownloadInformationsRow In Me.NetDownloadInformationsTable.Rows
                tmpTable = New RegionalCodeCommon.Database.dsNetDownload.RegionalCodeDataTable
                tmpTable.TableName = row.VersionDate

                SendMessage(String.Format("正在下载{0}版本数据...", row.VersionDate))

                gExcelQueryTable.Query(row.Address, Me.gNetCurrentInformations.ExcelQueryTableWebTableIndex, tmpTable)
                tmpTable.AcceptChanges()

                gNetRegionalCodeTableDictionary.Add(row.VersionDate, tmpTable)
            Next

            SendMessage("下载完成")
        End Sub

        Public Sub ExcelClose()
            If gExcelQueryTable Is Nothing Then Exit Sub

            gExcelQueryTable.Close()
        End Sub

        Private Function ExcelIsValid() As Boolean
            Dim mResult As Boolean = False

            If gExcelQueryTable Is Nothing Then
                SendMessage("正在起动Excel...")

                Try
                    gExcelQueryTable = New NET.ExcelQueryTable
                    mResult = True
                Catch ex As Exception
                    SendMessage("程序需要安装Excel。")
                End Try
            Else

                mResult = True
            End If

            Return mResult
        End Function
    End Class
End Namespace

再考虑保存下载数据到本地供以后数据更新，继承ClientServices为UpdateDatabaseService类，
UpdateDatabaseService.vb

Public Class UpdateDatabaseService
    Inherits Services.ClientServices
    Private gNetDownloadLocalDataset As New RegionalCodeCommon.Database.NetDownloadLocalDataSet
    Private gUpdateDatabaseDataset As New RegionalCodeCommon.Database.UpdateDatabaseDataSet

    Public ReadOnly Property UpdateDatabaseDataSet() As RegionalCodeCommon.Database.UpdateDatabaseDataSet
        Get
            Return gUpdateDatabaseDataset
        End Get
    End Property

    Public Sub LoadDatasFromFile(ByVal file As String)
        If Not IO.File.Exists(file) Then
            Me.SendMessage(String.Format("{0}文件不存在", file))
            Exit Sub
        End If

        Me.SendMessage("正从本地读取数据...")
        gNetDownloadLocalDataset.LoadDatasFromLocal(file)

        Me.NetRegionalCodeTableDictionary.Clear()
        Dim tmpTable As RegionalCodeCommon.Database.dsNetDownload.RegionalCodeDataTable
        For Each table As DataTable In Me.gNetDownloadLocalDataset.DataSet.Tables
            tmpTable = New RegionalCodeCommon.Database.dsNetDownload.RegionalCodeDataTable
            With tmpTable
                .Load(table.CreateDataReader)
                .TableName = table.TableName
                .AcceptChanges()
            End With
            Me.NetRegionalCodeTableDictionary.Add(tmpTable.TableName, tmpTable)
        Next

        Me.SendMessage("读取完毕")
    End Sub

    Public Sub SaveDatasToFile(ByVal file As String)
        Me.SendMessage("正保存数据至本地...")
        gNetDownloadLocalDataset.WriteDatasToLocal(file)
        Me.SendMessage("保存完毕")
    End Sub

    Public Overloads Sub DownLoadNetRegionalCodeDatas(ByVal versionDate As String)
        MyBase.DownLoadNetRegionalCodeDatas(versionDate)

        AppendTableToNetDownloadLocalDataset(versionDate)
    End Sub

    Public Overloads Sub DownLoadAllNetRegionalCodeDatas()
        MyBase.DownLoadAllNetRegionalCodeDatas()

        AppendAllTablesToNetDownloadLocalDataset()
    End Sub

    Private Sub AppendTableToNetDownloadLocalDataset(ByVal versionDate As String)
        If Not Me.NetRegionalCodeTableDictionary.ContainsKey(versionDate) Then
            SendMessage(String.Format("不存在版本日期为{0}的数据", versionDate))
            Exit Sub
        End If
        gNetDownloadLocalDataset.Add(Me.NetRegionalCodeTableDictionary(versionDate))
    End Sub

    Private Sub AppendAllTablesToNetDownloadLocalDataset()
        For Each table As RegionalCodeCommon.Database.dsNetDownload.RegionalCodeDataTable In Me.NetRegionalCodeTableDictionary.Values
            gNetDownloadLocalDataset.Add(table)
        Next
    End Sub

    Public Sub UpdateDatabaseDatasetClear()
        Me.gNetDownloadLocalDataset.Clear()
    End Sub

    Public Sub AppendTableToUpdateDatabaseDataset(ByVal versionDate As String)
        gUpdateDatabaseDataset.Add(Me.NetRegionalCodeTableDictionary(versionDate))
    End Sub

    Public Sub AppendAllTablesToUpdateDatabaseDataset()
        UpdateDatabaseDatasetClear()
        For Each table As DataTable In Me.NetRegionalCodeTableDictionary.Values
            gUpdateDatabaseDataset.Add(table)
        Next
    End Sub
End Class

方案写到这里，需要测试一番了。

下一篇，行政区划程序的设计(十三)，数据更新的简单测试。