Common CustomDataSourceCommon_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