ArcObjects Library Reference  

FindNearFeaturesRestSOE_VBNet

About the Find near features REST SOE Sample

[C#]

FindNearFeaturesRestSOE_VBNet.cs


[Visual Basic .NET]

FindNearFeaturesRestSOE_VBNet.vb

Imports Microsoft.VisualBasic
Imports System
Imports System.Collections.Generic
Imports System.Collections.Specialized
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.EnterpriseServices
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.Server
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.Carto

Imports ESRI.ArcGIS.SOESupport

Namespace FindNearFeaturesRestSOE_VBNet
    <ComVisible(True), Guid("3350AAE7-4F56-46AC-876B-A960776C1286"), ClassInterface(ClassInterfaceType.None)> _
    Public Class FindNearFeaturesRESTSOE_VBNet
        Inherits ServicedComponent
        Implements IServerObjectExtension, IObjectConstruct, IRESTRequestHandler
        Private Const c_SOEName As String = "FindNearFeaturesRESTSOE_VBNet"
        Private Const c_CapabilityGetInfo As String = "GetInfo"
        Private Const c_CapabilityFindFeatures As String = "FindFeatures"

        Private configProps As IPropertySet
        Private serverObjectHelper As IServerObjectHelper
        Private logger As ServerLogger
        Private reqHandler As IRESTRequestHandler

        Public Sub New()
            logger = New ServerLogger()

            Dim rootResource As RestResource = CreateRestSchema()

            Dim restImpl As New SoeRestImpl(c_SOEName, rootResource)
            reqHandler = CType(restImpl, IRESTRequestHandler)
        End Sub

        Private Function CreateRestSchema() As RestResource
            Dim soeResource As New RestResource("FindNearFeaturesRESTSOE_VBNet", False, AddressOf SOE, c_CapabilityGetInfo)

            Dim customLayerResource As New RestResource("customLayers", True, AddressOf CustomLayer, c_CapabilityGetInfo)

            Dim findNearFeatsOp As New RestOperation("findNearFeatures", New String() {"location", "distance"}, New String() {"json"}, AddressOf FindNearFeatures, c_CapabilityFindFeatures)

            customLayerResource.operations.Add(findNearFeatsOp)

            soeResource.resources.Add(customLayerResource)

            Return soeResource
        End Function

#Region "IServerObjectExtension"
        Public Sub Init(ByVal pSOH As IServerObjectHelper) Implements IServerObjectExtension.Init
            serverObjectHelper = pSOH
        End Sub

        Public Sub Shutdown() Implements IServerObjectExtension.Shutdown
            serverObjectHelper = Nothing
        End Sub
#End Region

#Region "IObjectConstruct"
        Public Overloads Sub Construct(ByVal props As IPropertySet) Implements IObjectConstruct.Construct
            Dim timer As New AutoTimer()
            logger.LogMessage(ServerLogger.msgType.infoSimple, "Construct", -1, c_SOEName & " Construct has started.")

            configProps = props

            'TODO - put any construct-time logic here
            logger.LogMessage(ServerLogger.msgType.infoSimple, "Construct", -1, timer.Elapsed, c_SOEName & " Construct has completed.")
        End Sub
#End Region

#Region "IRESTRequestHandler"
        Public Function GetSchema() As String Implements IRESTRequestHandler.GetSchema
            Return reqHandler.GetSchema()
        End Function


        Public Function HandleRESTRequest(ByVal Capabilities As String, ByVal resourceName As String, ByVal operationName As String, ByVal operationInput As String, ByVal outputFormat As String, ByVal requestProperties As String, <System.Runtime.InteropServices.Out()> ByRef responseProperties As String) As Byte() Implements IRESTRequestHandler.HandleRESTRequest
            Return reqHandler.HandleRESTRequest(Capabilities, resourceName, operationName, operationInput, outputFormat, requestProperties, responseProperties)
        End Function
#End Region

#Region "Resource Handlers"

        Private Function SOE(ByVal boundVariables As NameValueCollection, ByVal outputFormat As String, ByVal requestProperties As String, <System.Runtime.InteropServices.Out()> ByRef responseProperties As String) As Byte()
            responseProperties = Nothing

            Dim layerInfos() As CustomLayerInfo_VBNet = GetLayerInfos()

            Dim jos(layerInfos.Length - 1) As JsonObject

            For i As Integer = 0 To layerInfos.Length - 1
                jos(i) = layerInfos(i).ToJsonObject()
            Next i

            Dim result As New JsonObject()
            result.AddArray("customLayers", jos)

            Dim json As String = result.ToJson()

            Return Encoding.UTF8.GetBytes(json)
        End Function

        'customLayers/{customLayersID}
        'returns json with simplified layerinfo (name, id, extent)
        Private Function CustomLayer(ByVal boundVariables As NameValueCollection, ByVal outputFormat As String, ByVal requestProperties As String, <System.Runtime.InteropServices.Out()> ByRef responseProperties As String) As Byte()
            responseProperties = Nothing

            'layerID
            Dim layerID As Integer = Convert.ToInt32(boundVariables("customLayersID"))

            'execute
            Dim layerInfo As CustomLayerInfo_VBNet = GetLayerInfo(layerID)

            Dim json As String = layerInfo.ToJsonObject().ToJson()

            Return Encoding.UTF8.GetBytes(json)
        End Function
#End Region

#Region "Operation Handlers"
        'customLayers/{customLayersID}/findNearFeatures?location=<jsonPoint>&distance=<double>
        Private Function FindNearFeatures(ByVal boundVariables As NameValueCollection, ByVal operationInput As JsonObject, ByVal outputFormat As String, ByVal requestProperties As String, <System.Runtime.InteropServices.Out()> ByRef responseProperties As String) As Byte()

            responseProperties = Nothing

            'layerID
            Dim layerID As Integer = Convert.ToInt32(boundVariables("customLayersID"))

            'location
            Dim jsonPoint As JsonObject
            If (Not operationInput.TryGetJsonObject("location", jsonPoint)) Then
                Throw New ArgumentNullException("location")
            End If

            Dim location As IPoint = TryCast(ESRI.ArcGIS.SOESupport.Conversion.ToGeometry(jsonPoint, esriGeometryType.esriGeometryPoint), IPoint)
            If location Is Nothing Then
                Throw New ArgumentException("FindNearFeatures: invalid location", "location")
            End If

            'distance
            Dim distance? As Double
            If (Not operationInput.TryGetAsDouble("distance", distance)) OrElse (Not distance.HasValue) Then
                Throw New ArgumentException("FindNearFeatures: invalid distance", "distance")
            End If

            'execute asking the map server to generate json directly (not an IRecordSet)
            Dim result() As Byte = FindNearFeatures(layerID, location, distance.Value)

            Return result
        End Function
#End Region

#Region "Business Methods"
        Private Function GetLayerInfo(ByVal layerID As Integer) As CustomLayerInfo_VBNet
            If layerID < 0 Then
                Throw New ArgumentOutOfRangeException("layerID")
            End If

            Dim mapServer As IMapServer3 = TryCast(serverObjectHelper.ServerObject, IMapServer3)
            If mapServer Is Nothing Then
                Throw New Exception("Unable to access the map server.")
            End If

            Dim layerInfo As IMapLayerInfo

            Dim layerInfos As IMapLayerInfos = mapServer.GetServerInfo(mapServer.DefaultMapName).MapLayerInfos
            Dim c As Long = layerInfos.Count

            For i As Integer = 0 To c - 1
                layerInfo = layerInfos.Element(i)
                If layerInfo.ID = layerID Then
                    Return New CustomLayerInfo_VBNet(layerInfo)
                End If
            Next i

            Throw New ArgumentOutOfRangeException("layerID")
        End Function

        Private Function GetLayerInfos() As CustomLayerInfo_VBNet()
            Dim mapServer As IMapServer3 = TryCast(serverObjectHelper.ServerObject, IMapServer3)
            If mapServer Is Nothing Then
                Throw New Exception("Unable to access the map server.")
            End If

            Dim msInfo As IMapServerInfo = mapServer.GetServerInfo(mapServer.DefaultMapName)
            Dim layerInfos As IMapLayerInfos = msInfo.MapLayerInfos
            Dim c As Integer = layerInfos.Count

            Dim customLayerInfos(c - 1) As CustomLayerInfo_VBNet

            For i As Integer = 0 To c - 1
                Dim layerInfo As IMapLayerInfo = layerInfos.Element(i)
                customLayerInfos(i) = New CustomLayerInfo_VBNet(layerInfo)
            Next i

            Return customLayerInfos
        End Function

        Private Function FindNearFeatures(ByVal layerID As Integer, ByVal location As IPoint, ByVal distance As Double) As Byte()
            If layerID < 0 Then
                Throw New ArgumentOutOfRangeException("layerID")
            End If

            If distance <= 0.0 Then
                Throw New ArgumentOutOfRangeException("distance")
            End If

            Dim mapServer As IMapServer3 = TryCast(serverObjectHelper.ServerObject, IMapServer3)
            If mapServer Is Nothing Then
                Throw New Exception("Unable to access the map server.")
            End If

            Dim queryGeometry As IGeometry = (CType(location, ITopologicalOperator)).Buffer(distance)

            Dim filter As ISpatialFilter = New SpatialFilterClass()
            filter.Geometry = queryGeometry
            filter.SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersects

            Dim resultOptions As IQueryResultOptions = New QueryResultOptionsClass()
            resultOptions.Format = esriQueryResultFormat.esriQueryResultJsonAsMime

            Dim timer As New AutoTimer() 'starts the timer

            Dim tableDesc As IMapTableDescription = GetTableDesc(mapServer, layerID)

            logger.LogMessage(ServerLogger.msgType.infoDetailed, "FindNearFeatures", -1, timer.Elapsed, "Finding table description elapsed this much.")

            Dim result As IQueryResult = mapServer.QueryData(mapServer.DefaultMapName, tableDesc, filter, resultOptions)

            Return result.MimeData
        End Function

        Private Function GetTableDesc(ByVal mapServer As IMapServer3, ByVal layerID As Integer) As IMapTableDescription
            Dim layerDescs As ILayerDescriptions = mapServer.GetServerInfo(mapServer.DefaultMapName).DefaultMapDescription.LayerDescriptions
            Dim c As Long = layerDescs.Count

            For i As Integer = 0 To c - 1
                Dim layerDesc As ILayerDescription3 = CType(layerDescs.Element(i), ILayerDescription3)

                If layerDesc.ID = layerID Then
                    layerDesc.LayerResultOptions = New LayerResultOptionsClass()
                    layerDesc.LayerResultOptions.GeometryResultOptions = New GeometryResultOptionsClass()
                    layerDesc.LayerResultOptions.GeometryResultOptions.DensifyGeometries = True

                    Return CType(layerDesc, IMapTableDescription)
                End If
            Next i

            Throw New ArgumentOutOfRangeException("layerID")
        End Function
#End Region

    End Class
End Namespace