Imports System.Reflection Imports System.Security.Principal 'case 1012 Imports System.Runtime.Serialization.Formatters.Binary Imports System.IO.Compression Imports System.IO 'Imports System.Configuration Namespace Server ''' ''' Implements the server-side DataPortal as discussed ''' in Chapter 5. ''' Public Class DataPortal Inherits MarshalByRefObject #Region " Data Access " ''' ''' Called by the client-side DataPortal to create a new object. ''' ''' Object-specific criteria. ''' The user's principal object (if using CSLA .NET security). ''' A populated business object. Public Function Create(ByVal Criteria As Object, ByVal context As DataPortalContext) As Object SetPrincipal(context.Principal) ' create an instance of the business object Dim obj As Object = CreateBusinessObject(Criteria) ' tell the business object to fetch its data CallMethod(obj, "DataPortal_Create", Criteria) ' return the populated business object as a result If context.IsRemotePortal Then Serialization.SerializationNotification.OnSerializing(obj) End If Return obj End Function ''' ''' Called by the client-side DataProtal to retrieve an object. ''' ''' Object-specific criteria. ''' The user's principal object (if using CSLA .NET security). ''' A populated business object. Public Function Fetch(ByVal Criteria As Object, ByVal context As DataPortalContext) As Object SetPrincipal(context.Principal) ' create an instance of the business object Dim obj As Object = CreateBusinessObject(Criteria) ' tell the business object to fetch its data CallMethod(obj, "DataPortal_Fetch", Criteria) ' return the populated business object as a result 'If context.IsRemotePortal Then ' Serialization.SerializationNotification.OnSerializing(obj) 'End If 'case 1012 If context.IsRemotePortal Then Return Compress(obj) Else Return obj End If 'Return obj End Function ''' ''' Called by the client-side DataPortal to update an object. ''' ''' A reference to the object being updated. ''' The user's principal object (if using CSLA .NET security). ''' A reference to the newly updated object. Public Function Update(ByVal obj As Object, ByVal context As DataPortalContext) As Object SetPrincipal(context.Principal) Dim canCompress As Boolean = True 'case 1012 If context.IsRemotePortal AndAlso canCompress Then 'it's coming from the client compressed so decompress first 'Note servicebank can't be compressed due to transaction object not being serializable If (obj.GetType().ToString() <> "GZTW.AyaNova.BLL.ServiceBank") Then obj = Decompress(DirectCast(obj, Byte())) Else canCompress = False End If End If ' tell the business object to update itself CallMethod(obj, "DataPortal_Update") 'case 1012 If context.IsRemotePortal AndAlso canCompress Then 'It's going back to the client remotely so compress it first Return Compress(obj) Else Return obj End If 'Return obj End Function ''' ''' Called by the client-side DataPortal to delete an object. ''' ''' Object-specific criteria. ''' The user's principal object (if using CSLA .NET security). Public Sub Delete(ByVal Criteria As Object, ByVal context As DataPortalContext) SetPrincipal(context.Principal) ' create an instance of the business object Dim obj As Object = CreateBusinessObject(Criteria) ' tell the business object to delete itself CallMethod(obj, "DataPortal_Delete", Criteria) End Sub #End Region #Region "Compression" 'case 1012 Private Shared bSerializer As New BinaryFormatter Public Shared Function Compress(ByVal obj As Object) As Byte() Dim ms3 As New MemoryStream Dim cmp3 As New GZipStream(ms3, CompressionMode.Compress, False) bSerializer.Serialize(cmp3, obj) cmp3.Flush() cmp3.Close() Return ms3.ToArray() End Function Public Shared Function Decompress(ByVal bytes() As Byte) As Object Dim ms4 As New MemoryStream(bytes) Dim cmp4 As New GZipStream(ms4, CompressionMode.Decompress) Dim o As Object = bSerializer.Deserialize(cmp4) Return o End Function #End Region #Region " Security " Private Function AUTHENTICATION() As String Return "CSLA" 'System.CoXXXnfiguration.ConfigurationManager.AppSettings("Authentication") End Function Private Sub SetPrincipal(ByVal Principal As Object) Dim objPrincipal As IPrincipal Dim objIdentity As IIdentity If AUTHENTICATION() = "Windows" Then ' When using integrated security, Principal must be Nothing If Principal Is Nothing Then ' Set .NET to use integrated security AppDomain.CurrentDomain.SetPrincipalPolicy(PrincipalPolicy.WindowsPrincipal) Exit Sub Else Throw New Security.SecurityException( _ "No principal object should be passed to DataPortal when using Windows integrated security") End If End If ' We expect the Principal to be of the type BusinessPrincipal, but we can't enforce ' that since it causes a circular reference with the business library. ' Instead we must use type Object for the parameter, so here we do a check ' on the type of the parameter. objPrincipal = CType(Principal, IPrincipal) If Not (objPrincipal Is Nothing) Then objIdentity = objPrincipal.Identity If Not (objIdentity Is Nothing) Then If objIdentity.AuthenticationType = "CSLA" Then ' See if our current principal is different from the caller's principal If Not ReferenceEquals(Principal, _ System.Threading.Thread.CurrentPrincipal) Then ' The caller had a different principal, so change ours to match the ' caller's, so all our objects use the caller's security. System.Threading.Thread.CurrentPrincipal = CType(Principal, _ IPrincipal) End If Else Throw New Security.SecurityException( _ "Principal must be of type BusinessPrincipal, not " & Principal.ToString()) End If End If Else Throw New Security.SecurityException( _ "Principal must be of type BusinessPrincipal, not Nothing") End If End Sub #End Region #Region " Creating the business object " Private Function CreateBusinessObject(ByVal Criteria As Object) As Object Dim businessType As Type If Criteria.GetType.IsSubclassOf(GetType(CriteriaBase)) Then ' get the type of the actual business object ' from CriteriaBase (using the new scheme) businessType = CType(Criteria, CriteriaBase).ObjectType Else ' get the type of the actual business object ' based on the nested class scheme in the book businessType = Criteria.GetType.DeclaringType End If ' create an instance of the business object Return Activator.CreateInstance(businessType, True) End Function #End Region #Region " Calling a method " Private Function CallMethod(ByVal obj As Object, ByVal method As String, ByVal ParamArray params() As Object) As Object ' call a private method on the object Dim info As MethodInfo = GetMethod(obj.GetType, method) Dim result As Object Try result = info.Invoke(obj, params) Catch e As Exception Throw 'e.InnerException End Try Return result End Function Private Function GetMethod(ByVal ObjectType As Type, ByVal method As String) As MethodInfo Return ObjectType.GetMethod(method, _ BindingFlags.FlattenHierarchy Or _ BindingFlags.Instance Or _ BindingFlags.Public Or _ BindingFlags.NonPublic) End Function #End Region End Class End Namespace