ArcObjects Library Reference  

FindNearFeaturesSoapSOE_VBNet

About the Find near features SOAP SOE Sample

[C#]

FindNearFeaturesSoapSOE_VBNet.cs


[Visual Basic .NET]

FindNearFeaturesSoapSOE_VBNet.vb

Imports Microsoft.VisualBasic
Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.EnterpriseServices
Imports System.Runtime.InteropServices
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 FindNearFeaturesSoapSOE_VBNet
    <ComVisible(True), Guid("62600B17-14DA-4057-951A-F315D937D497"), ClassInterface(ClassInterfaceType.None)> _
    Public Class FindNearFeaturesSoapSOE_VBNet
        Inherits ServicedComponent
        Implements IRequestHandler2, IServerObjectExtension, IObjectConstruct


        Private Const c_soe_name As String = "FindNearFeaturesSoapSOE_VBNet"
        Friend Const c_ns_soe As String = "http://examples.esri.com/schemas/FindNearFeaturesSoapSOE_VBNet/1.0"
        Friend Const c_ns_esri As String = "http://www.esri.com/schemas/ArcGIS/10.0"

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

        Private reqHandler As IRequestHandler2

        Public Sub New()
            Dim soapCaps As New SoapCapabilities()
            soapCaps.AddMethod("GetLayerInfos", "getInfo")
            soapCaps.AddMethod("FindNearFeatures", "findFeatures")

            logger = New ServerLogger()

            Dim soapImpl As New SoeSoapImpl(c_soe_name, soapCaps, AddressOf HandleSoapMessage)
            reqHandler = CType(soapImpl, IRequestHandler2)
        End Sub

        '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


        'IObjectConstruct 
        Public Overloads Sub Construct(ByVal props As IPropertySet) Implements IObjectConstruct.Construct
            logger.LogMessage(ServerLogger.msgType.infoSimple, QualifiedMethodName(c_soe_name, "Construct"), -1, "Construct starting")

            configProps = props

            logger.LogMessage(ServerLogger.msgType.infoSimple, QualifiedMethodName(c_soe_name, "Construct"), -1, "Construct finishing")
        End Sub

        'IRequestHandler
        Public Function HandleBinaryRequest(ByRef request() As Byte) As Byte() Implements ESRI.ArcGIS.esriSystem.IRequestHandler.HandleBinaryRequest
            Throw New NotImplementedException()
        End Function
        Public Function HandleBinaryRequest2(ByVal Capabilities As String, ByRef request() As Byte) As Byte() Implements ESRI.ArcGIS.esriSystem.IRequestHandler2.HandleBinaryRequest2
            Throw New NotImplementedException()
        End Function
        Public Function HandleStringRequest(ByVal Capabilities As String, ByVal request As String) As String Implements ESRI.ArcGIS.esriSystem.IRequestHandler.HandleStringRequest
            Return reqHandler.HandleStringRequest(Capabilities, request)
        End Function
        Public Function HandleBinaryRequest1(ByRef request() As Byte) As Byte() Implements ESRI.ArcGIS.esriSystem.IRequestHandler2.HandleBinaryRequest
            Throw New NotImplementedException()
        End Function
        Public Function HandleStringRequest1(ByVal Capabilities As String, ByVal request As String) As String Implements ESRI.ArcGIS.esriSystem.IRequestHandler2.HandleStringRequest
            Return reqHandler.HandleStringRequest(Capabilities, request)
        End Function

        Public Sub HandleSoapMessage(ByVal reqMsg As IMessage, ByVal respMsg As IMessage)
            Dim methodName As String = reqMsg.Name

            If String.Compare(methodName, "GetLayerInfos", True) = 0 Then
                GetLayerInfos(reqMsg, respMsg)

            ElseIf String.Compare(methodName, "FindNearFeatures", True) = 0 Then
                FindNearFeatures(reqMsg, respMsg)

            Else
                Throw New ArgumentException("Method not supported: " & QualifiedMethodName(c_soe_name, methodName))
            End If
        End Sub

        Private Function QualifiedMethodName(ByVal soeName As String, ByVal methodName As String) As String
            Return soeName & "." & methodName
        End Function

#Region "wrapperMethods"

        Private Sub GetLayerInfos(ByVal reqMsg As IMessage, ByVal respMsg As IMessage)
            'no input parameters expected in request 

            Dim resultPropSet As CustomLayerInfos_VBNet = GetLayerInfos()

            respMsg.Name = "GetLayerInfosResponse"
            respMsg.NamespaceURI = c_ns_soe
            respMsg.Parameters.AddObject("Result", resultPropSet)
        End Sub

        Private Sub FindNearFeatures(ByVal reqMsg As IMessage, ByVal respMsg As IMessage)
            Dim reqParams As IXMLSerializeData = reqMsg.Parameters

            Dim layerID As Integer = reqParams.GetInteger(FindParam("LayerID", reqParams))

            Dim location As IPoint = CType(reqParams.GetObject(FindParam("Location", reqParams), c_ns_esri, "PointN"), IPoint)

            Dim distance As Double = reqParams.GetDouble(FindParam("Distance", reqParams))

            Dim recordSet As IRecordSet = FindNearFeatures(layerID, location, distance)

            respMsg.Name = "FindNearFeaturesResponse"
            respMsg.NamespaceURI = c_ns_soe
            respMsg.Parameters.AddObject("Result", recordSet)
        End Sub

#End Region ' wrapperMethods


#Region "businessLogicMethods"

        Private Function GetLayerInfos() As CustomLayerInfos_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 As New CustomLayerInfos_VBNet(c_ns_soe)

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

                Dim customLayerInfo As New CustomLayerInfo_VBNet()
                customLayerInfo.Name = layerInfo.Name
                customLayerInfo.ID = layerInfo.ID
                customLayerInfo.Extent = layerInfo.Extent

                customLayerInfos.Add(customLayerInfo)
            Next i

            Return customLayerInfos
        End Function

        Private Function FindNearFeatures(ByVal layerID As Integer, ByVal location As IPoint, ByVal distance As Double) As IRecordSet
            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.esriQueryResultRecordSetAsObject

            Dim tableDesc As IMapTableDescription = GetTableDesc(mapServer, layerID)

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

            Return CType(result.Object, RecordSet)
        End Function
#End Region ' businessLogicMethods


#Region "helperMethods"
        Private Function FindParam(ByVal parameterName As String, ByVal msgParams As IXMLSerializeData) As Integer
            Dim idx As Integer = msgParams.Find(parameterName)
            If idx = -1 Then
                Throw New ArgumentNullException(parameterName)
            End If
            Return idx
        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

        Private Function GetLayerInfo(ByVal mapServer As IMapServer3, ByVal layerID As Integer) As IMapLayerInfo
            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 layerInfo
                End If
            Next i

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




    End Class 'class
End Namespace