Common CustomDataSource
Common_CustomDataSource_VBNet\CustomDataSource_VBNet\REXMLDataSource_VBNet\QueryFunctionality.vb
' Copyright 2007 ESRI
' 
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
' 
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
' 
' See the use restrictions.
' 

Imports Microsoft.VisualBasic
Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Data
Imports System.Web.UI
Imports ESRI.ArcGIS.ADF.Web.Geometry
Imports ESRI.ArcGIS.ADF.Web.DataSources
Imports ESRI.ArcGIS.ADF.Web.Display.Graphics
Imports System.Collections
Imports ESRI.ArcGIS.ADF.Web

Namespace REXMLDataSource_VBNet
  Public Class QueryFunctionality
    Implements IQueryFunctionality
    Public Sub New(ByVal name_Renamed As String, ByVal resource_Renamed As MapResource)
      Me.name_Renamed = name_Renamed
      Me.resource_Renamed = resource_Renamed
    End Sub

    Private Function GetGraphicsDataSet(ByVal mapFunctionalityName As String) As GraphicsDataSet
      Dim mapResource As MapResource = TryCast(resource_Renamed, MapResource)
      If mapResource Is Nothing Then
        Return Nothing
      End If

      If mapFunctionalityName Is Nothing Then
        Return mapResource.Graphics
      Else
        Dim mapFunctionality As MapFunctionality = TryCast(mapResource.Functionalities.Find(mapFunctionalityName), MapFunctionality)
        If mapFunctionality Is Nothing Then
          Return Nothing
        Else
          Return mapFunctionality.GraphicsDataSet
        End If
      End If
    End Function

    Private Function GetGraphicsLayer(ByVal mapFunctionalityName As String, ByVal layerID As String) As GraphicsLayer
      Dim gds As GraphicsDataSet = GetGraphicsDataSet(mapFunctionalityName)
      If gds Is Nothing Then
        Return Nothing
      End If

      Dim tableName As String = layerID
      If tableName Is Nothing Then
        Return Nothing
      End If

      Return TryCast(gds.Tables(tableName), GraphicsLayer)
    End Function

    #Region "IQueryFunctionality implementation"

        Public Function Find(ByVal mapFunctionalityName As String, ByVal findParameters As FindParameters) As DataTable() Implements IQueryFunctionality.Find
            Dim datatables As List(Of DataTable) = New List(Of DataTable)()
            Dim graphicsDataSet As GraphicsDataSet = GetGraphicsDataSet(mapFunctionalityName)
            If graphicsDataSet Is Nothing Then
                Return Nothing
            End If

            Dim filter As QueryFilter = New QueryFilter()
            filter.MaxRecords = findParameters.MaxRecords
            filter.ReturnADFGeometries = findParameters.ReturnADFGeometries

            Dim en As IDictionaryEnumerator = findParameters.LayersAndFields.GetEnumerator()
            Do While en.MoveNext()
                Dim layerID As String = TryCast(en.Key, String)
                Dim searchFields As String() = TryCast(en.Value, String())

                ' Build where clause
                Dim whereExpression As StringBuilder = New StringBuilder()
                Dim i As Integer = 0
                Do While i < searchFields.Length
                    If findParameters.UseSqlContains Then
                        ' todo: change to use SQL CONTAINS statement
                        whereExpression.Append(String.Format("{0} like '%{1}%'", searchFields(i), findParameters.FindString))
                    Else
                        whereExpression.Append(String.Format("{0} like '%{1}%'", searchFields(i), findParameters.FindString))
                    End If
                    If i <> searchFields.Length - 1 Then
                        whereExpression.Append(" OR ")
                    End If
                    i += 1
                Loop

                filter.WhereClause = whereExpression.ToString()

                Dim glayer As GraphicsLayer = TryCast(graphicsDataSet.Tables(layerID), GraphicsLayer)
                If Not glayer Is Nothing Then
                    If findParameters.FindOption <> FindOption.VisibleLayers OrElse (findParameters.FindOption = FindOption.VisibleLayers AndAlso glayer.Visible = True) Then
                        datatables.Add(Query(mapFunctionalityName, glayer.TableName, filter))
                    End If
                End If
            Loop


            Return datatables.ToArray()
        End Function

        Public Function Identify(ByVal mapFunctionalityName As String, ByVal geometry As Geometry, ByVal tolerance As Integer, ByVal [option] As IdentifyOption, ByVal layers As String()) As DataTable() Implements IQueryFunctionality.Identify
            Dim datatables As List(Of DataTable) = New List(Of DataTable)()

            Dim graphicsDataSource As GraphicsDataSet = GetGraphicsDataSet(mapFunctionalityName)
            If graphicsDataSource Is Nothing Then
                Return Nothing
            End If

            Dim sf As SpatialFilter = New SpatialFilter()
            sf.SearchOrder = SearchOrder.Spatial
            If TypeOf geometry Is Point Then
                Dim point As Point = TryCast(geometry, Point)
                Dim mr As MapResource = TryCast(Resource, MapResource)
                sf.Geometry = point.Expand(tolerance, graphicsDataSource.FullExtent)
            Else
                Throw New NotSupportedException("GraphicsLayer only supports Points in the Identify method.")
            End If

            If layers Is Nothing Then
                For Each glb As GraphicsLayer In graphicsDataSource.Tables
                    datatables.Add(Query(mapFunctionalityName, glb.TableName, sf))
                Next glb
            Else
                For Each o As String In layers
                    datatables.Add(Query(mapFunctionalityName, o, sf))
                Next o
            End If

            Return datatables.ToArray()
        End Function

    Public Function Query(ByVal mapFunctionalityName As String, ByVal layerID As String, ByVal queryFilter As QueryFilter) As DataTable Implements IQueryFunctionality.Query
      Dim glayer As GraphicsLayer = GetGraphicsLayer(mapFunctionalityName, layerID)
      If glayer Is Nothing Then
        Return Nothing
      End If

'      #Region "Create Table"
      Dim dataTable As DataTable = Nothing
      Dim columns As List(Of DataColumn) = New List(Of DataColumn)()
      For Each col As DataColumn In glayer.Columns
        If queryFilter.SubFields.Count = 0 OrElse queryFilter.SubFields.IndexOf(col.ColumnName) <> -1 Then
          columns.Add(CloneColumn(col))
        ElseIf queryFilter.ReturnADFGeometries AndAlso (col.DataType Is GetType(GraphicElement) OrElse col.DataType Is GetType(Geometry)) Then
          columns.Add(CloneColumn(col))
        End If
      Next col
      If queryFilter.ReturnADFGeometries Then
        If TypeOf glayer Is FeatureGraphicsLayer Then
          Dim flayer As FeatureGraphicsLayer = TryCast(glayer, FeatureGraphicsLayer)
          dataTable = New FeatureGraphicsLayer(flayer.TableName, columns.ToArray(), flayer.GeometryColumnName, flayer.GraphicsIDColumn.ColumnName, flayer.FeatureType)
        Else
          Dim elayer As ElementGraphicsLayer = TryCast(glayer, ElementGraphicsLayer)
          dataTable = New ElementGraphicsLayer(elayer.TableName, columns.ToArray(), elayer.GraphicsColumn.ColumnName, elayer.GraphicsIDColumn.ColumnName)
        End If
      End If
      If dataTable Is Nothing Then
        dataTable = New DataTable(glayer.TableName)
        dataTable.Columns.AddRange(columns.ToArray())
      End If
'      #End Region

      ' Do query
      If TypeOf queryFilter Is SpatialFilter Then
        Dim sf As SpatialFilter = TryCast(queryFilter, SpatialFilter)
        If sf.SearchOrder = SearchOrder.Spatial Then
          InitialSpatialQuery(glayer, dataTable, sf)
          AttributeQueryOnSpatialResults(dataTable, queryFilter)
        Else
          Dim geometries As List(Of Geometry) = InitialAttributeQuery(glayer, dataTable, queryFilter)
          SpatialQueryOnAttributeResults(dataTable, sf, geometries)
        End If
      Else
        InitialAttributeQuery(glayer, dataTable, queryFilter)
      End If

      If dataTable.Rows.Count > queryFilter.MaxRecords AndAlso queryFilter.MaxRecords > 0 Then
        Do While dataTable.Rows.Count > queryFilter.MaxRecords
          dataTable.Rows.RemoveAt(dataTable.Rows.Count - 1)
        Loop
      End If

      Return dataTable
    End Function

    Private Function InitialAttributeQuery(ByVal glayer As GraphicsLayer, ByVal resultsDataTable As DataTable, ByVal queryFilter As QueryFilter) As List(Of Geometry)
      Dim geometries As List(Of Geometry) = New List(Of Geometry)()
      Dim rows As DataRow() = glayer.Select(queryFilter.WhereClause)
      For Each row As DataRow In rows
        resultsDataTable.ImportRow(row)
        geometries.Add(glayer.GeometryFromRow(row))
      Next row

      Return geometries
    End Function

    Private Sub InitialSpatialQuery(ByVal glayer As GraphicsLayer, ByVal resultsDataTable As DataTable, ByVal sf As SpatialFilter)
      For Each row As DataRow In glayer.Rows
        Dim geometry As Geometry = glayer.GeometryFromRow(row)

        ' To implemement, evaluate feature geometry and spatial filter geometry
        ' if (geometry != null && GeometriesIntersect(geometry, sf.Geometry))

        If Not geometry Is Nothing Then
          resultsDataTable.ImportRow(row)
        End If

      Next row
    End Sub

    Private Sub AttributeQueryOnSpatialResults(ByVal dataTable As DataTable, ByVal queryFilter As QueryFilter)
      If queryFilter.WhereClause = "" Then
        Return
      End If

      Dim rows As DataRow() = dataTable.Select(queryFilter.WhereClause)
      For Each row As DataRow In dataTable.Rows
        If Array.IndexOf(rows, row) = -1 Then
          dataTable.Rows.Remove(row)
        End If
      Next row
    End Sub

    Private Sub SpatialQueryOnAttributeResults(ByVal dataTable As DataTable, ByVal sf As SpatialFilter, ByVal geometries As List(Of Geometry))
      If geometries Is Nothing OrElse geometries.Count = 0 Then
        Return
      End If

      Dim i As Integer = 0
      Dim j As Integer = 0
      Do While i < dataTable.Rows.Count
        ' To implement, evaluate if feature geometry intersects spatial filter geometry

        'if (!GeometriesIntersect(geometries[j], sf.Geometry))
        '{
          'dataTable.Rows.Remove(dataTable.Rows[i]);
          '--i;
        '}
        i += 1
        j += 1
      Loop
    End Sub

        Public Sub GetQueryableLayers(ByVal mapFunctionalityName As String, <System.Runtime.InteropServices.Out()> ByRef layerIDs As String(), <System.Runtime.InteropServices.Out()> ByRef layerNames As String(), ByVal featureType As FeatureType) Implements IQueryFunctionality.GetQueryableLayers
            layerIDs = Nothing
            layerNames = Nothing

            Dim tables As List(Of DataTable) = New List(Of DataTable)()

            Dim gds As GraphicsDataSet = GetGraphicsDataSet(mapFunctionalityName)
            If gds Is Nothing Then
                Return
            End If

            For Each glayer As GraphicsLayer In gds.Tables
                Dim gl As FeatureGraphicsLayer = TryCast(glayer, FeatureGraphicsLayer)
                If Not gl Is Nothing AndAlso gl.FeatureType <> featureType Then
                    Continue For
                End If

                tables.Add(glayer)
            Next glayer

            layerIDs = New String(tables.Count - 1) {}
            layerNames = New String(tables.Count - 1) {}
            Dim i As Integer = 0
            Do While i < tables.Count
                layerIDs(i) = tables(i).TableName
                layerNames(i) = tables(i).TableName
                i += 1
            Loop
        End Sub

        Public Sub GetQueryableLayers(ByVal mapFunctionalityName As String, <System.Runtime.InteropServices.Out()> ByRef layerIDs As String(), <System.Runtime.InteropServices.Out()> ByRef layerNames As String()) Implements IQueryFunctionality.GetQueryableLayers
            layerIDs = Nothing
            layerNames = Nothing

            Dim gds As GraphicsDataSet = GetGraphicsDataSet(mapFunctionalityName)
            If gds Is Nothing Then
                Return
            End If

            layerIDs = New String(gds.Tables.Count - 1) {}
            layerNames = New String(gds.Tables.Count - 1) {}
            Dim i As Integer = 0
            Do While i < gds.Tables.Count
                layerIDs(i) = gds.Tables(i).TableName
                layerNames(i) = gds.Tables(i).TableName
                i += 1
            Loop
        End Sub

        Public Function GetFields(ByVal mapFunctionalityName As String, ByVal layerID As String) As String() Implements IQueryFunctionality.GetFields
            Dim glayer As GraphicsLayer = GetGraphicsLayer(mapFunctionalityName, layerID)
            If glayer Is Nothing Then
                Return Nothing
            End If

            Dim fields As String() = New String(glayer.Columns.Count - 1) {}
            Dim i As Integer = 0
            Do While i < glayer.Columns.Count
                fields(i) = glayer.Columns(i).ColumnName
                i += 1
            Loop

            Return fields
        End Function

        Public Function GetFields(ByVal mapFunctionalityName As String, ByVal layerID As String, <System.Runtime.InteropServices.Out()> ByRef fieldTypes As Type()) As String() Implements IQueryFunctionality.GetFields
            Dim glayer As GraphicsLayer = GetGraphicsLayer(mapFunctionalityName, layerID)
            If glayer Is Nothing Then
                fieldTypes = Nothing
                Return Nothing
            End If

            Dim fields As String() = New String(glayer.Columns.Count - 1) {}
            fieldTypes = New Type(glayer.Columns.Count - 1) {}

            Dim i As Integer = 0
            Do While i < glayer.Columns.Count
                fields(i) = glayer.Columns(i).ColumnName
                fieldTypes(i) = glayer.Columns(i).DataType
                i += 1
            Loop

            Return fields
        End Function
    #End Region

    #Region "IGISFunctionality implementation"

    Private name_Renamed As String = String.Empty
    Private resource_Renamed As IGISResource = Nothing
        Private _webControl As System.Web.UI.WebControls.WebControl

    Public Property WebControl() As System.Web.UI.WebControls.WebControl Implements IQueryFunctionality.WebControl
      Get
        Return _webControl
      End Get
      Set
        _webControl = Value
      End Set
    End Property

    Public Property Name() As String Implements IQueryFunctionality.Name
      Get
        Return name_Renamed
      End Get
      Set
        name_Renamed = Value
      End Set
    End Property

    Public Property Resource() As IGISResource Implements IQueryFunctionality.Resource
      Get
        Return resource_Renamed
      End Get
      Set
        resource_Renamed = Value
      End Set
    End Property

    Private _initialized As Boolean = False

    Public ReadOnly Property Initialized() As Boolean Implements IQueryFunctionality.Initialized
      Get
        Return _initialized
      End Get
    End Property

    Public Sub LoadState() Implements IQueryFunctionality.LoadState
    End Sub

    Public Sub Initialize() Implements IQueryFunctionality.Initialize
      _initialized = True
    End Sub

    Public Sub SaveState() Implements IQueryFunctionality.SaveState
    End Sub

    Public Sub Dispose() Implements IQueryFunctionality.Dispose
      _initialized = False
    End Sub

    Public Function Supports(ByVal operation As String) As Boolean Implements IQueryFunctionality.Supports
      Return True
    End Function
    #End Region

    Public Shared Function CloneColumn(ByVal toClone As DataColumn) As DataColumn
      Dim column1 As DataColumn = CType(Activator.CreateInstance(toClone.GetType()), DataColumn)
      column1.AllowDBNull = toClone.AllowDBNull
      column1.AutoIncrement = toClone.AutoIncrement
      column1.AutoIncrementStep = toClone.AutoIncrementStep
      column1.AutoIncrementSeed = toClone.AutoIncrementSeed
      column1.Caption = toClone.Caption
      column1.ColumnName = toClone.ColumnName
      column1.DataType = toClone.DataType
      column1.DefaultValue = toClone.DefaultValue
      column1.ColumnMapping = toClone.ColumnMapping
      column1.ReadOnly = toClone.ReadOnly
      column1.MaxLength = toClone.MaxLength
      column1.DateTimeMode = toClone.DateTimeMode
      column1.Namespace = toClone.Namespace
      column1.Prefix = toClone.Prefix
      column1.Unique = toClone.Unique
      If Not toClone.ExtendedProperties Is Nothing Then
        For Each obj1 As Object In toClone.ExtendedProperties.Keys
          column1.ExtendedProperties(obj1) = toClone.ExtendedProperties(obj1)
        Next obj1
      End If
      Return column1
    End Function

  End Class
End Namespace