admin/ayanova7
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Browse Source
This commit is contained in:
John Cardinal
2018-06-29 19:47:36 +00:00
commit be7f501333
3769 changed files with 1425961 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
source/csla10/.cvsignore Normal file
View File

@@ -0,0 +1,3 @@
doc
CodeCommentReport
SortingClasses.ZIP

32
source/csla10/Backup/CSLA.BatchQueue/AssemblyInfo.vb Normal file
View File

@@ -0,0 +1,32 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("CSLA.BatchQueue")>
<Assembly: AssemblyDescription("CSLA .NET framework")>
<Assembly: AssemblyCompany("Rockford Lhotka")>
<Assembly: AssemblyProduct("Expert One-on-One VB.NET Business Objects")>
<Assembly: AssemblyCopyright("Copyright 2003 Rockford Lhotka. All rights reserved.")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("EC45E25E-E411-4477-95FE-1F10004502E0")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
<Assembly: AssemblyVersion("1.3.*")>

49
source/csla10/Backup/CSLA.BatchQueue/BatchEntries.vb Normal file
View File

@@ -0,0 +1,49 @@
Imports System.Messaging
Imports System.Runtime.Serialization.Formatters.Binary
''' <summary>
''' Contains a list of holding, pending and active batch
''' queue entries.
''' </summary>
<Serializable()> _
Public Class BatchEntries
Inherits CollectionBase
''' <summary>
''' Returns a reference to an object with information about
''' a specific batch queue entry.
''' </summary>
Default Public ReadOnly Property Entry(ByVal index As Integer) As BatchEntryInfo
Get
Return CType(list.Item(index), BatchEntryInfo)
End Get
End Property
''' <summary>
''' Returns a reference to an object with information about
''' a specific batch queue entry.
''' </summary>
''' <param name="ID">The ID value of the entry to return.</param>
Default Public ReadOnly Property Entry(ByVal ID As Guid) As BatchEntryInfo
Get
Dim obj As BatchEntryInfo
For Each obj In list
If obj.ID.Equals(ID) Then
Return obj
End If
Next
End Get
End Property
Friend Sub New()
' prevent direct creation
End Sub
Friend Sub Add(ByVal Value As BatchEntryInfo)
list.Add(Value)
End Sub
End Class

225
source/csla10/Backup/CSLA.BatchQueue/BatchEntry.vb Normal file
View File

@@ -0,0 +1,225 @@
Imports System.Security.Principal
Imports System.Configuration
''' <summary>
'''
''' </summary>
Namespace Server
''' <summary>
''' A batch queue entry.
''' </summary>
''' <remarks>
''' Each batch queue entry consists of basic information about
''' the entry, a Principal object (if you are using CSLA .NET
''' security), the actual worker object containing the code
''' to be run and an optional state object containing arbitrary
''' state data.
''' </remarks>
<Serializable()> _
Public NotInheritable Class BatchEntry
Private mInfo As New BatchEntryInfo
Private mPrincipal As IPrincipal = GetPrincipal()
Private mWorker As IBatchEntry
Private mState As Object
''' <summary>
''' Returns a reference to the object containing information
''' about this batch entry.
''' </summary>
Public ReadOnly Property Info() As BatchEntryInfo
Get
Return mInfo
End Get
End Property
''' <summary>
''' Returns a reference to the
''' <see cref="T:CSLA.Security.BusinessPrincipal" />
''' object for the user that submitted this entry.
''' </summary>
Public ReadOnly Property Principal() As IPrincipal
Get
Return mPrincipal
End Get
End Property
''' <summary>
''' Returns a reference to the worker object that
''' contains the code which is to be executed as
''' a batch process.
''' </summary>
Public Property Entry() As IBatchEntry
Get
Return mWorker
End Get
Set(ByVal Value As IBatchEntry)
mWorker = Value
End Set
End Property
''' <summary>
''' Returns a reference to the optional state object.
''' </summary>
''' <returns></returns>
Public Property State() As Object
Get
Return mState
End Get
Set(ByVal Value As Object)
mState = Value
End Set
End Property
#Region " Batch execution "
' this will run in a background thread in the
' thread pool
Friend Sub Execute(ByVal State As Object)
Dim oldPrincipal As IPrincipal
Try
' set this thread's principal to our user
oldPrincipal = Threading.Thread.CurrentPrincipal
SetPrincipal(mPrincipal)
Try
' now run the user's code
mWorker.Execute(mState)
Dim sb As New Text.StringBuilder()
With sb
.Append("Batch job completed")
.Append(vbCrLf)
.AppendFormat("Batch job: {0}", Me.ToString)
.Append(vbCrLf)
.AppendFormat("Job object: {0}", CType(mWorker, Object).ToString)
.Append(vbCrLf)
End With
System.Diagnostics.EventLog.WriteEntry( _
BatchQueueService.Name, sb.ToString, EventLogEntryType.Information)
Catch ex As Exception
Dim sb As New Text.StringBuilder()
With sb
.Append("Batch job failed due to execution error")
.Append(vbCrLf)
.AppendFormat("Batch job: {0}", Me.ToString)
.Append(vbCrLf)
.AppendFormat("Job object: {0}", CType(mWorker, Object).ToString)
.Append(vbCrLf)
.Append(ex.ToString)
End With
System.Diagnostics.EventLog.WriteEntry( _
BatchQueueService.Name, sb.ToString, EventLogEntryType.Warning)
End Try
Finally
Server.BatchQueueService.Deactivate(Me)
' reset the thread's principal object
Threading.Thread.CurrentPrincipal = oldPrincipal
End Try
End Sub
#End Region
#Region " System.Object overrides "
Public Overrides Function ToString() As String
Return mInfo.ToString
End Function
Public Overloads Function Equals(ByVal Entry As BatchEntry) As Boolean
Return mInfo.Equals(Entry.Info)
End Function
Public Overrides Function GetHashCode() As Integer
Return mInfo.GetHashCode
End Function
#End Region
#Region " Constructors "
Friend Sub New(ByVal Entry As IBatchEntry)
mWorker = Entry
End Sub
Friend Sub New(ByVal Entry As IBatchEntry, ByVal State As Object)
mWorker = Entry
mState = State
End Sub
#End Region
#Region " Security "
Private Function AUTHENTICATION() As String
Return ConfigurationSettings.AppSettings("Authentication")
End Function
Private Function GetPrincipal() As System.Security.Principal.IPrincipal
If AUTHENTICATION() = "Windows" Then
' Windows integrated security
Return Nothing
Else
' we assume using the CSLA framework security
Return System.Threading.Thread.CurrentPrincipal
End If
End Function
Private Sub SetPrincipal(ByVal Principal As Object)
If AUTHENTICATION() = "Windows" Then
' when using integrated security, Principal must be Nothing
' and we need to set our policy to use the Windows principal
If Principal Is Nothing Then
AppDomain.CurrentDomain.SetPrincipalPolicy(PrincipalPolicy.WindowsPrincipal)
Exit Sub
Else
Throw New System.Security.SecurityException("No principal object should be passed to DataPortal when using Windows integrated security")
End If
End If
' we expect Principal to be of type BusinessPrincipal, but
' we can't enforce that since it causes a circular reference
' with the business library so instead we must use type Object
' for the parameter, so here we do a check on the type of the
' parameter
If Principal.ToString = "CSLA.Security.BusinessPrincipal" 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 System.Security.SecurityException("Principal must be of type BusinessPrincipal, not " & Principal.ToString)
End If
End Sub
#End Region
End Class
End Namespace

185
source/csla10/Backup/CSLA.BatchQueue/BatchEntryInfo.vb Normal file
View File

@@ -0,0 +1,185 @@
Imports System.Environment
''' <summary>
''' Values indicating the status of a batch queue entry.
''' </summary>
Public Enum BatchEntryStatus
Pending
Holding
Active
End Enum
''' <summary>
''' Contains information about a batch queue entry.
''' </summary>
''' <remarks>
''' This object contains information about batch entry including
''' when it was submitted, the user that submitted the job and
''' which machine the user was using at the time. It also contains
''' the job's priority, status and the optional date/time until
''' which the job should be held until it is run.
''' </remarks>
<Serializable()> _
Public Class BatchEntryInfo
Private mID As Guid = Guid.NewGuid
Private mSubmitted As Date = Now
Private mUser As String = System.Environment.UserName
Private mMachine As String = System.Environment.MachineName
Private mPriority As Messaging.MessagePriority = Messaging.MessagePriority.Normal
Private mMsgID As String
Private mHoldUntil As Date = Date.MinValue
Private mStatus As BatchEntryStatus = BatchEntryStatus.Pending
''' <summary>
''' Returns the unique ID value for this batch entry.
''' </summary>
Public ReadOnly Property ID() As Guid
Get
Return mID
End Get
End Property
''' <summary>
''' Returns the date and time that the batch entry
''' was submitted.
''' </summary>
Public ReadOnly Property Submitted() As Date
Get
Return mSubmitted
End Get
End Property
''' <summary>
''' Returns the Windows user id of the user that
''' was logged into the workstation when the job
''' was submitted.
''' </summary>
Public ReadOnly Property User() As String
Get
Return mUser
End Get
End Property
''' <summary>
''' Returns the name of the workstation from
''' which this job was submitted.
''' </summary>
Public ReadOnly Property Machine() As String
Get
Return mMachine
End Get
End Property
''' <summary>
''' Returns the priority of this batch entry.
''' </summary>
''' <remarks>
''' The priority values flow from System.Messaging and
''' the priority is used by MSMQ to order the entries
''' in the queue.
''' </remarks>
Public Property Priority() As Messaging.MessagePriority
Get
Return mPriority
End Get
Set(ByVal Value As Messaging.MessagePriority)
mPriority = Value
End Set
End Property
''' <summary>
''' Returns the MSMQ message ID of the batch entry.
''' </summary>
''' <remarks>
''' This value is only valid after the batch entry
''' has been submitted to the queue.
''' </remarks>
Public ReadOnly Property MessageID() As String
Get
Return mMsgID
End Get
End Property
Friend Sub SetMessageID(ByVal ID As String)
mMsgID = ID
End Sub
''' <summary>
''' Returns the date and time until which the
''' batch entry will be held before it can be run.
''' </summary>
''' <remarks>
''' This value is optional. If it was provided, the batch
''' entry will be held until this date/time. At this date/time,
''' the entry will switch from Holding status to Pending
''' status and will be queued based on its priority along
''' with all other Pending entries.
''' </remarks>
Public Property HoldUntil() As Date
Get
Return mHoldUntil
End Get
Set(ByVal Value As Date)
mHoldUntil = Value
End Set
End Property
''' <summary>
''' Returns the status of the batch entry.
''' </summary>
''' <remarks>
''' <para>
''' If the job is Holding, it means that the job
''' won't run until the data/time specified by
''' <see cref="P:CSLA.BatchQueue.BatchEntryInfo.HoldUntil" />.
''' </para><para>
''' If the job is Pending, it means that the job
''' will run as soon as possible, but that the queue
''' is busy. Pending entries are run in priority order based
''' on <see cref="P:CSLA.BatchQueue.BatchEntryInfo.Priority" />.
''' </para><para>
''' If the job is Active, it means that the job is
''' currently being executed on the server.
''' </para>
''' </remarks>
Public ReadOnly Property Status() As BatchEntryStatus
Get
If mHoldUntil > Now AndAlso mStatus = BatchEntryStatus.Pending Then
Return BatchEntryStatus.Holding
Else
Return mStatus
End If
End Get
End Property
Friend Sub SetStatus(ByVal Status As BatchEntryStatus)
mStatus = Status
End Sub
#Region " System.Object overrides "
Public Overrides Function ToString() As String
Return mUser & "@" & mMachine & ":" & mID.ToString
End Function
Public Overloads Function Equals(ByVal Info As BatchEntryInfo) As Boolean
Return mID.Equals(Info.ID)
End Function
Public Overrides Function GetHashCode() As Integer
Return mID.GetHashCode
End Function
#End Region
End Class

97
source/csla10/Backup/CSLA.BatchQueue/BatchJobRequest.vb Normal file
View File

@@ -0,0 +1,97 @@
''' <summary>
''' A helper object used to execute a specified class
''' from a specified DLL on the server.
''' </summary>
''' <remarks>
''' <para>
''' A worker object can be provided directly by the client
''' workstation. In that case, the worker object is passed
''' by value to the server where it is executed. The drawback
''' to such an approach is that the worker assembly must be
''' installed on both client and server.
''' </para><para>
''' BatchJobRequest is a worker object that specifies the
''' type and assembly name of a class on the server. When
''' this job is run, it dynamically creates an instance of
''' the specified class and executes it on the server. This
''' means that the actual worker assembly needs to be installed
''' only on the server, not on the client.
''' </para>
''' </remarks>
<Serializable()> _
Public Class BatchJobRequest
Implements IBatchEntry
Private mAssembly As String = ""
Private mType As String = ""
''' <summary>
''' Creates a new object, specifying the type and assembly
''' of the actual worker object.
''' </summary>
''' <param name="Type">The class name of the actual worker object.</param>
''' <param name="Assembly">The name of the assembly containing the actual worker class.</param>
Public Sub New(ByVal Type As String, ByVal [Assembly] As String)
mAssembly = [Assembly]
mType = Type
End Sub
''' <summary>
''' The class name of the worker object.
''' </summary>
Public Property Type() As String
Get
Return mType
End Get
Set(ByVal Value As String)
mType = Value
End Set
End Property
''' <summary>
''' The name of the assembly containing the actual worker class.
''' </summary>
Public Property [Assembly]() As String
Get
Return mAssembly
End Get
Set(ByVal Value As String)
mAssembly = Value
End Set
End Property
''' <summary>
''' Executes the batch job on the server.
''' </summary>
''' <remarks>
''' This method runs on the server - it is called
''' by <see cref="T:CSLA.BatchQueue.Server.BatchEntry" />,
''' which is called by
''' <see cref="T:CSLA.BatchQueue.Server.BatchQueueService" />.
''' </remarks>
''' <param name="State"></param>
Public Sub Execute(ByVal State As Object) _
Implements IBatchEntry.Execute
' create an instance of the specified object
Dim job As IBatchEntry
job = CType(AppDomain.CurrentDomain.CreateInstanceAndUnwrap(mAssembly, mType), IBatchEntry)
' execute the job
job.Execute(State)
End Sub
#Region " System.Object overrides "
Public Overrides Function ToString() As String
Return "BatchJobRequest: " & mType & "," & mAssembly
End Function
#End Region
End Class

257
source/csla10/Backup/CSLA.BatchQueue/BatchQueue.vb Normal file
View File

@@ -0,0 +1,257 @@
Imports System.Runtime.Remoting.Channels
Imports System.Runtime.Remoting.Channels.Tcp
Imports System.Configuration
''' <summary>
''' Provides easy access to the batch queue functionality.
''' </summary>
''' <remarks>
''' Client code should create an instance of this class to
''' interact with a batch queue. A BatchQueue object can
''' be used to interact with either the default batch queue
''' server or with a specific batch queue server.
''' </remarks>
Public Class BatchQueue
Private mQueueURL As String
Private mServer As Server.BatchQueue
#Region " Constructors and Initialization "
''' <summary>
''' Creates an instance of the object that allows interaction
''' with the default batch queue server as specified in the
''' application configuration file.
''' </summary>
Public Sub New()
mQueueURL = ConfigurationSettings.AppSettings("DefaultBatchQueueServer")
End Sub
''' <summary>
''' Creates an instance of the object that allows interaction
''' with a specific batch queue server as specified by
''' the URL passed as a parameter.
''' </summary>
''' <param name="QueueServerURL">A URL referencing the batch queue server.</param>
Public Sub New(ByVal QueueServerURL As String)
mQueueURL = QueueServerURL
End Sub
Private Function QueueServer() As Server.BatchQueue
If mServer Is Nothing Then
mServer = _
CType(Activator.GetObject(GetType(Server.BatchQueue), _
mQueueURL), _
Server.BatchQueue)
End If
Return mServer
End Function
#End Region
#Region " Submitting jobs "
''' <summary>
''' Submits an entry to the batch queue.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
Public Sub Submit(ByVal Entry As IBatchEntry)
QueueServer.Submit(New Server.BatchEntry(Entry))
End Sub
''' <summary>
''' Submits an entry to the batch queue with extra state data.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="State">A reference to a serializable object containing state data.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, ByVal State As Object)
QueueServer.Submit(New Server.BatchEntry(Entry, State))
End Sub
''' <summary>
''' Submits an entry to the batch queue with a specific priority.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="Priority">The priority of the entry.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, _
ByVal Priority As Messaging.MessagePriority)
Dim job As Server.BatchEntry = New Server.BatchEntry(Entry)
job.Info.Priority = Priority
QueueServer.Submit(job)
End Sub
''' <summary>
''' Submits an entry to the batch queue with extra state data and
''' a specific priority.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="State">A reference to a serializable object containing state data.</param>
''' <param name="Priority">The priority of the entry.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, _
ByVal State As Object, _
ByVal Priority As Messaging.MessagePriority)
Dim job As Server.BatchEntry = New Server.BatchEntry(Entry, State)
job.Info.Priority = Priority
QueueServer.Submit(job)
End Sub
''' <summary>
''' Submits an entry to the batch queue to be held until a specific date/time.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="HoldUntil">The date/time until which the entry should be held.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, ByVal HoldUntil As Date)
Dim job As Server.BatchEntry = New Server.BatchEntry(Entry)
job.Info.HoldUntil = HoldUntil
QueueServer.Submit(job)
End Sub
''' <summary>
''' Submits an entry to the batch queue with extra state data
''' and to be held until a specific date/time.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="State">A reference to a serializable object containing state data.</param>
''' <param name="HoldUntil">The date/time until which the entry should be held.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, _
ByVal State As Object, _
ByVal HoldUntil As Date)
Dim job As Server.BatchEntry = New Server.BatchEntry(Entry, State)
job.Info.HoldUntil = HoldUntil
QueueServer.Submit(job)
End Sub
''' <summary>
''' Submits an entry to the batch queue to be held until
''' a specific date/time and at a specific priority.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="HoldUntil">The date/time until which the entry should be held.</param>
''' <param name="Priority">The priority of the entry.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, _
ByVal HoldUntil As Date, ByVal Priority As Messaging.MessagePriority)
Dim job As Server.BatchEntry = New Server.BatchEntry(Entry)
job.Info.HoldUntil = HoldUntil
job.Info.Priority = Priority
QueueServer.Submit(job)
End Sub
''' <summary>
''' Submits an entry to the batch queue specifying all details.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="State">A reference to a serializable object containing state data.</param>
''' <param name="HoldUntil">The date/time until which the entry should be held.</param>
''' <param name="Priority">The priority of the entry.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, _
ByVal State As Object, _
ByVal HoldUntil As Date, _
ByVal Priority As Messaging.MessagePriority)
Dim job As Server.BatchEntry = New Server.BatchEntry(Entry, State)
job.Info.HoldUntil = HoldUntil
job.Info.Priority = Priority
QueueServer.Submit(job)
End Sub
#End Region
#Region " Public methods "
''' <summary>
''' Removes a holding or pending entry from the
''' batch queue.
''' </summary>
''' <param name="Entry">A reference to the entry to be removed.</param>
Public Sub Remove(ByVal Entry As BatchEntryInfo)
QueueServer.Remove(Entry)
End Sub
''' <summary>
''' Returns the URL which identifies the batch
''' queue server to which this object is attached.
''' </summary>
Public ReadOnly Property BatchQueueURL() As String
Get
Return mQueueURL
End Get
End Property
''' <summary>
''' Returns a collection of the batch entries currently
''' in the batch queue.
''' </summary>
Public ReadOnly Property Entries() As BatchEntries
Get
Return QueueServer.GetEntries(GetPrincipal)
End Get
End Property
#End Region
#Region " System.Object overrides "
Public Overrides Function ToString() As String
Return mQueueURL
End Function
Public Overloads Function Equals(ByVal Queue As BatchQueue) As Boolean
Return mQueueURL = Queue.BatchQueueURL
End Function
Public Overrides Function GetHashCode() As Integer
Return mQueueURL.GetHashCode
End Function
#End Region
#Region " Security "
Private Function AUTHENTICATION() As String
Return ConfigurationSettings.AppSettings("Authentication")
End Function
Private Function GetPrincipal() As System.Security.Principal.IPrincipal
If AUTHENTICATION() = "Windows" Then
' Windows integrated security
Return Nothing
Else
' we assume using the CSLA framework security
Return System.Threading.Thread.CurrentPrincipal
End If
End Function
#End Region
End Class

103
source/csla10/Backup/CSLA.BatchQueue/BatchQueueServer.vb Normal file
View File

@@ -0,0 +1,103 @@
Imports System.Security.Principal
Imports System.Configuration
Imports CSLA.Security
''' <summary>
'''
''' </summary>
Namespace Server
''' <summary>
''' This is the entry point for all queue requests from
''' the client via Remoting.
''' </summary>
Public Class BatchQueue
Inherits MarshalByRefObject
#Region " Public methods "
''' <summary>
''' Submits a batch entry to the queue.
''' </summary>
''' <param name="Entry">A reference to the batch entry.</param>
Public Sub Submit(ByVal Entry As BatchEntry)
BatchQueueService.Enqueue(Entry)
End Sub
''' <summary>
''' Removes a holding or pending entry from the queue.
''' </summary>
''' <param name="Entry">A reference to the info object for the batch entry.</param>
Public Sub Remove(ByVal Entry As BatchEntryInfo)
BatchQueueService.Dequeue(Entry)
End Sub
''' <summary>
''' Gets a list of the entries currently in the
''' batch queue.
''' </summary>
''' <param name="Principal">The requesting user's security credentials.</param>
Public Function GetEntries(ByVal Principal As IPrincipal) As BatchEntries
SetPrincipal(Principal)
Dim entries As New BatchEntries()
BatchQueueService.LoadEntries(entries)
Return entries
End Function
#End Region
#Region " Security "
Private Function AUTHENTICATION() As String
Return ConfigurationSettings.AppSettings("Authentication")
End Function
Private Sub SetPrincipal(ByVal Principal As Object)
If AUTHENTICATION() = "Windows" Then
' when using integrated security, Principal must be Nothing
' and we need to set our policy to use the Windows principal
If Principal Is Nothing Then
AppDomain.CurrentDomain.SetPrincipalPolicy(PrincipalPolicy.WindowsPrincipal)
Exit Sub
Else
Throw New System.Security.SecurityException("No principal object should be passed to DataPortal when using Windows integrated security")
End If
End If
' we expect Principal to be of type BusinessPrincipal, but
' we can't enforce that since it causes a circular reference
' with the business library so instead we must use type Object
' for the parameter, so here we do a check on the type of the
' parameter
If Principal.ToString = "CSLA.Security.BusinessPrincipal" 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 System.Security.SecurityException("Principal must be of type BusinessPrincipal, not " & Principal.ToString)
End If
End Sub
#End Region
End Class
End Namespace

337
source/csla10/Backup/CSLA.BatchQueue/BatchQueueService.vb Normal file
View File

@@ -0,0 +1,337 @@
Imports System.Configuration
Imports System.Messaging
Imports System.Runtime.Remoting
Imports System.Runtime.Remoting.Channels
Imports System.Runtime.Remoting.Channels.Tcp
Imports System.IO
Imports System.Runtime.Serialization.Formatters.Binary
''' <summary>
'''
''' </summary>
Namespace Server
''' <summary>
''' Implements the batch queue service.
''' </summary>
''' <remarks>
''' This class implements the server-side batch queue functionality.
''' It must be hosted within some process, typically a Windows Service.
''' It may also be hosted within a console application, which is
''' useful for testing and debugging.
''' </remarks>
Public Class BatchQueueService
Private Shared mChannel As TcpServerChannel
Private Shared mQueue As MessageQueue
Private Shared mMonitor As Threading.Thread
Private Shared WithEvents mTimer As New System.Timers.Timer
Private Shared mRunning As Boolean
Private Shared mActiveEntries As Hashtable = Hashtable.Synchronized(New Hashtable)
Private Shared mSync As New Threading.AutoResetEvent(False)
Private Shared mWaitToEnd As New Threading.ManualResetEvent(False)
''' <summary>
''' Returns the name of the batch queue server.
''' </summary>
Public Shared ReadOnly Property Name() As String
Get
Return LISTENER_NAME()
End Get
End Property
#Region " Start/Stop "
''' <summary>
''' Starts the batch queue.
''' </summary>
''' <remarks>
''' Call this as your Windows Service starts up to
''' start the batch queue itself. This will cause
''' the queue to start listening for user requests
''' via remoting and to the MSMQ for queued jobs.
''' </remarks>
Public Shared Sub Start()
mTimer.AutoReset = False
' open and/or create queue
If MessageQueue.Exists(QUEUE_NAME) Then
mQueue = New MessageQueue(QUEUE_NAME)
Else
mQueue = MessageQueue.Create(QUEUE_NAME)
End If
mQueue.MessageReadPropertyFilter.Extension = True
' start reading from queue
mRunning = True
mMonitor = New Threading.Thread(AddressOf MonitorQueue)
mMonitor.Name = "MonitorQueue"
mMonitor.Start()
' start remoting for Server.BatchQueue
If mChannel Is Nothing Then
' set application name (virtual root name)
RemotingConfiguration.ApplicationName = LISTENER_NAME()
' set up channel
Dim properties As New Hashtable()
properties("name") = "TcpBinary"
properties("priority") = "2"
properties("port") = CStr(PORT())
Dim svFormatter As New BinaryServerFormatterSinkProvider()
'TODO: uncomment the following line for .NET 1.1
'svFormatter.TypeFilterLevel = Runtime.Serialization.Formatters.TypeFilterLevel.Full
mChannel = New TcpServerChannel(properties, svFormatter)
Channels.ChannelServices.RegisterChannel(mChannel)
' register our class
RemotingConfiguration.RegisterWellKnownServiceType( _
GetType(Server.BatchQueue), _
"BatchQueue.rem", _
WellKnownObjectMode.SingleCall)
Else
mChannel.StartListening(Nothing)
End If
Dim sb As New Text.StringBuilder()
sb.Append("Batch queue processor started")
sb.Append(vbCrLf)
sb.AppendFormat("Name: {0}", Name)
sb.Append(vbCrLf)
sb.AppendFormat("Port: {0}", PORT)
sb.Append(vbCrLf)
sb.AppendFormat("Queue: {0}", QUEUE_NAME)
sb.Append(vbCrLf)
sb.AppendFormat("Max jobs: {0}", MAX_ENTRIES)
sb.Append(vbCrLf)
System.Diagnostics.EventLog.WriteEntry( _
Name, sb.ToString, EventLogEntryType.Information)
End Sub
''' <summary>
''' Stops the batch queue.
''' </summary>
''' <remarks>
''' <para>
''' Call this as your Windows Service is stopping. It
''' stops the batch queue, causing it to stop listening
''' for user requests via remoting and to stop looking for
''' jobs in the MSMQ queue.
''' </para><para>
''' NOTE that this method will not return until any
''' currently active (executing) batch jobs have completed.
''' </para>
''' </remarks>
Public Shared Sub [Stop]()
' stop remoting for Server.BatchQueue
mChannel.StopListening(Nothing)
' signal to stop working
mRunning = False
mSync.Set()
mMonitor.Join()
' close the queue
mQueue.Close()
If mActiveEntries.Count > 0 Then
' wait for work to end
mWaitToEnd.WaitOne()
End If
End Sub
#End Region
#Region " Process messages "
' this will be running on a background thread
Private Shared Sub MonitorQueue()
While mRunning
ScanQueue()
mSync.WaitOne()
End While
End Sub
' this runs on a threadpool thread
Private Shared Sub mTimer_Elapsed(ByVal sender As Object, _
ByVal e As System.Timers.ElapsedEventArgs) Handles mTimer.Elapsed
mTimer.Stop()
mSync.Set()
End Sub
' this is called by MonitorQueue
Private Shared Sub ScanQueue()
Dim msg As Message
Dim holdUntil As Date
Dim nextWake As Date = Date.MaxValue
Dim en As MessageEnumerator = mQueue.GetMessageEnumerator
While en.MoveNext()
msg = en.Current
holdUntil = CDate(Text.Encoding.ASCII.GetString(msg.Extension))
If holdUntil <= Now Then
If mActiveEntries.Count < MAX_ENTRIES() Then
ProcessEntry(mQueue.ReceiveById(msg.Id))
Else
' the queue is busy, go to sleep
Exit Sub
End If
ElseIf holdUntil < nextWake Then
' find the minimum holduntil value
nextWake = holdUntil
End If
End While
If nextWake < Date.MaxValue AndAlso nextWake > Now Then
' we have at least one entry holding, so set the
' timer to wake us when it should be run
mTimer.Interval = nextWake.Subtract(Now).TotalMilliseconds
mTimer.Start()
End If
End Sub
Private Shared Sub ProcessEntry(ByVal msg As Message)
' get entry from queue
Dim entry As BatchEntry
Dim formatter As New BinaryFormatter()
entry = CType(formatter.Deserialize(msg.BodyStream), BatchEntry)
' make active
entry.Info.SetStatus(BatchEntryStatus.Active)
mActiveEntries.Add(entry.Info.ID, entry.Info)
' start processing entry on background thread
Threading.ThreadPool.QueueUserWorkItem(AddressOf entry.Execute)
End Sub
' called by BatchEntry when it is done processing so
' we know that it is complete and we can start another
' job if needed
Friend Shared Sub Deactivate(ByVal entry As BatchEntry)
mActiveEntries.Remove(entry.Info.ID)
mSync.Set()
If Not mRunning AndAlso mActiveEntries.Count = 0 Then
' indicate that there are no active workers
mWaitToEnd.Set()
End If
End Sub
#End Region
#Region " Enqueue/Dequeue/LoadEntries "
Friend Shared Sub Enqueue(ByVal Entry As BatchEntry)
Dim msg As New Message()
Dim f As New BinaryFormatter()
With msg
.Label = Entry.ToString
.Priority = Entry.Info.Priority
.Extension = Text.Encoding.ASCII.GetBytes(CStr(Entry.Info.HoldUntil))
Entry.Info.SetMessageID(.Id)
f.Serialize(.BodyStream, Entry)
End With
mQueue.Send(msg)
mSync.Set()
End Sub
Friend Shared Sub Dequeue(ByVal Entry As BatchEntryInfo)
Dim label As String
Dim msg As Message
Dim msgID As String
label = Entry.ToString
Dim en As MessageEnumerator = mQueue.GetMessageEnumerator
mQueue.MessageReadPropertyFilter.Label = True
While en.MoveNext()
If en.Current.Label = label Then
' we found a match
msgID = en.Current.Id
Exit While
End If
End While
If Len(msgID) > 0 Then
mQueue.ReceiveById(msgID)
End If
End Sub
Friend Shared Sub LoadEntries(ByVal List As BatchEntries)
' load our list of BatchEntry objects
Dim msgs() As Message
Dim msg As Message
Dim formatter As New BinaryFormatter()
Dim de As DictionaryEntry
Dim entry As Server.BatchEntry
' get all active entries
SyncLock mActiveEntries.SyncRoot
For Each de In Server.BatchQueueService.mActiveEntries
List.Add(CType(de.Value, BatchEntryInfo))
Next
End SyncLock
' get all queued entries
msgs = mQueue.GetAllMessages
For Each msg In msgs
entry = CType(formatter.Deserialize(msg.BodyStream), Server.BatchEntry)
entry.Info.SetMessageID(msg.Id)
List.Add(entry.Info)
Next
End Sub
#End Region
#Region " Utility functions "
Private Shared Function QUEUE_NAME() As String
Return ".\private$\" & ConfigurationSettings.AppSettings("QueueName")
End Function
Private Shared Function LISTENER_NAME() As String
Return ConfigurationSettings.AppSettings("ListenerName")
End Function
Private Shared Function PORT() As Integer
Return CInt(ConfigurationSettings.AppSettings("ListenerPort"))
End Function
Private Shared Function MAX_ENTRIES() As Integer
Return CInt(ConfigurationSettings.AppSettings("MaxActiveEntries"))
End Function
#End Region
End Class
End Namespace

39
source/csla10/Backup/CSLA.BatchQueue/CSLA.BatchQueue.vbproj Normal file
View File

@@ -0,0 +1,39 @@
<VisualStudioProject>
<VisualBasic ProjectType="Local" ProductVersion="7.10.3077" SchemaVersion="2.0" ProjectGuid="{F8E2709C-E0DE-4253-9A1A-59F4F59B0EBD}">
<Build>
<Settings ApplicationIcon="" AssemblyKeyContainerName="" AssemblyName="CSLA.BatchQueue" AssemblyOriginatorKeyFile="" AssemblyOriginatorKeyMode="None" DefaultClientScript="JScript" DefaultHTMLPageLayout="Grid" DefaultTargetSchema="IE50" DelaySign="false" OutputType="Library" OptionCompare="Binary" OptionExplicit="On" OptionStrict="Off" RootNamespace="CSLA.BatchQueue" StartupObject="">
<Config Name="Debug" BaseAddress="285212672" ConfigurationOverrideFile="" DefineConstants="" DefineDebug="true" DefineTrace="true" DebugSymbols="true" IncrementalBuild="true" Optimize="false" OutputPath="bin\" RegisterForComInterop="false" RemoveIntegerChecks="false" TreatWarningsAsErrors="false" WarningLevel="1" />
<Config Name="Release" BaseAddress="285212672" ConfigurationOverrideFile="" DefineConstants="" DefineDebug="false" DefineTrace="true" DebugSymbols="false" IncrementalBuild="false" Optimize="true" OutputPath="bin\" RegisterForComInterop="false" RemoveIntegerChecks="false" TreatWarningsAsErrors="false" WarningLevel="1" />
</Settings>
<References>
<Reference Name="System" AssemblyName="System" />
<Reference Name="System.Data" AssemblyName="System.Data" />
<Reference Name="System.XML" AssemblyName="System.Xml" />
<Reference Name="System.Messaging" AssemblyName="System.Messaging" HintPath="..\..\..\WINDOWS\Microsoft.NET\Framework\v1.0.3705\System.Messaging.dll" />
<Reference Name="System.Runtime.Remoting" AssemblyName="System.Runtime.Remoting" HintPath="..\..\..\WINDOWS\Microsoft.NET\Framework\v1.0.3705\System.Runtime.Remoting.dll" />
<Reference Name="CSLA" Project="{1B9A38BB-461A-47A4-AD72-099C694138A0}" Package="{F184B08F-C81C-45F6-A57F-5ABD9991F28F}" />
</References>
<Imports>
<Import Namespace="Microsoft.VisualBasic" />
<Import Namespace="System" />
<Import Namespace="System.Collections" />
<Import Namespace="System.Data" />
<Import Namespace="System.Diagnostics" />
</Imports>
</Build>
<Files>
<Include>
<File RelPath="AssemblyInfo.vb" SubType="Code" BuildAction="Compile" />
<File RelPath="BatchEntries.vb" SubType="Code" BuildAction="Compile" />
<File RelPath="BatchEntry.vb" SubType="Code" BuildAction="Compile" />
<File RelPath="BatchEntryInfo.vb" SubType="Code" BuildAction="Compile" />
<File RelPath="BatchJobRequest.vb" SubType="Code" BuildAction="Compile" />
<File RelPath="BatchQueue.vb" SubType="Code" BuildAction="Compile" />
<File RelPath="BatchQueueServer.vb" SubType="Code" BuildAction="Compile" />
<File RelPath="BatchQueueService.vb" SubType="Code" BuildAction="Compile" />
<File RelPath="IBatchEntry.vb" SubType="Code" BuildAction="Compile" />
</Include>
</Files>
</VisualBasic>
</VisualStudioProject>

48
source/csla10/Backup/CSLA.BatchQueue/CSLA.BatchQueue.vbproj.user Normal file
View File

@@ -0,0 +1,48 @@
<VisualStudioProject>
<VisualBasic LastOpenVersion = "7.10.3077" >
<Build>
<Settings ReferencePath = "" >
<Config
Name = "Debug"
EnableASPDebugging = "false"
EnableASPXDebugging = "false"
EnableUnmanagedDebugging = "false"
EnableSQLServerDebugging = "false"
RemoteDebugEnabled = "false"
RemoteDebugMachine = ""
StartAction = "Project"
StartArguments = ""
StartPage = ""
StartProgram = ""
StartURL = ""
StartWorkingDirectory = ""
StartWithIE = "false"
/>
<Config
Name = "Release"
EnableASPDebugging = "false"
EnableASPXDebugging = "false"
EnableUnmanagedDebugging = "false"
EnableSQLServerDebugging = "false"
RemoteDebugEnabled = "false"
RemoteDebugMachine = ""
StartAction = "Project"
StartArguments = ""
StartPage = ""
StartProgram = ""
StartURL = ""
StartWorkingDirectory = ""
StartWithIE = "false"
/>
</Settings>
</Build>
<OtherProjectSettings
CopyProjectDestinationFolder = ""
CopyProjectUncPath = ""
CopyProjectOption = "0"
ProjectView = "ProjectFiles"
ProjectTrust = "0"
/>
</VisualBasic>
</VisualStudioProject>

18
source/csla10/Backup/CSLA.BatchQueue/IBatchEntry.vb Normal file
View File

@@ -0,0 +1,18 @@
''' <summary>
''' Defines the interface that must be implemented by
''' all worker classes.
''' </summary>
''' <remarks>
''' To create a worker that can be executed within the
''' batch queue, implement this interface. The interface
''' will be invoked by the batch queue processor on the
''' server.
''' </remarks>
Public Interface IBatchEntry
''' <summary>
''' This method should contain your worker code that
''' is to be run in the batch queue.
''' </summary>
''' <param name="State">An optional object containing extra state data from the client.</param>
Sub Execute(ByVal State As Object)
End Interface

59
source/csla10/Backup/CSLA.Core.Bindablebase/AssemblyInfo.cs Normal file
View File

@@ -0,0 +1,59 @@
using System.Reflection;
using System.Runtime.CompilerServices;
//
// General Information about an assembly is controlled through the following
// set of attributes. Change these attribute values to modify the information
// associated with an assembly.
//
[assembly: AssemblyTitle("CSLA.Core.BindableBase")]
[assembly: AssemblyDescription("CSLA .NET framework")]
[assembly: AssemblyConfiguration("")]
[assembly: AssemblyCompany("Rockford Lhotka")]
[assembly: AssemblyProduct("Expert One-on-One VB.NET Business Objects")]
[assembly: AssemblyCopyright("Copyright 2003 Rockford Lhotka. All rights reserved.")]
[assembly: AssemblyTrademark("")]
[assembly: AssemblyCulture("")]
//
// Version information for an assembly consists of the following four values:
//
// Major Version
// Minor Version
// Build Number
// Revision
//
// You can specify all the values or you can default the Revision and Build Numbers
// by using the '*' as shown below:
[assembly: AssemblyVersion("1.3.0")]
//
// In order to sign your assembly you must specify a key to use. Refer to the
// Microsoft .NET Framework documentation for more information on assembly signing.
//
// Use the attributes below to control which key is used for signing.
//
// Notes:
// (*) If no key is specified, the assembly is not signed.
// (*) KeyName refers to a key that has been installed in the Crypto WorkorderService
// Provider (CSP) on your machine. KeyFile refers to a file which contains
// a key.
// (*) If the KeyFile and the KeyName values are both specified, the
// following processing occurs:
// (1) If the KeyName can be found in the CSP, that key is used.
// (2) If the KeyName does not exist and the KeyFile does exist, the key
// in the KeyFile is installed into the CSP and used.
// (*) In order to create a KeyFile, you can use the sn.exe (Strong Name) utility.
// When specifying the KeyFile, the location of the KeyFile should be
// relative to the project output directory which is
// %Project Directory%\obj\<configuration>. For example, if your KeyFile is
// located in the project directory, you would specify the AssemblyKeyFile
// attribute as [assembly: AssemblyKeyFile("..\\..\\mykey.snk")]
// (*) Delay Signing is an advanced option - see the Microsoft .NET Framework
// documentation for more information on this.
//
//[assembly: AssemblyDelaySign(false)]
//[assembly: AssemblyKeyFile("..\\..\\..\\..\\..\\keys\\AyaNova.snk")]
//[assembly: AssemblyKeyName("")]
//[assembly:System.CLSCompliant(true)]

BIN
source/csla10/Backup/CSLA.Core.Bindablebase/AyaNova.snk Normal file
View File

Binary file not shown.

27
source/csla10/Backup/CSLA.Core.Bindablebase/BindableBase.cs Normal file
View File

@@ -0,0 +1,27 @@
using System;
namespace CSLA.Core
{
/// <summary>
/// This base class declares the IsDirtyChanged event
/// to be NonSerialized so serialization will work.
/// </summary>
[Serializable()]
public abstract class BindableBase
{
/// <summary>
/// Declares a serialization-safe IsDirtyChanged event.
/// </summary>
[field: NonSerialized]
public event EventHandler IsDirtyChanged;
/// <summary>
/// Call this method to raise the IsDirtyChanged event.
/// </summary>
virtual protected void OnIsDirtyChanged()
{
if (IsDirtyChanged != null)
IsDirtyChanged(this, EventArgs.Empty);
}
}
}

242
source/csla10/Backup/CSLA.Core.Bindablebase/BindableCollectionBase.cs Normal file
View File

@@ -0,0 +1,242 @@
using System;
using System.Collections;
using System.ComponentModel;
namespace CSLA.Core
{
/// <summary>
/// This is a base class that exposes an implementation
/// of IBindableList that does nothing other than
/// create a nonserialized version of the listchanged
/// event.
/// </summary>
[Serializable]
public abstract class BindableCollectionBase : CollectionBase, IBindingList
{
#region Protected control variables
/// <summary>
/// Set this to True to allow data binding to add new
/// child objects to the collection.
/// </summary>
/// <remarks>
/// If you set this to True, you must also override the OnAddNew
/// method. You must also set AllowEdit to True.
/// </remarks>
protected bool AllowNew = false;
/// <summary>
/// Set this to True to allow data binding to do in-place
/// editing of child objects in a grid control.
/// </summary>
protected bool AllowEdit = false;
/// <summary>
/// Set this to True to allow data binding to automatically
/// remove child objects from the collection.
/// </summary>
protected bool AllowRemove = false;
/// <summary>
/// Set this to True to allow this collection to be sorted.
/// </summary>
/// <remarks>
/// <para>
/// There is an overhead cost to enabling sorting. Specifically,
/// the collection must contain an internal collection containing
/// the original order of the items in the collection, so the order
/// can be reset if the sort is removed.
/// </para><para>
/// This overhead is only incurred if AllowSort is set to True, and is
/// only a major concern if you are using a remote DataPortal. The concern
/// there is that this extra collection must also be serialized, thus
/// increasing the overall amount of data sent across the wire.
/// </para>
/// </remarks>
protected bool AllowSort = false;
/// <summary>
/// Set this to True to allow this collection to be
/// searched.
/// </summary>
protected bool AllowFind = false;
#endregion
#region ListChanged event
/// <summary>
/// Declares a serialization-safe ListChanged event.
/// </summary>
[field: NonSerialized]
public event System.ComponentModel.ListChangedEventHandler ListChanged;
/// <summary>
/// Call this method to raise the ListChanged event.
/// </summary>
virtual protected void OnListChanged(System.ComponentModel.ListChangedEventArgs e)
{
if (ListChanged != null)
ListChanged(this, e);
}
#endregion
#region Collection events
// *******************************************************************
/// <summary>
/// Ensures that the OnListChanged event is raised when a
/// new child is inserted.
/// </summary>
override protected void OnInsertComplete(int index, object value)
{
OnListChanged(new ListChangedEventArgs(ListChangedType.ItemAdded, index));
}
/// <summary>
/// Ensures that the OnListChanged event is raised when the
/// list is cleared.
/// </summary>
override protected void OnClearComplete()
{
OnListChanged(new ListChangedEventArgs(ListChangedType.Reset, 0));
}
/// <summary>
/// Ensures that the OnListChanged event is raised when an
/// item is removed.
/// </summary>
override protected void OnRemoveComplete(int index, object value)
{
OnListChanged(new ListChangedEventArgs(ListChangedType.ItemDeleted, index));
}
/// <summary>
/// Ensures that the OnListChanged event is raised when an
/// item is changed.
/// </summary>
override protected void OnSetComplete(int index, object oldValue, object newValue)
{
OnListChanged(new ListChangedEventArgs(ListChangedType.ItemChanged, index));
}
#endregion
#region IBindingList interface
// *******************************************************************
// This is most of the IBindingList interface.
// Notice that each of these implementations merely
// calls a virtual method, so subclasses can override those
// methods and provide the actual implementation of the interface
object IBindingList.AddNew() { return OnAddNew(); }
bool IBindingList.AllowEdit { get { return AllowEdit; } }
bool IBindingList.AllowNew { get { return AllowNew; } }
bool IBindingList.AllowRemove { get { return AllowRemove; } }
bool IBindingList.SupportsSearching { get { return AllowFind; } }
bool IBindingList.SupportsSorting { get { return AllowSort; } }
bool IBindingList.SupportsChangeNotification { get { return true; } }
int IBindingList.Find(System.ComponentModel.PropertyDescriptor property, object key)
{
return IBindingList_Find(property, key);
}
void IBindingList.AddIndex(System.ComponentModel.PropertyDescriptor property) {}
void IBindingList.RemoveIndex(System.ComponentModel.PropertyDescriptor property) {}
void IBindingList.ApplySort(System.ComponentModel.PropertyDescriptor property, System.ComponentModel.ListSortDirection direction)
{
IBindingList_ApplySort(property, direction);
}
void IBindingList.RemoveSort()
{
IBindingList_RemoveSort();
}
bool IBindingList.IsSorted { get { return IBindingList_IsSorted; } }
System.ComponentModel.ListSortDirection IBindingList.SortDirection { get { return IBindingList_SortDirection; } }
System.ComponentModel.PropertyDescriptor IBindingList.SortProperty { get { return IBindingList_SortProperty; } }
#endregion
#region OnAddNew
// *******************************************************************
// The following methods allow a subclass to actually provide
// the implementation of adding a new child object
/// <summary>
/// Override this method to allow data binding to automatically
/// add new child objects to a collection.
/// </summary>
/// <returns></returns>
virtual protected object OnAddNew() { return null; }
#endregion
#region Search/Find
// *******************************************************************
// The following methods allow a subclass to actually provide
// the implementation of IBindingList searching
/// <summary>
/// Override this method to implement search/find functionality
/// for the collection.
/// </summary>
/// <param name="property">The property to search.</param>
/// <param name="key">The value to searched for.</param>
/// <returns></returns>
protected virtual int IBindingList_Find(PropertyDescriptor property, object key)
{
return -1;
}
#endregion
#region Sorting
// *******************************************************************
// The following methods allow a subclass to actually provide
// the implementation of IBindingList sorting
/// <summary>
/// Override this method to indicate whether your collection
/// is currently sorted. This returns False by default.
/// </summary>
protected virtual bool IBindingList_IsSorted
{ get{ return false;}}
/// <summary>
/// Override this method to return the property by which
/// the collection is sorted (if you implement sorting).
/// </summary>
protected virtual System.ComponentModel.PropertyDescriptor IBindingList_SortProperty
{ get{ return null;}}
/// <summary>
/// Override this method to return the current sort direction
/// (if you implement sorting).
/// </summary>
protected virtual ListSortDirection IBindingList_SortDirection
{ get{ return ListSortDirection.Ascending;}}
/// <summary>
/// Override this method to provide sorting functionality
/// (if you implement sorting).
/// </summary>
/// <param name="property">The property on which to sort.</param>
/// <param name="direction">The sort direction.</param>
protected virtual void IBindingList_ApplySort(PropertyDescriptor property, ListSortDirection direction) {}
/// <summary>
/// Override this method to remove any existing sort
/// (if you implement sorting).
/// </summary>
protected virtual void IBindingList_RemoveSort() {}
#endregion
}
}

107
source/csla10/Backup/CSLA.Core.Bindablebase/CSLA.Core.Bindablebase.csproj Normal file
View File

@@ -0,0 +1,107 @@
<Project DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectType>Local</ProjectType>
<ProductVersion>8.0.50727</ProductVersion>
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>{C2392355-12A9-4197-A1D3-603C390B1E62}</ProjectGuid>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ApplicationIcon>
</ApplicationIcon>
<AssemblyKeyContainerName>
</AssemblyKeyContainerName>
<AssemblyName>CSLA.Core.Bindablebase</AssemblyName>
<AssemblyOriginatorKeyFile>AyaNova.snk</AssemblyOriginatorKeyFile>
<DefaultClientScript>JScript</DefaultClientScript>
<DefaultHTMLPageLayout>Grid</DefaultHTMLPageLayout>
<DefaultTargetSchema>IE50</DefaultTargetSchema>
<DelaySign>false</DelaySign>
<OutputType>Library</OutputType>
<RootNamespace>CSLA.Core.Bindablebase</RootNamespace>
<RunPostBuildEvent>OnBuildSuccess</RunPostBuildEvent>
<StartupObject>
</StartupObject>
<FileUpgradeFlags>
</FileUpgradeFlags>
<UpgradeBackupLocation>
</UpgradeBackupLocation>
<SignAssembly>true</SignAssembly>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<OutputPath>bin\Debug\</OutputPath>
<AllowUnsafeBlocks>false</AllowUnsafeBlocks>
<BaseAddress>285212672</BaseAddress>
<CheckForOverflowUnderflow>false</CheckForOverflowUnderflow>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>DEBUG;TRACE</DefineConstants>
<DocumentationFile>CSLA.Core.BindableBase.xml</DocumentationFile>
<DebugSymbols>true</DebugSymbols>
<FileAlignment>4096</FileAlignment>
<NoStdLib>false</NoStdLib>
<NoWarn>
</NoWarn>
<Optimize>false</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>4</WarningLevel>
<DebugType>full</DebugType>
<ErrorReport>prompt</ErrorReport>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<OutputPath>bin\Release\</OutputPath>
<AllowUnsafeBlocks>false</AllowUnsafeBlocks>
<BaseAddress>285212672</BaseAddress>
<CheckForOverflowUnderflow>false</CheckForOverflowUnderflow>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>TRACE</DefineConstants>
<DocumentationFile>
</DocumentationFile>
<DebugSymbols>false</DebugSymbols>
<FileAlignment>4096</FileAlignment>
<NoStdLib>false</NoStdLib>
<NoWarn>
</NoWarn>
<Optimize>true</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>4</WarningLevel>
<DebugType>none</DebugType>
<ErrorReport>prompt</ErrorReport>
</PropertyGroup>
<ItemGroup>
<Reference Include="System">
<Name>System</Name>
</Reference>
<Reference Include="System.Data">
<Name>System.Data</Name>
</Reference>
<Reference Include="System.Xml">
<Name>System.XML</Name>
</Reference>
</ItemGroup>
<ItemGroup>
<Compile Include="AssemblyInfo.cs">
<SubType>Code</SubType>
</Compile>
<Compile Include="BindableBase.cs">
<SubType>Code</SubType>
</Compile>
<Compile Include="BindableCollectionBase.cs">
<SubType>Code</SubType>
</Compile>
</ItemGroup>
<ItemGroup>
<None Include="AyaNova.snk" />
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Microsoft.CSharp.targets" />
<PropertyGroup>
<PreBuildEvent>
</PreBuildEvent>
<PostBuildEvent>
</PostBuildEvent>
</PropertyGroup>
</Project>

58
source/csla10/Backup/CSLA.Core.Bindablebase/CSLA.Core.Bindablebase.csproj.user Normal file
View File

@@ -0,0 +1,58 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<LastOpenVersion>7.10.3077</LastOpenVersion>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ReferencePath>
</ReferencePath>
<CopyProjectDestinationFolder>
</CopyProjectDestinationFolder>
<CopyProjectUncPath>
</CopyProjectUncPath>
<CopyProjectOption>0</CopyProjectOption>
<ProjectView>ProjectFiles</ProjectView>
<ProjectTrust>0</ProjectTrust>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
</Project>

36
source/csla10/Backup/CSLA.Server.DataPortal/AssemblyInfo.vb Normal file
View File

@@ -0,0 +1,36 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("CSLA.Server.DataPortal")>
<Assembly: AssemblyDescription("CSLA .NET framework")>
<Assembly: AssemblyCompany("Rockford Lhotka")>
<Assembly: AssemblyProduct("Expert One-on-One VB.NET Business Objects")>
<Assembly: AssemblyCopyright("Copyright 2003 Rockford Lhotka. All rights reserved.")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("1E5537B9-A381-4E20-8869-47FBAC978A2D")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
<Assembly: AssemblyVersion("1.3.0")>
' strong name
<Assembly: AssemblyKeyFile("..\..\..\..\..\keys\AyaNova.snk")>

117
source/csla10/Backup/CSLA.Server.DataPortal/CSLA.Server.DataPortal.vbproj Normal file
View File

@@ -0,0 +1,117 @@
<Project DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectType>Local</ProjectType>
<ProductVersion>8.0.50727</ProductVersion>
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>{80828E2C-E9FB-4E73-A27C-7F9CDB96FCDE}</ProjectGuid>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ApplicationIcon>
</ApplicationIcon>
<AssemblyKeyContainerName>
</AssemblyKeyContainerName>
<AssemblyName>CSLA.Server.DataPortal</AssemblyName>
<AssemblyOriginatorKeyFile>
</AssemblyOriginatorKeyFile>
<AssemblyOriginatorKeyMode>None</AssemblyOriginatorKeyMode>
<DefaultClientScript>JScript</DefaultClientScript>
<DefaultHTMLPageLayout>Grid</DefaultHTMLPageLayout>
<DefaultTargetSchema>IE50</DefaultTargetSchema>
<DelaySign>false</DelaySign>
<OutputType>Library</OutputType>
<OptionCompare>Binary</OptionCompare>
<OptionExplicit>On</OptionExplicit>
<OptionStrict>Off</OptionStrict>
<RootNamespace>CSLA</RootNamespace>
<StartupObject>CSLA.%28None%29</StartupObject>
<FileUpgradeFlags>
</FileUpgradeFlags>
<MyType>Windows</MyType>
<UpgradeBackupLocation>
</UpgradeBackupLocation>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>CSLA.Server.DataPortal.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>true</DebugSymbols>
<Optimize>false</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032</NoWarn>
<DebugType>full</DebugType>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>CSLA.Server.DataPortal.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>false</DebugSymbols>
<Optimize>true</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032</NoWarn>
<DebugType>none</DebugType>
</PropertyGroup>
<ItemGroup>
<Reference Include="System">
<Name>System</Name>
</Reference>
<Reference Include="System.configuration" />
<Reference Include="System.Data">
<Name>System.Data</Name>
</Reference>
<Reference Include="System.Xml">
<Name>System.XML</Name>
</Reference>
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
</ItemGroup>
<ItemGroup>
<Compile Include="AssemblyInfo.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="CriteriaBase.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="DataPortal.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="DataPortalContext.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="ISerializationNotification.vb">
<SubType>Code</SubType>
</Compile>
</ItemGroup>
<ItemGroup>
<Folder Include="My Project\" />
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Microsoft.VisualBasic.targets" />
<PropertyGroup>
<PreBuildEvent>
</PreBuildEvent>
<PostBuildEvent>
</PostBuildEvent>
</PropertyGroup>
</Project>

58
source/csla10/Backup/CSLA.Server.DataPortal/CSLA.Server.DataPortal.vbproj.user Normal file
View File

@@ -0,0 +1,58 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<LastOpenVersion>7.10.3077</LastOpenVersion>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ReferencePath>
</ReferencePath>
<CopyProjectDestinationFolder>
</CopyProjectDestinationFolder>
<CopyProjectUncPath>
</CopyProjectUncPath>
<CopyProjectOption>0</CopyProjectOption>
<ProjectView>ShowAllFiles</ProjectView>
<ProjectTrust>0</ProjectTrust>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
</Project>

21
source/csla10/Backup/CSLA.Server.DataPortal/CriteriaBase.vb Normal file
View File

@@ -0,0 +1,21 @@
''' <summary>
''' Base type from which Criteria classes can be
''' derived in a business class.
''' </summary>
<Serializable()> _
Public MustInherit Class CriteriaBase
''' <summary>
''' Type of the business object to be instantiated by
''' the server-side DataPortal.
''' </summary>
Public ObjectType As Type
''' <summary>
''' Initializes CriteriaBase with the type of
''' business object to be created by the DataPortal.
''' </summary>
Public Sub New(ByVal Type As Type)
ObjectType = Type
End Sub
End Class

225
source/csla10/Backup/CSLA.Server.DataPortal/DataPortal.vb Normal file
View File

@@ -0,0 +1,225 @@
Imports System.Reflection
Imports System.Security.Principal
Imports System.Configuration
''' <summary>
'''
''' </summary>
Namespace Server
''' <summary>
''' Implements the server-side DataPortal as discussed
''' in Chapter 5.
''' </summary>
Public Class DataPortal
Inherits MarshalByRefObject
#Region " Data Access "
''' <summary>
''' Called by the client-side DataPortal to create a new object.
''' </summary>
''' <param name="Criteria">Object-specific criteria.</param>
''' <param name="Principal">The user's principal object (if using CSLA .NET security).</param>
''' <returns>A populated business object.</returns>
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
''' <summary>
''' Called by the client-side DataProtal to retrieve an object.
''' </summary>
''' <param name="Criteria">Object-specific criteria.</param>
''' <param name="Principal">The user's principal object (if using CSLA .NET security).</param>
''' <returns>A populated business object.</returns>
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
Return obj
End Function
''' <summary>
''' Called by the client-side DataPortal to update an object.
''' </summary>
''' <param name="obj">A reference to the object being updated.</param>
''' <param name="Principal">The user's principal object (if using CSLA .NET security).</param>
''' <returns>A reference to the newly updated object.</returns>
Public Function Update(ByVal obj As Object, ByVal context As DataPortalContext) As Object
SetPrincipal(context.Principal)
If context.IsRemotePortal Then
Serialization.SerializationNotification.OnDeserialized(obj)
End If
' tell the business object to update itself
CallMethod(obj, "DataPortal_Update")
If context.IsRemotePortal Then
Serialization.SerializationNotification.OnSerializing(obj)
End If
Return obj
End Function
''' <summary>
''' Called by the client-side DataPortal to delete an object.
''' </summary>
''' <param name="Criteria">Object-specific criteria.</param>
''' <param name="Principal">The user's principal object (if using CSLA .NET security).</param>
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 " Security "
Private Function AUTHENTICATION() As String
Return System.Configuration.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

66
source/csla10/Backup/CSLA.Server.DataPortal/DataPortalContext.vb Normal file
View File

@@ -0,0 +1,66 @@
Imports System.Security.Principal
''' <summary>
'''
''' </summary>
Namespace Server
''' <summary>
''' Provides consistent context information between the client
''' and server DataPortal objects.
''' </summary>
''' <remarks>
''' The context includes the current
''' <see cref="T:CSLA.Security.BusinessPrincipal" />
''' object if CSLA security is being used. It also includes a
''' flag indicating whether the server-side DataPortal is running
''' locally or remotely.
''' </remarks>
<Serializable()> _
Public Class DataPortalContext
Private mPrincipal As IPrincipal
Private mRemotePortal As Boolean
''' <summary>
''' The current <see cref="T:CSLA.Security.BusinessPrincipal" />
''' if CSLA security is being used.
''' </summary>
Public ReadOnly Property Principal() As IPrincipal
Get
Return mPrincipal
End Get
End Property
''' <summary>
''' Returns True if the server-side DataPortal is running
''' on a remote server via remoting.
''' </summary>
Public ReadOnly Property IsRemotePortal() As Boolean
Get
Return mRemotePortal
End Get
End Property
''' <summary>
''' Creates a new DataPortalContext object.
''' </summary>
''' <param name="isRemotePortal">Indicates whether the DataPortal is remote.</param>
Public Sub New(ByVal isRemotePortal As Boolean)
mPrincipal = Nothing
mRemotePortal = isRemotePortal
End Sub
''' <summary>
''' Creates a new DataPortalContext object.
''' </summary>
''' <param name="principal">The current Principal object.</param>
''' <param name="isRemotePortal">Indicates whether the DataPortal is remote.</param>
Public Sub New(ByVal principal As IPrincipal, ByVal isRemotePortal As Boolean)
mPrincipal = principal
mRemotePortal = isRemotePortal
End Sub
End Class
End Namespace

86
source/csla10/Backup/CSLA.Server.DataPortal/ISerializationNotification.vb Normal file
View File

@@ -0,0 +1,86 @@
''' <summary>
''' Contains interfaces and classes to help support serialization
''' of objects.
''' </summary>
Namespace Serialization
''' <summary>
''' Objects can implement this interface if they wish to be
''' notified of serialization events.
''' </summary>
''' <remarks>
''' <para>
''' Note that .NET serialization does NOT call these methods. Only
''' code that checks for the ISerializationNotification interface
''' when serializating and deserializing objects will invoke these
''' methods.
''' </para><para>
''' The CSLA .NET framework's DataPortal processing and the Clone
''' method in BusinessBase automatically make these calls.
''' </para>
''' </remarks>
Public Interface ISerializationNotification
''' <summary>
''' This method is called before an object is serialized.
''' </summary>
Sub Serializing()
''' <summary>
''' This method is called on the original instance of the
''' object after it has been serialized.
''' </summary>
Sub Serialized()
''' <summary>
''' This method is called on a newly deserialized object
''' after deserialization is complete.
''' </summary>
Sub Deserialized()
End Interface
''' <summary>
''' Helper methods for invoking the ISerializatoinNotification
''' methods.
''' </summary>
Public Class SerializationNotification
''' <summary>
''' Invokes the Serializing method on the target object
''' if it has implemented ISerializationNotification.
''' </summary>
''' <param name="target">Object on which the method should be invoked.</param>
Public Shared Sub OnSerializing(ByVal target As Object)
If TypeOf target Is ISerializationNotification Then
DirectCast(target, ISerializationNotification).Serializing()
End If
End Sub
''' <summary>
''' Invokes the Serialized method on the target object
''' if it has implemented ISerializationNotification.
''' </summary>
''' <param name="target">Object on which the method should be invoked.</param>
Public Shared Sub OnSerialized(ByVal target As Object)
If TypeOf target Is ISerializationNotification Then
DirectCast(target, ISerializationNotification).Serialized()
End If
End Sub
''' <summary>
''' Invokes the Deserialized method on the target object
''' if it has implemented ISerializationNotification.
''' </summary>
''' <param name="target">Object on which the method should be invoked.</param>
Public Shared Sub OnDeserialized(ByVal target As Object)
If TypeOf target Is ISerializationNotification Then
DirectCast(target, ISerializationNotification).Deserialized()
End If
End Sub
End Class
End Namespace

43
source/csla10/Backup/CSLA.Server.ServicedDataPortal/AssemblyInfo.vb Normal file
View File

@@ -0,0 +1,43 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.EnterpriseServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("CSLA.Server.ServicedDataPortal")>
<Assembly: AssemblyDescription("CSLA .NET framework")>
<Assembly: AssemblyCompany("Rockford Lhotka")>
<Assembly: AssemblyProduct("Expert One-on-One VB.NET Business Objects")>
<Assembly: AssemblyCopyright("Copyright 2003 Rockford Lhotka. All rights reserved.")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("A0547DE0-0EA3-4B98-AD4C-AD3759C14A96")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
<Assembly: AssemblyVersion("1.3.0")>
' update this to point to your key
' strong name
<Assembly: AssemblyKeyFile("..\..\..\..\..\keys\AyaNova.snk")>
' EnterpriseServices settings
<Assembly: ApplicationActivation(ActivationOption.Library)>
<Assembly: ApplicationName("CSLA DataPortal")>
<Assembly: Description("CSLA .NET data portal")>
<Assembly: ApplicationAccessControl(True)>

111
source/csla10/Backup/CSLA.Server.ServicedDataPortal/CSLA.Server.ServicedDataPortal.vbproj Normal file
View File

@@ -0,0 +1,111 @@
<Project DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectType>Local</ProjectType>
<ProductVersion>8.0.50727</ProductVersion>
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>{AD60DF60-2D14-4403-B5A8-41D4E06AB7AD}</ProjectGuid>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ApplicationIcon>
</ApplicationIcon>
<AssemblyKeyContainerName>
</AssemblyKeyContainerName>
<AssemblyName>CSLA.Server.ServicedDataPortal</AssemblyName>
<AssemblyOriginatorKeyFile>
</AssemblyOriginatorKeyFile>
<AssemblyOriginatorKeyMode>None</AssemblyOriginatorKeyMode>
<DefaultClientScript>JScript</DefaultClientScript>
<DefaultHTMLPageLayout>Grid</DefaultHTMLPageLayout>
<DefaultTargetSchema>IE50</DefaultTargetSchema>
<DelaySign>false</DelaySign>
<OutputType>Library</OutputType>
<OptionCompare>Binary</OptionCompare>
<OptionExplicit>On</OptionExplicit>
<OptionStrict>Off</OptionStrict>
<RootNamespace>CSLA.Server.ServicedDataPortal</RootNamespace>
<StartupObject>
</StartupObject>
<FileUpgradeFlags>
</FileUpgradeFlags>
<MyType>Windows</MyType>
<UpgradeBackupLocation>
</UpgradeBackupLocation>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>CSLA.Server.ServicedDataPortal.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>true</DebugSymbols>
<Optimize>false</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032</NoWarn>
<DebugType>full</DebugType>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>CSLA.Server.ServicedDataPortal.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>false</DebugSymbols>
<Optimize>true</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032</NoWarn>
<DebugType>none</DebugType>
</PropertyGroup>
<ItemGroup>
<Reference Include="System">
<Name>System</Name>
</Reference>
<Reference Include="System.Data">
<Name>System.Data</Name>
</Reference>
<Reference Include="System.EnterpriseServices">
<Name>System.EnterpriseServices</Name>
</Reference>
<Reference Include="System.Xml">
<Name>System.XML</Name>
</Reference>
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
</ItemGroup>
<ItemGroup>
<Compile Include="AssemblyInfo.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="DataPortal.vb">
<SubType>Code</SubType>
</Compile>
</ItemGroup>
<ItemGroup>
<Folder Include="My Project\" />
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Microsoft.VisualBasic.targets" />
<PropertyGroup>
<PreBuildEvent>
</PreBuildEvent>
<PostBuildEvent>
</PostBuildEvent>
</PropertyGroup>
</Project>

58
source/csla10/Backup/CSLA.Server.ServicedDataPortal/CSLA.Server.ServicedDataPortal.vbproj.user Normal file
View File

@@ -0,0 +1,58 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<LastOpenVersion>7.10.3077</LastOpenVersion>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ReferencePath>
</ReferencePath>
<CopyProjectDestinationFolder>
</CopyProjectDestinationFolder>
<CopyProjectUncPath>
</CopyProjectUncPath>
<CopyProjectOption>0</CopyProjectOption>
<ProjectView>ShowAllFiles</ProjectView>
<ProjectTrust>0</ProjectTrust>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
</Project>

51
source/csla10/Backup/CSLA.Server.ServicedDataPortal/DataPortal.vb Normal file
View File

@@ -0,0 +1,51 @@
Imports System.EnterpriseServices
''' <summary>
''' Implements the transactional server-side DataPortal object as
''' discussed in Chapter 5.
''' </summary>
<Transaction(TransactionOption.Required), EventTrackingEnabled(True)> _
Public Class DataPortal
Inherits ServicedComponent
''' <summary>
''' Invokes the server-side DataPortal Create method within
''' a COM+ transaction.
''' </summary>
<AutoComplete(True)> _
Public Function Create(ByVal Criteria As Object, ByVal Principal As Object) As Object
Dim portal As New CSLA.Server.DataPortal()
Return portal.Create(Criteria, Principal)
End Function
''' <summary>
''' Invokes the server-side DataPortal Fetch method within
''' a COM+ transaction.
''' </summary>
<AutoComplete(True)> _
Public Function Fetch(ByVal Criteria As Object, ByVal Principal As Object) As Object
Dim portal As New CSLA.Server.DataPortal()
Return portal.Fetch(Criteria, Principal)
End Function
''' <summary>
''' Invokes the server-side DataPortal Update method within
''' a COM+ transaction.
''' </summary>
<AutoComplete(True)> _
Public Function Update(ByVal obj As Object, ByVal Principal As Object) As Object
Dim portal As New CSLA.Server.DataPortal()
Return portal.Update(obj, Principal)
End Function
''' <summary>
''' Invokes the server-side DataPortal Delete method within
''' a COM+ transaction.
''' </summary>
<AutoComplete(True)> _
Public Sub Delete(ByVal Criteria As Object, ByVal Principal As Object)
Dim portal As New CSLA.Server.DataPortal()
portal.Delete(Criteria, Principal)
End Sub
End Class

34
source/csla10/Backup/CSLA/AssemblyInfo.vb Normal file
View File

@@ -0,0 +1,34 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("CSLA .NET")>
<Assembly: AssemblyDescription("CSLA .NET framework")>
<Assembly: AssemblyCompany("Rockford Lhotka")>
<Assembly: AssemblyProduct("Expert One-on-One VB.NET Business Objects")>
<Assembly: AssemblyCopyright("Copyright 2003 Rockford Lhotka. All rights reserved.")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("C3F68BA4-2214-40F5-AB36-AC39903057B9")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
<Assembly: AssemblyVersion("1.3.0")>
<Assembly: AssemblyKeyFile("..\..\..\..\..\keys\AyaNova.snk")>

899
source/csla10/Backup/CSLA/BrokenRules.vb Normal file
View File

@@ -0,0 +1,899 @@
Imports System.Collections.Specialized
''' <summary>
''' Tracks the business rules broken within a business object.
''' </summary>
<Serializable()> _
Public Class BrokenRules
#Region " Rule structure "
''' <summary>
''' Stores details about a specific broken business rule.
''' </summary>
<Serializable()> _
Public Structure Rule
Private mRule As String
Private mDescription As String
Private mProperty As String
Friend Sub New(ByVal Rule As String, ByVal Description As String)
mRule = Rule
mDescription = Description
End Sub
Friend Sub New(ByVal Rule As String, ByVal Description As String, ByVal [Property] As String)
mRule = Rule
mDescription = Description
mProperty = [Property]
End Sub
''' <summary>
''' Provides access to the name of the broken rule.
''' </summary>
''' <remarks>
''' This value is actually readonly, not readwrite. Any new
''' value set into this property is ignored. The property is only
''' readwrite because that is required to support data binding
''' within Web Forms.
''' </remarks>
''' <value>The name of the rule.</value>
Public Property Rule() As String
Get
Return mRule
End Get
Set(ByVal Value As String)
' the property must be read-write for Web Forms data binding
' to work, but we really don't want to allow the value to be
' changed dynamically so we ignore any attempt to set it
End Set
End Property
''' <summary>
''' Provides access to the description of the broken rule.
''' </summary>
''' <remarks>
''' This value is actually readonly, not readwrite. Any new
''' value set into this property is ignored. The property is only
''' readwrite because that is required to support data binding
''' within Web Forms.
''' </remarks>
''' <value>The description of the rule.</value>
Public Property Description() As String
Get
Return mDescription
End Get
Set(ByVal Value As String)
' the property must be read-write for Web Forms data binding
' to work, but we really don't want to allow the value to be
' changed dynamically so we ignore any attempt to set it
End Set
End Property
''' <summary>
''' Provides access to the property affected by the broken rule.
''' </summary>
''' <remarks>
''' This value is actually readonly, not readwrite. Any new
''' value set into this property is ignored. The property is only
''' readwrite because that is required to support data binding
''' within Web Forms.
''' </remarks>
''' <value>The property affected by the rule.</value>
Public Property [Property]() As String
Get
Return mProperty
End Get
Set(ByVal Value As String)
' the property must be read-write for Web Forms data binding
' to work, but we really don't want to allow the value to be
' changed dynamically so we ignore any attempt to set it
End Set
End Property
End Structure
#End Region
#Region " RulesCollection "
''' <summary>
''' A collection of currently broken rules.
''' </summary>
''' <remarks>
''' This collection is readonly and can be safely made available
''' to code outside the business object such as the UI. This allows
''' external code, such as a UI, to display the list of broken rules
''' to the user.
''' </remarks>
<Serializable()> _
Public Class RulesCollection
Inherits CSLA.Core.BindableCollectionBase
Private mLegal As Boolean = False
''' <summary>
''' Returns a <see cref="T:CSLA.BrokenRules.Rule" /> object
''' containing details about a specific broken business rule.
''' </summary>
''' <param name="Index"></param>
''' <returns></returns>
Default Public ReadOnly Property Item(ByVal Index As Integer) As Rule
Get
Return CType(list.Item(Index), Rule)
End Get
End Property
''' <summary>
''' Returns the first <see cref="T:CSLA.BrokenRules.Rule" /> object
''' corresponding to the specified property.
''' </summary>
''' <remarks>
''' <para>
''' When a rule is marked as broken, the business developer can provide
''' an optional Property parameter. This parameter is the name of the
''' Property on the object that is most affected by the rule. Data binding
''' may later use the IDataErrorInfo interface to query the object for
''' details about errors corresponding to specific properties, and this
''' value will be returned as a result of that query.
''' </para><para>
''' Code in a business object or UI can also use this value to retrieve
''' the first broken rule in <see cref="T:CSLA.BrokenRules" /> that corresponds
''' to a specfic Property on the object.
''' </para>
''' </remarks>
''' <param name="Property">The name of the property affected by the rule.</param>
Public ReadOnly Property RuleForProperty(ByVal [Property] As String) As Rule
Get
Dim item As Rule
For Each item In list
If item.Property = [Property] Then
Return item
End If
Next
Return New Rule()
End Get
End Property
Friend Sub New()
AllowEdit = False
AllowRemove = False
AllowNew = False
End Sub
Friend Sub Add(ByVal Rule As String, ByVal Description As String)
Remove(Rule)
mLegal = True
list.Add(New Rule(Rule, Description))
mLegal = False
End Sub
Friend Sub Add(ByVal Rule As String, ByVal Description As String, ByVal [Property] As String)
Remove(Rule)
mLegal = True
list.Add(New Rule(Rule, Description, [Property]))
mLegal = False
End Sub
Friend Sub Remove(ByVal Rule As String)
Dim index As Integer
' we loop through using a numeric counter because
' the base class Remove requires a numberic index
mLegal = True
For index = 0 To list.Count - 1
If CType(list.Item(index), Rule).Rule = Rule Then
list.Remove(list.Item(index))
Exit For
End If
Next
mLegal = False
End Sub
Friend Function Contains(ByVal Rule As String) As Boolean
Dim index As Integer
For index = 0 To list.Count - 1
If CType(list.Item(index), Rule).Rule = Rule Then
Return True
End If
Next
Return False
End Function
''' <summary>
''' Prevents clearing the collection.
''' </summary>
Protected Overrides Sub OnClear()
If Not mLegal Then
Throw New NotSupportedException("Clear is an invalid operation")
End If
End Sub
''' <summary>
''' Prevents insertion of items into the collection.
''' </summary>
Protected Overrides Sub OnInsert(ByVal index As Integer, ByVal value As Object)
If Not mLegal Then
Throw New NotSupportedException("Insert is an invalid operation")
End If
End Sub
''' <summary>
''' Prevents removal of items from the collection.
''' </summary>
Protected Overrides Sub OnRemove(ByVal index As Integer, ByVal value As Object)
If Not mLegal Then
Throw New NotSupportedException("Remove is an invalid operation")
End If
End Sub
''' <summary>
''' Prevents changing items in the collection.
''' </summary>
Protected Overrides Sub OnSet(ByVal index As Integer, _
ByVal oldValue As Object, ByVal newValue As Object)
If Not mLegal Then
Throw New NotSupportedException("Changing an element is an invalid operation")
End If
End Sub
End Class
#End Region
Private mBrokenRules As New RulesCollection()
<NonSerialized(), NotUndoable()> _
Private mTarget As Object
#Region " Rule Manager "
''' <summary>
''' Sets the target object so the Rules Manager functionality
''' has a reference to the object containing the data to
''' be validated.
''' </summary>
''' <remarks>
''' The object here is typically your business object. In your
''' business class you'll implement a method to set up your
''' business rules. As you do so, you need to call this method
''' to give BrokenRules a reference to your business object
''' so it has access to your object's data.
''' </remarks>
''' <param name="target">A reference to the object containing
''' the data to be validated.</param>
Public Sub SetTargetObject(ByVal target As Object)
mTarget = target
End Sub
#Region " RuleHandler delegate "
''' <summary>
''' Delegate that defines the method signature for all rule handler methods.
''' </summary>
''' <remarks>
''' <para>
''' When implementing a rule handler, you must conform to the method signature
''' defined by this delegate. You should also apply the Description attribute
''' to your method to provide a meaningful description for your rule.
''' </para><para>
''' The method implementing the rule must return True if the data is valid and
''' return False if the data is invalid.
''' </para>
''' </remarks>
Public Delegate Function RuleHandler(ByVal target As Object, ByVal e As RuleArgs) As Boolean
#End Region
#Region " RuleArgs class "
''' <summary>
''' Object providing extra information to methods that
''' implement business rules.
''' </summary>
Public Class RuleArgs
Private mPropertyName As String
Private mDescription As String
''' <summary>
''' The (optional) name of the property to be validated.
''' </summary>
Public ReadOnly Property PropertyName() As String
Get
Return mPropertyName
End Get
End Property
''' <summary>
''' Set by the rule handler method to describe the broken
''' rule.
''' </summary>
''' <remarks>
''' <para>
''' If the rule handler sets this property, this value will override
''' any description attribute value associated with the rule handler
''' method.
''' </para><para>
''' The description string returned via this property
''' is provided to the UI or other consumer
''' about which rules are broken. These descriptions are intended
''' for end-user display.
''' </para><para>
''' The description value is a .NET format string, and it can include
''' the following tokens in addition to literal text:
''' </para><para>
''' {0} - the RuleName value
''' </para><para>
''' {1} - the PropertyName value
''' </para><para>
''' {2} - the full type name of the target object
''' </para><para>
''' {3} - the ToString value of the target object
''' </para><para>
''' You can use these tokens in your description string and the
''' appropriate values will be substituted for the tokens at
''' runtime.
''' </para>
''' </remarks>
Public Property Description() As String
Get
Return mDescription
End Get
Set(ByVal Value As String)
mDescription = Value
End Set
End Property
''' <summary>
''' Creates an instance of RuleArgs.
''' </summary>
Public Sub New()
End Sub
''' <summary>
''' Creates an instance of RuleArgs.
''' </summary>
''' <param name="propertyName">The name of the property to be validated.</param>
Public Sub New(ByVal propertyName As String)
mPropertyName = propertyName
End Sub
#Region " Empty "
Private Shared mEmptyArgs As New RuleArgs()
''' <summary>
''' Returns an empty RuleArgs object.
''' </summary>
Public Shared ReadOnly Property Empty() As RuleArgs
Get
Return mEmptyArgs
End Get
End Property
#End Region
End Class
#End Region
#Region " Description attribute "
''' <summary>
''' Defines the description of a business rule.
''' </summary>
''' <remarks>
''' <para>
''' The description in this attribute is used by BusinessRules
''' as information that is provided to the UI or other consumer
''' about which rules are broken. These descriptions are intended
''' for end-user display.
''' </para><para>
''' The description value is a .NET format string, and it can include
''' the following tokens in addition to literal text:
''' </para><para>
''' {0} - the RuleName value
''' </para><para>
''' {1} - the PropertyName value
''' </para><para>
''' {2} - the full type name of the target object
''' </para><para>
''' {3} - the ToString value of the target object
''' </para><para>
''' You can use these tokens in your description string and the
''' appropriate values will be substituted for the tokens at
''' runtime.
''' </para><para>
''' Instead of using this attribute, a rule handler method can
''' set the Description property of the RuleArgs parameter to
''' a description string. That approach can provide a more dynamic
''' way to generate descriptions of broken rules.
''' </para>
''' </remarks>
<AttributeUsage(AttributeTargets.Method)> _
Public Class DescriptionAttribute
Inherits Attribute
Private mText As String = ""
''' <summary>
''' Initializes the attribute with a description.
''' </summary>
Public Sub New(ByVal description As String)
mText = description
End Sub
''' <summary>
''' Returns the description value of the attribute.
''' </summary>
Public Overrides Function ToString() As String
Return mText
End Function
End Class
#End Region
#Region " RuleMethod Class "
''' <summary>
''' Tracks all information for a rule.
''' </summary>
Private Class RuleMethod
Private mHandler As RuleHandler
Private mTarget As Object
Private mRuleName As String
Private mArgs As RuleArgs
Private mDescription As String
''' <summary>
''' Returns the name of the method implementing the rule
''' and the property, field or column name to which the
''' rule applies.
''' </summary>
Public Overrides Function ToString() As String
If RuleArgs.PropertyName Is Nothing Then
Return mHandler.Method.Name
Else
Return mHandler.Method.Name & "!" & RuleArgs.PropertyName
End If
End Function
''' <summary>
''' Returns the delegate to the method implementing the rule.
''' </summary>
Public ReadOnly Property Handler() As RuleHandler
Get
Return mHandler
End Get
End Property
''' <summary>
''' Returns the user-friendly name of the rule.
''' </summary>
Public ReadOnly Property RuleName() As String
Get
Return mRuleName
End Get
End Property
''' <summary>
''' Returns the name of the field, property or column
''' to which the rule applies.
''' </summary>
Public ReadOnly Property RuleArgs() As RuleArgs
Get
Return mArgs
End Get
End Property
''' <summary>
''' Returns the formatted description of the rule.
''' </summary>
Public ReadOnly Property Description() As String
Get
If Len(mArgs.Description) > 0 Then
Return String.Format(mArgs.Description, RuleName, RuleArgs.PropertyName, TypeName(mTarget), mTarget.ToString)
Else
Return String.Format(mDescription, RuleName, RuleArgs.PropertyName, TypeName(mTarget), mTarget.ToString)
End If
End Get
End Property
''' <summary>
''' Retrieves the description text from the Description
''' attribute on a RuleHandler method.
''' </summary>
Private Function GetDescription(ByVal handler As RuleHandler) As String
Dim attrib() As Object = handler.Method.GetCustomAttributes(GetType(DescriptionAttribute), False)
If attrib.Length > 0 Then
Return attrib(0).ToString
Else
Return "{2}.{0}:<no description>"
End If
End Function
''' <summary>
''' Creates and initializes the rule.
''' </summary>
''' <param name="target">Reference to the object containing the data to validate.</param>
''' <param name="handler">The address of the method implementing the rule.</param>
''' <param name="ruleName">The user-friendly name of the rule.</param>
''' <param name="ruleArgs">A RuleArgs object containing data related to the rule.</param>
Public Sub New(ByVal target As Object, ByVal handler As RuleHandler, ByVal ruleName As String, ByVal ruleArgs As RuleArgs)
mTarget = target
mHandler = handler
mDescription = GetDescription(handler)
mRuleName = ruleName
mArgs = ruleArgs
End Sub
''' <summary>
''' Creates and initializes the rule.
''' </summary>
''' <param name="target">Reference to the object containing the data to validate.</param>
''' <param name="handler">The address of the method implementing the rule.</param>
''' <param name="ruleName">The user-friendly name of the rule.</param>
''' <param name="propertyName">The field, property or column to which the rule applies.</param>
Public Sub New(ByVal target As Object, ByVal handler As RuleHandler, ByVal ruleName As String, ByVal propertyName As String)
mTarget = target
mHandler = handler
mDescription = GetDescription(handler)
mRuleName = ruleName
mArgs = New RuleArgs(propertyName)
End Sub
''' <summary>
''' Invokes the rule to validate the data.
''' </summary>
''' <returns>True if the data is valid, False if the data is invalid.</returns>
Public Function Invoke() As Boolean
Return mHandler.Invoke(mTarget, mArgs)
End Function
End Class
#End Region
#Region " RulesList property "
<NonSerialized(), NotUndoable()> _
Private mRulesList As HybridDictionary
Private ReadOnly Property RulesList() As HybridDictionary
Get
If mRulesList Is Nothing Then
mRulesList = New HybridDictionary()
End If
Return mRulesList
End Get
End Property
#End Region
#Region " Adding Rules "
''' <summary>
''' Returns the ArrayList containing rules for a rule name. If
''' no ArrayList exists one is created and returned.
''' </summary>
Private Function GetRulesForName(ByVal ruleName As String) As ArrayList
' get the ArrayList (if any) from the Hashtable
Dim list As ArrayList = CType(RulesList.Item(ruleName), ArrayList)
If list Is Nothing Then
' there is no list for this name - create one
list = New ArrayList()
RulesList.Add(ruleName, list)
End If
Return list
End Function
''' <summary>
''' Adds a rule to the list of rules to be enforced.
''' </summary>
''' <remarks>
''' <para>
''' A rule is implemented by a method which conforms to the
''' method signature defined by the RuleHandler delegate.
''' </para><para>
''' The ruleName is used to group all the rules that apply
''' to a specific field, property or concept. All rules applying
''' to the field or property should have the same rule name. When
''' rules are checked, they can be checked globally or for a
''' specific ruleName.
''' </para><para>
''' The propertyName may be used by the method that implements the rule
''' in order to retrieve the value to be validated. If the rule
''' implementation is inside the target object then it probably has
''' direct access to all data. However, if the rule implementation
''' is outside the target object then it will need to use reflection
''' or CallByName to dynamically invoke this property to retrieve
''' the value to be validated.
''' </para>
''' </remarks>
''' <param name="handler">The method that implements the rule.</param>
''' <param name="ruleName">
''' A user-friendly identifier for the field/property
''' to which the rule applies.
''' </param>
Public Sub AddRule(ByVal handler As RuleHandler, ByVal ruleName As String)
' get the ArrayList (if any) from the Hashtable
Dim list As ArrayList = GetRulesForName(ruleName)
' we have the list, add our new rule
list.Add(New RuleMethod(mTarget, handler, ruleName, RuleArgs.Empty))
End Sub
''' <summary>
''' Adds a rule to the list of rules to be enforced.
''' </summary>
''' <remarks>
''' <para>
''' A rule is implemented by a method which conforms to the
''' method signature defined by the RuleHandler delegate.
''' </para><para>
''' The ruleName is used to group all the rules that apply
''' to a specific field, property or concept. All rules applying
''' to the field or property should have the same rule name. When
''' rules are checked, they can be checked globally or for a
''' specific ruleName.
''' </para>
''' </remarks>
''' <param name="handler">The method that implements the rule.</param>
''' <param name="ruleName">
''' A user-friendly identifier for the field/property
''' to which the rule applies.
''' </param>
''' <param name="ruleArgs">A RuleArgs object containing data
''' to be passed to the method implementing the rule.</param>
Public Sub AddRule(ByVal handler As RuleHandler, ByVal ruleName As String, ByVal ruleArgs As RuleArgs)
' get the ArrayList (if any) from the Hashtable
Dim list As ArrayList = GetRulesForName(ruleName)
' we have the list, add our new rule
list.Add(New RuleMethod(mTarget, handler, ruleName, ruleArgs))
End Sub
''' <summary>
''' Adds a rule to the list of rules to be enforced.
''' </summary>
''' <remarks>
''' <para>
''' A rule is implemented by a method which conforms to the
''' method signature defined by the RuleHandler delegate.
''' </para><para>
''' The ruleName is used to group all the rules that apply
''' to a specific field, property or concept. All rules applying
''' to the field or property should have the same rule name. When
''' rules are checked, they can be checked globally or for a
''' specific ruleName.
''' </para><para>
''' The propertyName may be used by the method that implements the rule
''' in order to retrieve the value to be validated. If the rule
''' implementation is inside the target object then it probably has
''' direct access to all data. However, if the rule implementation
''' is outside the target object then it will need to use reflection
''' or CallByName to dynamically invoke this property to retrieve
''' the value to be validated.
''' </para>
''' </remarks>
''' <param name="handler">The method that implements the rule.</param>
''' <param name="ruleName">
''' A user-friendly identifier for the field/property
''' to which the rule applies.
''' </param>
''' <param name="propertyName">
''' The property name on the target object where the rule implementation can retrieve
''' the value to be validated.
''' </param>
Public Sub AddRule(ByVal handler As RuleHandler, ByVal ruleName As String, ByVal propertyName As String)
' get the ArrayList (if any) from the Hashtable
Dim list As ArrayList = GetRulesForName(ruleName)
' we have the list, add our new rule
list.Add(New RuleMethod(mTarget, handler, ruleName, propertyName))
End Sub
#End Region
#Region " Checking Rules "
''' <summary>
''' Checks all the rules for a specific ruleName.
''' </summary>
''' <param name="ruleName">The ruleName to be validated.</param>
Public Sub CheckRules(ByVal ruleName As String)
Dim list As ArrayList
' get the list of rules to check
list = CType(RulesList.Item(ruleName), ArrayList)
If list Is Nothing Then Exit Sub
' now check the rules
Dim rule As RuleMethod
For Each rule In list
If rule.Invoke() Then
UnBreakRule(rule)
Else
BreakRule(rule)
End If
Next
End Sub
''' <summary>
''' Checks all the rules for a target object.
''' </summary>
Public Sub CheckRules()
' get the rules for each rule name
Dim de As DictionaryEntry
For Each de In RulesList
Dim list As ArrayList
list = CType(de.Value, ArrayList)
' now check the rules
Dim rule As RuleMethod
For Each rule In list
If rule.Invoke() Then
UnBreakRule(rule)
Else
BreakRule(rule)
End If
Next
Next
End Sub
Private Sub UnBreakRule(ByVal rule As RuleMethod)
If rule.RuleArgs.PropertyName Is Nothing Then
Assert(rule.ToString, "", False)
Else
Assert(rule.ToString, "", rule.RuleArgs.PropertyName, False)
End If
End Sub
Private Sub BreakRule(ByVal rule As RuleMethod)
If rule.RuleArgs.PropertyName Is Nothing Then
Assert(rule.ToString, rule.Description, True)
Else
Assert(rule.ToString, rule.Description, rule.RuleArgs.PropertyName, True)
End If
End Sub
#End Region
#End Region ' Rule Manager
#Region " Assert methods "
''' <summary>
''' This method is called by business logic within a business class to
''' indicate whether a business rule is broken.
''' </summary>
''' <remarks>
''' Rules are identified by their names. The description field is merely a
''' comment that is used for display to the end user. When a rule is marked as
''' broken, it is recorded under the rule name value. To mark the rule as not
''' broken, the same rule name must be used.
''' </remarks>
''' <param name="Rule">The name of the business rule.</param>
''' <param name="Description">The description of the business rule.</param>
''' <param name="IsBroken">True if the value is broken, False if it is not broken.</param>
Public Sub Assert(ByVal Rule As String, ByVal Description As String, ByVal IsBroken As Boolean)
If IsBroken Then
mBrokenRules.Add(Rule, Description)
Else
mBrokenRules.Remove(Rule)
End If
End Sub
''' <summary>
''' This method is called by business logic within a business class to
''' indicate whether a business rule is broken.
''' </summary>
''' <remarks>
''' Rules are identified by their names. The description field is merely a
''' comment that is used for display to the end user. When a rule is marked as
''' broken, it is recorded under the rule name value. To mark the rule as not
''' broken, the same rule name must be used.
''' </remarks>
''' <param name="Rule">The name of the business rule.</param>
''' <param name="Description">The description of the business rule.</param>
''' <param name="Property">The property affected by the business rule.</param>
''' <param name="IsBroken">True if the value is broken, False if it is not broken.</param>
Public Sub Assert(ByVal Rule As String, ByVal Description As String, ByVal [Property] As String, ByVal IsBroken As Boolean)
If IsBroken Then
mBrokenRules.Add(Rule, Description, [Property])
Else
mBrokenRules.Remove(Rule)
End If
End Sub
#End Region
#Region " Status retrieval "
''' <summary>
''' Returns a value indicating whether there are any broken rules
''' at this time. If there are broken rules, the business object
''' is assumed to be invalid and False is returned. If there are no
''' broken business rules True is returned.
''' </summary>
''' <returns>A value indicating whether any rules are broken.</returns>
Public ReadOnly Property IsValid() As Boolean
Get
Return mBrokenRules.Count = 0
End Get
End Property
''' <summary>
''' Returns a value indicating whether a particular business rule
''' is currently broken.
''' </summary>
''' <param name="Rule">The name of the rule to check.</param>
''' <returns>A value indicating whether the rule is currently broken.</returns>
Public Function IsBroken(ByVal Rule As String) As Boolean
Return mBrokenRules.Contains(Rule)
End Function
''' <summary>
''' Returns a reference to the readonly collection of broken
''' business rules.
''' </summary>
''' <remarks>
''' The reference returned points to the actual collection object.
''' This means that as rules are marked broken or unbroken over time,
''' the underlying data will change. Because of this, the UI developer
''' can bind a display directly to this collection to get a dynamic
''' display of the broken rules at all times.
''' </remarks>
''' <returns>A reference to the collection of broken rules.</returns>
Public Function GetBrokenRules() As RulesCollection
Return mBrokenRules
End Function
''' <summary>
''' Returns the text of all broken rule descriptions, each
''' separated by cr/lf.
''' </summary>
''' <returns>The text of all broken rule descriptions.</returns>
Public Overrides Function ToString() As String
Dim obj As New System.Text.StringBuilder
Dim item As Rule
Dim first As Boolean = True
For Each item In mBrokenRules
If first Then
first = False
Else
obj.Append("|") 'Modified by John to be pipe delimited for separation and localization in UI level
End If
obj.Append(item.Description)
Next
Return obj.ToString
End Function
#End Region
End Class

837
source/csla10/Backup/CSLA/BusinessBase.vb Normal file
View File

@@ -0,0 +1,837 @@
Imports System.IO
Imports System.Reflection
Imports System.Runtime.Serialization.Formatters.Binary
Imports System.ComponentModel
Imports System.Configuration
''AyaNova Imports
Imports System.Threading
Imports CSLA.Security
''' <summary>
''' This is the base class from which most business objects
''' will be derived.
''' </summary>
''' <remarks>
''' <para>
''' This class is the core of the CSLA .NET framework. To create
''' a business object, inherit from this class.
''' </para><para>
''' Please refer to 'Expert One-on-One VB.NET Business Objects' for
''' full details on the use of this base class to create business
''' objects.
''' </para>
''' </remarks>
<Serializable()> _
Public MustInherit Class BusinessBase
Inherits Core.UndoableBase
Implements IEditableObject
Implements ICloneable
Implements IDataErrorInfo
Implements Serialization.ISerializationNotification
#Region "AyaNova related convenience items"
''Get the user object so
''we can check rights / get ID value
<Browsable(False)> _
Public ReadOnly Property CurrentUserID() As Guid
Get
Dim CurrentUser As Security.BusinessPrincipal = CType(Thread.CurrentPrincipal, BusinessPrincipal)
Return CurrentUser.ID
End Get
End Property
''Confirm if notification is on or off from current principle object
<Browsable(False)> _
Public ReadOnly Property Notify() As Boolean
Get
Dim CurrentUser As Security.BusinessPrincipal = CType(Thread.CurrentPrincipal, BusinessPrincipal)
Return CurrentUser.UseNotification
End Get
End Property
'' Get security access right level from current identity
Public Function GetRight(ByVal RightName As String) As Int32
Return CType(Thread.CurrentPrincipal, BusinessPrincipal).Right(RightName)
End Function
''Added to give UI ability to know if object is in an
''edit level greater than zero
<Browsable(False)> _
Public ReadOnly Property IsEditing() As Boolean
Get
Return (EditLevel > 0)
End Get
End Property
#End Region
#Region " IsNew, IsDeleted, IsDirty "
' keep track of whether we are new, deleted or dirty
Private mIsNew As Boolean = True
Private mIsDeleted As Boolean = False
Private mIsDirty As Boolean = True
''' <summary>
''' Returns True if this is a new object, False if it is a pre-existing object.
''' </summary>
''' <remarks>
''' An object is considered to be new if its data doesn't correspond to
''' data in the database. In other words, if the data values in this particular
''' object have not yet been saved to the database the object is considered to
''' be new. Likewise, if the object's data has been deleted from the database
''' then the object is considered to be new.
''' </remarks>
''' <returns>A value indicating if this object is new.</returns>
<Browsable(False)> _
Public ReadOnly Property IsNew() As Boolean
Get
Return mIsNew
End Get
End Property
''' <summary>
''' Returns True if this object is marked for deletion.
''' </summary>
''' <remarks>
''' CSLA .NET supports both immediate and deferred deletion of objects. This
''' property is part of the support for deferred deletion, where an object
''' can be marked for deletion, but isn't actually deleted until the object
''' is saved to the database. This property indicates whether or not the
''' current object has been marked for deletion. If it is True, the object will
''' be deleted when it is saved to the database, otherwise it will be inserted
''' or updated by the save operation.
''' </remarks>
''' <returns>A value indicating if this object is marked for deletion.</returns>
<Browsable(False)> _
Public ReadOnly Property IsDeleted() As Boolean
Get
Return mIsDeleted
End Get
End Property
''' <summary>
''' Returns True if this object's data has been changed.
''' </summary>
''' <remarks>
''' <para>
''' When an object's data is changed, CSLA .NET makes note of that change
''' and considers the object to be 'dirty' or changed. This value is used to
''' optimize data updates, since an unchanged object does not need to be
''' updated into the database. All new objects are considered dirty. All objects
''' marked for deletion are considered dirty.
''' </para><para>
''' Once an object's data has been saved to the database (inserted or updated)
''' the dirty flag is cleared and the object is considered unchanged. Objects
''' newly loaded from the database are also considered unchanged.
''' </para>
''' </remarks>
''' <returns>A value indicating if this object's data has been changed.</returns>
<Browsable(False)> _
Public Overridable ReadOnly Property IsDirty() As Boolean
Get
Return mIsDirty
End Get
End Property
''' <summary>
''' Marks the object as being a new object. This also marks the object
''' as being dirty and ensures that it is not marked for deletion.
''' </summary>
''' <remarks>
''' Newly created objects are marked new by default. You should call
''' this method in the implementation of DataPortal_Update when the
''' object is deleted (due to being marked for deletion) to indicate
''' that the object no longer reflects data in the database.
''' </remarks>
Protected Sub MarkNew()
mIsNew = True
mIsDeleted = False
MarkDirty()
End Sub
''' <summary>
''' Marks the object as being an old (not new) object. This also
''' marks the object as being unchanged (not dirty).
''' </summary>
''' <remarks>
''' <para>
''' You should call this method in the implementation of
''' DataPortal_Fetch to indicate that an existing object has been
''' successfully retrieved from the database.
''' </para><para>
''' You should call this method in the implementation of
''' DataPortal_Update to indicate that a new object has been successfully
''' inserted into the database.
''' </para>
''' </remarks>
Protected Sub MarkOld()
mIsNew = False
MarkClean()
End Sub
''' <summary>
''' Marks an object for deletion. This also marks the object
''' as being dirty.
''' </summary>
''' <remarks>
''' You should call this method in your business logic in the
''' case that you want to have the object deleted when it is
''' saved to the database.
''' </remarks>
Protected Sub MarkDeleted()
mIsDeleted = True
MarkDirty()
End Sub
''' <summary>
''' Marks an object as being dirty, or changed.
''' </summary>
''' <remarks>
''' <para>
''' You should call this method in your business logic any time
''' the object's internal data changes. Any time any instance
''' variable changes within the object, this method should be called
''' to tell CSLA .NET that the object's data has been changed.
''' </para><para>
''' Marking an object as dirty does two things. First it ensures
''' that CSLA .NET will properly save the object as appropriate. Second,
''' it causes CSLA .NET to tell Windows Forms data binding that the
''' object's data has changed so any bound controls will update to
''' reflect the new values.
''' </para>
''' </remarks>
Protected Sub MarkDirty()
mIsDirty = True
OnIsDirtyChanged()
End Sub
Private Sub MarkClean()
mIsDirty = False
OnIsDirtyChanged()
End Sub
#End Region
#Region " IsSavable "
''' <summary>
''' Returns True if this object is both dirty and valid.
''' </summary>
''' <remarks>
''' An object is considered dirty (changed) if
''' <see cref="P:CSLA.BusinessBase.IsDirty" /> returns True. It is
''' considered valid if <see cref="P:CSLA.BusinessBase.IsValid" />
''' returns True. The IsSavable property is
''' a combination of these two properties. It is provided specifically to
''' enable easy binding to a Save or OK button on a form so that button
''' can automatically enable/disable as the object's state changes between
''' being savable and not savable.
''' </remarks>
''' <returns>A value indicating if this object is new.</returns>
<Browsable(False)> _
Public Overridable ReadOnly Property IsSavable() As Boolean
Get
Return IsDirty AndAlso IsValid
End Get
End Property
#End Region
#Region " IEditableObject "
<NotUndoable()> _
Private mParent As BusinessCollectionBase
<NotUndoable()> _
Private mBindingEdit As Boolean = False
Private mNeverCommitted As Boolean = True
''' <summary>
''' Used by <see cref="T:CSLA.BusinessCollectionBase" /> as a
''' child object is created to tell the child object about its
''' parent.
''' </summary>
''' <param name="parent">A reference to the parent collection object.</param>
Friend Sub SetParent(ByVal parent As BusinessCollectionBase)
If Not IsChild Then
Throw New Exception("Parent value can only be set for child objects")
End If
mParent = parent
End Sub
''' <summary>
''' Allow data binding to start a nested edit on the object.
''' </summary>
''' <remarks>
''' Data binding may call this method many times. Only the first
''' call should be honored, so we have extra code to detect this
''' and do nothing for subsquent calls.
''' </remarks>
Private Sub IEditableObject_BeginEdit() Implements IEditableObject.BeginEdit
Debug.WriteLine("beginedit " & Me.ToString)
If Not mBindingEdit Then
BeginEdit()
End If
End Sub
''' <summary>
''' Allow data binding to cancel the current edit.
''' </summary>
''' <remarks>
''' Data binding may call this method many times. Only the first
''' call to either IEditableObject.CancelEdit or
''' <see cref="M:CSLA.BusinessBase.IEditableObject_EndEdit">IEditableObject.EndEdit</see>
''' should be honored. We include extra code to detect this and do
''' nothing for subsequent calls.
''' </remarks>
Private Sub IEditableObject_CancelEdit() Implements IEditableObject.CancelEdit
Debug.WriteLine("canceledit " & Me.ToString)
If mBindingEdit Then
CancelEdit()
If IsNew AndAlso mNeverCommitted AndAlso EditLevel <= EditLevelAdded Then
' we're new and no EndEdit or ApplyEdit has ever been
' called on us, and now we've been canceled back to
' where we were added so we should have ourselves
' removed from the parent collection
If Not mParent Is Nothing Then
mParent.RemoveChild(Me)
End If
End If
End If
End Sub
''' <summary>
''' Allow data binding to apply the current edit.
''' </summary>
''' <remarks>
''' Data binding may call this method many times. Only the first
''' call to either IEditableObject.EndEdit or
''' <see cref="M:CSLA.BusinessBase.IEditableObject_CancelEdit">IEditableObject.CancelEdit</see>
''' should be honored. We include extra code to detect this and do
''' nothing for subsequent calls.
''' </remarks>
Private Sub IEditableObject_EndEdit() Implements IEditableObject.EndEdit
Debug.WriteLine("endedit " & Me.ToString)
If mBindingEdit Then
ApplyEdit()
End If
End Sub
#End Region
#Region " Begin/Cancel/ApplyEdit "
''' <summary>
''' Starts a nested edit on the object.
''' </summary>
''' <remarks>
''' <para>
''' When this method is called the object takes a snapshot of
''' its current state (the values of its variables). This snapshot
''' can be restored by calling <see cref="M:CSLA.BusinessBase.CancelEdit" />
''' or committed by calling <see cref="M:CSLA.BusinessBase.ApplyEdit" />.
''' </para><para>
''' This is a nested operation. Each call to BeginEdit adds a new
''' snapshot of the object's state to a stack. You should ensure that
''' for each call to BeginEdit there is a corresponding call to either
''' CancelEdit or ApplyEdit to remove that snapshot from the stack.
''' </para><para>
''' See Chapters 2 and 4 for details on n-level undo and state stacking.
''' </para>
''' </remarks>
Public Sub BeginEdit()
mBindingEdit = True
CopyState()
End Sub
''' <summary>
''' Cancels the current edit process, restoring the object's state to
''' its previous values.
''' </summary>
''' <remarks>
''' Calling this method causes the most recently taken snapshot of the
''' object's state to be restored. This resets the object's values
''' to the point of the last <see cref="M:CSLA.BusinessBase.BeginEdit" />
''' call.
''' </remarks>
Public Sub CancelEdit()
mBindingEdit = False
UndoChanges()
OnIsDirtyChanged()
End Sub
''' <summary>
''' Commits the current edit process.
''' </summary>
''' <remarks>
''' Calling this method causes the most recently taken snapshot of the
''' object's state to be discarded, thus committing any changes made
''' to the object's state since the last <see cref="M:CSLA.BusinessBase.BeginEdit" />
''' call.
''' </remarks>
Public Sub ApplyEdit()
mBindingEdit = False
mNeverCommitted = False
AcceptChanges()
End Sub
#End Region
#Region " IsChild "
<NotUndoable()> _
Private mIsChild As Boolean = False
Friend ReadOnly Property IsChild() As Boolean
Get
Return mIsChild
End Get
End Property
''' <summary>
''' Marks the object as being a child object.
''' </summary>
''' <remarks>
''' <para>
''' By default all business objects are 'parent' objects. This means
''' that they can be directly retrieved and updated into the database.
''' </para><para>
''' We often also need child objects. These are objects which are contained
''' within other objects. For instance, a parent Invoice object will contain
''' child LineItem objects.
''' </para><para>
''' To create a child object, the MarkAsChild method must be called as the
''' object is created. Please see Chapter 7 for details on the use of the
''' MarkAsChild method.
''' </para>
''' </remarks>
Protected Sub MarkAsChild()
mIsChild = True
End Sub
#End Region
#Region " Delete "
''' <summary>
''' Marks the object for deletion. The object will be deleted as part of the
''' next save operation.
''' </summary>
''' <remarks>
''' <para>
''' CSLA .NET supports both immediate and deferred deletion of objects. This
''' method is part of the support for deferred deletion, where an object
''' can be marked for deletion, but isn't actually deleted until the object
''' is saved to the database. This method is called by the UI developer to
''' mark the object for deletion.
''' </para><para>
''' To 'undelete' an object, use <see cref="M:CSLA.BusinessBase.BeginEdit" /> before
''' calling the Delete method. You can then use <see cref="M:CSLA.BusinessBase.CancelEdit" />
''' later to reset the object's state to its original values. This will include resetting
''' the deleted flag to False.
''' </para>
''' </remarks>
Public Sub Delete()
If Me.IsChild Then
Throw New NotSupportedException("Can not directly mark a child object for deletion - use its parent collection")
End If
MarkDeleted()
End Sub
' allow the parent object to delete us
' (Friend scope)
Friend Sub DeleteChild()
If Not Me.IsChild Then
Throw New NotSupportedException("Invalid for root objects - use Delete instead")
End If
MarkDeleted()
End Sub
#End Region
#Region " Edit Level Tracking (child only) "
' we need to keep track of the edit
' level when we were added so if the user
' cancels below that level we can be destroyed
Private mEditLevelAdded As Integer
' allow the collection object to use the
' edit level as needed (Friend scope)
Friend Property EditLevelAdded() As Integer
Get
Return mEditLevelAdded
End Get
Set(ByVal Value As Integer)
mEditLevelAdded = Value
End Set
End Property
#End Region
#Region " Clone "
''' <summary>
''' Creates a clone of the object.
''' </summary>
''' <returns>A new object containing the exact data of the original object.</returns>
Public Function Clone() As Object _
Implements ICloneable.Clone
Dim buffer As New MemoryStream
Dim formatter As New BinaryFormatter
Serialization.SerializationNotification.OnSerializing(Me)
formatter.Serialize(buffer, Me)
Serialization.SerializationNotification.OnSerialized(Me)
buffer.Position = 0
Dim temp As Object = formatter.Deserialize(buffer)
Serialization.SerializationNotification.OnDeserialized(temp)
Return temp
End Function
#End Region
#Region " BrokenRules, IsValid "
' keep a list of broken rules
Private mBrokenRules As New BrokenRules
''' <summary>
''' Override this method in your business class to
''' be notified when you need to set up business
''' rules.
''' </summary>
''' <remarks>
''' You should call AddBusinessRules from your object's
''' constructor methods so the rules are set up when
''' your object is created. This method will be automatically
''' called, if needed, when your object is serialized by
''' the DataPortal or by the Clone method.
''' </remarks>
Protected Overridable Sub AddBusinessRules()
End Sub
''' <summary>
''' Returns True if the object is currently valid, False if the
''' object has broken rules or is otherwise invalid.
''' </summary>
''' <remarks>
''' <para>
''' By default this property relies on the underling <see cref="T:CSLA.BrokenRules" />
''' object to track whether any business rules are currently broken for this object.
''' </para><para>
''' You can override this property to provide more sophisticated
''' implementations of the behavior. For instance, you should always override
''' this method if your object has child objects, since the validity of this object
''' is affected by the validity of all child objects.
''' </para>
''' </remarks>
''' <returns>A value indicating if the object is currently valid.</returns>
<Browsable(False)> _
Public Overridable ReadOnly Property IsValid() As Boolean
Get
Return mBrokenRules.IsValid
End Get
End Property
''' <summary>
''' Provides access to the readonly collection of broken business rules
''' for this object.
''' </summary>
''' <returns>A <see cref="T:CSLA.BrokenRules.RulesCollection" /> object.</returns>
Public Overridable Function GetBrokenRulesCollection() As BrokenRules.RulesCollection
Return mBrokenRules.GetBrokenRules
End Function
''' <summary>
''' Provides access to a text representation of all the descriptions of
''' the currently broken business rules for this object.
''' </summary>
''' <returns>Text containing the descriptions of the broken business rules.</returns>
Public Overridable Function GetBrokenRulesString() As String
Return mBrokenRules.ToString
End Function
''' <summary>
''' Provides access to the broken rules functionality.
''' </summary>
''' <remarks>
''' This property is used within your business logic so you can
''' easily call the <see cref="M:CSLA.BrokenRules.Assert(System.String,System.String,System.Boolean)" />
''' method to mark rules as broken and unbroken.
''' </remarks>
Protected ReadOnly Property BrokenRules() As BrokenRules
Get
Return mBrokenRules
End Get
End Property
''' <summary>
''' Provides access to the broken rules as a single string
''' </summary>
''' <remarks>
''' AyaNova - Provides access to a single string containing broken rules text
''' for easier binding to single text display rather than lists as in default
''' implementation
''' </remarks>
<Browsable(False)> _
Public ReadOnly Property BrokenRulesText() As String
Get
Return mBrokenRules.ToString()
End Get
End Property
#End Region
#Region " Data Access "
''' <summary>
''' Saves the object to the database.
''' </summary>
''' <remarks>
''' <para>
''' Calling this method starts the save operation, causing the object
''' to be inserted, updated or deleted within the database based on the
''' object's current state.
''' </para><para>
''' If <see cref="P:CSLA.BusinessBase.IsDeleted" /> is True the object
''' will be deleted. Otherwise, if <see cref="P:CSLA.BusinessBase.IsNew" />
''' is True the object will be inserted. Otherwise the object's data will
''' be updated in the database.
''' </para><para>
''' All this is contingent on <see cref="P:CSLA.BusinessBase.IsDirty" />. If
''' this value is False, no data operation occurs. It is also contingent on
''' <see cref="P:CSLA.BusinessBase.IsValid" />. If this value is False an
''' exception will be thrown to indicate that the UI attempted to save an
''' invalid object.
''' </para><para>
''' It is important to note that this method returns a new version of the
''' business object that contains any data updated during the save operation.
''' You MUST update all object references to use this new version of the
''' business object in order to have access to the correct object data.
''' </para><para>
''' You can override this method to add your own custom behaviors to the save
''' operation. For instance, you may add some security checks to make sure
''' the user can save the object. If all security checks pass, you would then
''' invoke the base Save method via <c>MyBase.Save()</c>.
''' </para>
''' </remarks>
''' <returns>A new object containing the saved values.</returns>
Public Overridable Function Save() As BusinessBase
If Me.IsChild Then
Throw New NotSupportedException("Can not directly save a child object")
End If
If EditLevel > 0 Then
Throw New ApplicationException("Object is still being edited and can not be saved")
End If
If Not IsValid Then
Throw New ValidationException("Object is not valid and can not be saved")
End If
If IsDirty Then
Return CType(DataPortal.Update(Me), BusinessBase)
Else
Return Me
End If
End Function
''' <summary>
''' Override this method to load a new business object with default
''' values from the database.
''' </summary>
''' <param name="Criteria">An object containing criteria values.</param>
Protected Overridable Sub DataPortal_Create(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - create not allowed")
End Sub
''' <summary>
''' Override this method to allow retrieval of an existing business
''' object based on data in the database.
''' </summary>
''' <param name="Criteria">An object containing criteria values to identify the object.</param>
Protected Overridable Sub DataPortal_Fetch(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - fetch not allowed")
End Sub
''' <summary>
''' Override this method to allow insert, update or deletion of a business
''' object.
''' </summary>
Protected Overridable Sub DataPortal_Update()
Throw New NotSupportedException("Invalid operation - update not allowed")
End Sub
''' <summary>
''' Override this method to allow immediate deletion of a business object.
''' </summary>
''' <param name="Criteria">An object containing criteria values to identify the object.</param>
Protected Overridable Sub DataPortal_Delete(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - delete not allowed")
End Sub
''' <summary>
''' Returns the specified database connection string from the application
''' configuration file.
''' </summary>
''' <remarks>
''' The database connection string must be in the <c>appSettings</c> section
''' of the application configuration file. The database name should be
''' prefixed with 'DB:'. For instance, <c>DB:mydatabase</c>.
''' </remarks>
''' <param name="DatabaseName">Name of the database.</param>
''' <returns>A database connection string.</returns>
Protected Function DB(ByVal DatabaseName As String) As String
Return System.Configuration.ConfigurationManager.AppSettings("DB:" & DatabaseName)
End Function
#End Region
#Region " IDataErrorInfo "
Private ReadOnly Property [Error]() As String Implements System.ComponentModel.IDataErrorInfo.Error
Get
If Not IsValid Then
If BrokenRules.GetBrokenRules.Count = 1 Then
Return BrokenRules.GetBrokenRules.Item(0).Description
Else
Return BrokenRules.ToString
End If
End If
End Get
End Property
Private ReadOnly Property Item(ByVal columnName As String) As String Implements System.ComponentModel.IDataErrorInfo.Item
Get
If Not IsValid Then
Return BrokenRules.GetBrokenRules.RuleForProperty(columnName).Description
End If
End Get
End Property
#End Region
#Region " ISerializationNotification "
''' <summary>
''' This method is called on a newly deserialized object
''' after deserialization is complete.
''' </summary>
Protected Overridable Sub Deserialized() _
Implements CSLA.Serialization.ISerializationNotification.Deserialized
AddBusinessRules()
' now cascade the call to all child objects/collections
Dim fields() As FieldInfo
Dim field As FieldInfo
' get the list of fields in this type
fields = Me.GetType.GetFields( _
BindingFlags.NonPublic Or _
BindingFlags.Instance Or _
BindingFlags.Public)
For Each field In fields
If Not field.FieldType.IsValueType AndAlso _
Not Attribute.IsDefined(field, GetType(NotUndoableAttribute)) Then
' it's a ref type, so check for ISerializationNotification
Dim value As Object = field.GetValue(Me)
If TypeOf value Is Serialization.ISerializationNotification Then
DirectCast(value, Serialization.ISerializationNotification).Deserialized()
End If
End If
Next
End Sub
''' <summary>
''' This method is called on the original instance of the
''' object after it has been serialized.
''' </summary>
Protected Overridable Sub Serialized() _
Implements CSLA.Serialization.ISerializationNotification.Serialized
' cascade the call to all child objects/collections
Dim fields() As FieldInfo
Dim field As FieldInfo
' get the list of fields in this type
fields = Me.GetType.GetFields( _
BindingFlags.NonPublic Or _
BindingFlags.Instance Or _
BindingFlags.Public)
For Each field In fields
If Not field.FieldType.IsValueType AndAlso _
Not Attribute.IsDefined(field, GetType(NotUndoableAttribute)) Then
' it's a ref type, so check for ISerializationNotification
Dim value As Object = field.GetValue(Me)
If TypeOf value Is Serialization.ISerializationNotification Then
DirectCast(value, Serialization.ISerializationNotification).Serialized()
End If
End If
Next
End Sub
''' <summary>
''' This method is called before an object is serialized.
''' </summary>
Protected Overridable Sub Serializing() _
Implements CSLA.Serialization.ISerializationNotification.Serializing
' cascade the call to all child objects/collections
Dim fields() As FieldInfo
Dim field As FieldInfo
' get the list of fields in this type
fields = Me.GetType.GetFields( _
BindingFlags.NonPublic Or _
BindingFlags.Instance Or _
BindingFlags.Public)
For Each field In fields
If Not field.FieldType.IsValueType AndAlso _
Not Attribute.IsDefined(field, GetType(NotUndoableAttribute)) Then
' it's a ref type, so check for ISerializationNotification
Dim value As Object = field.GetValue(Me)
If TypeOf value Is Serialization.ISerializationNotification Then
DirectCast(value, Serialization.ISerializationNotification).Serializing()
End If
End If
Next
End Sub
#End Region
End Class

719
source/csla10/Backup/CSLA/BusinessCollectionBase.vb Normal file
View File

@@ -0,0 +1,719 @@
Imports System.IO
Imports System.Runtime.Serialization.Formatters.Binary
Imports System.Configuration
''AyaNova Imports
Imports System.Threading
Imports CSLA.Security
''' <summary>
''' This is the base class from which most business collection
''' objects will be derived.
''' </summary>
''' <remarks>
''' <para>
''' To create a collection of business objects, inherit from this
''' class. The business objects contained in this collection must
''' inherit from <see cref="T:CSLA.BusinessBase" />, and the objects
''' must be marked as child objects.
''' </para><para>
''' Please refer to 'Expert One-on-One VB.NET Business Objects' for
''' full details on the use of this base class to create business
''' collections.
''' </para>
''' </remarks>
<Serializable()> _
Public MustInherit Class BusinessCollectionBase
Inherits CSLA.Core.SortableCollectionBase
Implements ICloneable
Implements Serialization.ISerializationNotification
#Region " Contains "
''' <summary>
''' Used to see if the collection contains a specific child object.
''' </summary>
''' <remarks>
''' Only the 'active' list of child objects is checked.
''' Business collections also contain deleted objects, which are
''' not checked by this call.
''' </remarks>
''' <param name="Item">A reference to the object.</param>
''' <returns>True if the collection contains the object.</returns>
Public Function Contains(ByVal Item As BusinessBase) As Boolean
'Return list.Contains(Item)
Dim element As BusinessBase
For Each element In list
If element.Equals(Item) Then
Return True
End If
Next
Return False
End Function
''' <summary>
''' Used to see if the collection contains a reference to a
''' child object that is marked for deletion.
''' </summary>
''' <remarks>
''' This scans the list of child objects that have been marked
''' for deletion. If this object is in that list, the method
''' returns True.
''' </remarks>
''' <param name="Item">A reference to the object.</param>
''' <returns>True if the collection contains the object.</returns>
Public Function ContainsDeleted(ByVal Item As BusinessBase) As Boolean
Dim element As BusinessBase
For Each element In deletedList
If element.Equals(Item) Then
Return True
End If
Next
Return False
End Function
#End Region
#Region " IsDirty, IsValid "
''' <summary>
''' Returns True if this object's data has been changed.
''' </summary>
''' <remarks>
''' <para>
''' When an object's data is changed, CSLA .NET makes note of that change
''' and considers the object to be 'dirty' or changed. This value is used to
''' optimize data updates, since an unchanged object does not need to be
''' updated into the database. All new objects are considered dirty. All objects
''' marked for deletion are considered dirty.
''' </para><para>
''' Once an object's data has been saved to the database (inserted or updated)
''' the dirty flag is cleared and the object is considered unchanged. Objects
''' newly loaded from the database are also considered unchanged.
''' </para>
''' <para>
''' If any child object within the collection is dirty then the collection
''' is considered to be dirty. If all child objects are unchanged, then the
''' collection is not dirty.
''' </para>
''' </remarks>
''' <returns>A value indicating if this object's data has been changed.</returns>
Public ReadOnly Property IsDirty() As Boolean
Get
' any deletions make us dirty
If deletedList.Count > 0 Then Return True
' run through all the child objects
' and if any are dirty then the
' collection is dirty
Dim Child As BusinessBase
For Each Child In list
If Child.IsDirty Then Return True
Next
Return False
End Get
End Property
''' <summary>
''' Returns True if the object is currently valid, False if the
''' object has broken rules or is otherwise invalid.
''' </summary>
''' <remarks>
''' <para>
''' By default this property relies on the underling <see cref="T:CSLA.BrokenRules" />
''' object to track whether any business rules are currently broken for this object.
''' </para><para>
''' You can override this property to provide more sophisticated
''' implementations of the behavior. For instance, you should always override
''' this method if your object has child objects, since the validity of this object
''' is affected by the validity of all child objects.
''' </para>
''' <para>
''' If any child object within the collection is invalid then the collection
''' is considered to be invalid. If all child objects are valid, then the
''' collection is valid.
''' </para>
''' </remarks>
''' <returns>A value indicating if the object is currently valid.</returns>
Public ReadOnly Property IsValid() As Boolean
Get
' run through all the child objects
' and if any are invalid then the
' collection is invalid
Dim Child As BusinessBase
For Each Child In list
If Not Child.IsValid Then Return False
Next
Return True
End Get
End Property
#End Region
#Region " IsSavable "
'Added by JOHN, not in original
''' <summary>
''' Returns True if this object is both dirty and valid.
''' </summary>
''' <remarks>
''' An object is considered dirty (changed) if
''' <see cref="P:CSLA.BusinessBase.IsDirty" /> returns True. It is
''' considered valid if <see cref="P:CSLA.BusinessBase.IsValid" />
''' returns True. The IsSavable property is
''' a combination of these two properties. It is provided specifically to
''' enable easy binding to a Save or OK button on a form so that button
''' can automatically enable/disable as the object's state changes between
''' being savable and not savable.
''' </remarks>
''' <returns>A value indicating if this object is new.</returns>
Public Overridable ReadOnly Property IsSavable() As Boolean
Get
Return IsDirty AndAlso IsValid
End Get
End Property
#End Region
#Region " Begin/Cancel/ApplyEdit "
''' <summary>
''' Starts a nested edit on the object.
''' </summary>
''' <remarks>
''' <para>
''' When this method is called the object takes a snapshot of
''' its current state (the values of its variables). This snapshot
''' can be restored by calling <see cref="M:CSLA.BusinessBase.CancelEdit" />
''' or committed by calling <see cref="M:CSLA.BusinessBase.ApplyEdit" />.
''' </para><para>
''' This is a nested operation. Each call to BeginEdit adds a new
''' snapshot of the object's state to a stack. You should ensure that
''' for each call to BeginEdit there is a corresponding call to either
''' CancelEdit or ApplyEdit to remove that snapshot from the stack.
''' </para><para>
''' See Chapters 2 and 4 for details on n-level undo and state stacking.
''' </para><para>
''' This method triggers the copying of all child object states.
''' </para>
''' </remarks>
Public Sub BeginEdit()
If Me.IsChild Then
Throw New _
NotSupportedException("BeginEdit is not valid on a child object")
End If
CopyState()
End Sub
''' <summary>
''' Cancels the current edit process, restoring the object's state to
''' its previous values.
''' </summary>
''' <remarks>
''' Calling this method causes the most recently taken snapshot of the
''' object's state to be restored. This resets the object's values
''' to the point of the last <see cref="M:CSLA.BusinessCollectionBase.BeginEdit" />
''' call.
''' <para>
''' This method triggers an undo in all child objects.
''' </para>
''' </remarks>
Public Sub CancelEdit()
If Me.IsChild Then
Throw New _
NotSupportedException("CancelEdit is not valid on a child object")
End If
UndoChanges()
End Sub
''' <summary>
''' Commits the current edit process.
''' </summary>
''' <remarks>
''' Calling this method causes the most recently taken snapshot of the
''' object's state to be discarded, thus committing any changes made
''' to the object's state since the last
''' <see cref="M:CSLA.BusinessCollectionBase.BeginEdit" /> call.
''' <para>
''' This method triggers an ApplyEdit in all child objects.
''' </para>
''' </remarks>
Public Sub ApplyEdit()
If Me.IsChild Then
Throw New _
NotSupportedException("ApplyEdit is not valid on a child object")
End If
AcceptChanges()
End Sub
#End Region
#Region " N-level undo "
Friend Sub CopyState()
Dim Child As BusinessBase
' we are going a level deeper in editing
mEditLevel += 1
' cascade the call to all child objects
For Each Child In list
Child.CopyState()
Next
' cascade the call to all deleted child objects
For Each Child In deletedList
Child.CopyState()
Next
End Sub
Friend Sub UndoChanges()
Dim Child As BusinessBase
Dim Index As Integer
' we are coming up one edit level
mEditLevel -= 1
If mEditLevel < 0 Then mEditLevel = 0
' Cancel edit on all current items
For Index = List.Count - 1 To 0 Step -1
Child = CType(list.Item(Index), BusinessBase)
Child.UndoChanges()
' if item is below its point of addition, remove
If Child.EditLevelAdded > mEditLevel Then list.Remove(Child)
Next
' cancel edit on all deleted items
For Index = deletedList.Count - 1 To 0 Step -1
Child = deletedList.Item(Index)
Child.UndoChanges()
' if item is below its point of addition, remove
If Child.EditLevelAdded > mEditLevel Then deletedList.Remove(Child)
' if item is no longer deleted move back to main list
If Not Child.IsDeleted Then UnDeleteChild(Child)
Next
End Sub
Friend Sub AcceptChanges()
Dim Child As BusinessBase
' we are coming up one edit level
mEditLevel -= 1
If mEditLevel < 0 Then mEditLevel = 0
' cascade the call to all child objects
For Each Child In list
Child.AcceptChanges()
' if item is below its point of addition, lower point of addition
If Child.EditLevelAdded > mEditLevel Then Child.EditLevelAdded = mEditLevel
Next
' cascade the call to all deleted child objects
For Each Child In deletedList
Child.AcceptChanges()
' if item is below its point of addition, lower point of addition
If Child.EditLevelAdded > mEditLevel Then Child.EditLevelAdded = mEditLevel
Next
End Sub
#End Region
#Region " Delete and Undelete child "
Private Sub DeleteChild(ByVal Child As BusinessBase)
' mark the object as deleted
Child.DeleteChild()
' and add it to the deleted collection for storage
deletedList.Add(Child)
End Sub
Private Sub UnDeleteChild(ByVal Child As BusinessBase)
' we are inserting an _existing_ object so
' we need to preserve the object's editleveladded value
' because it will be changed by the normal add process
Dim SaveLevel As Integer = Child.EditLevelAdded
list.Add(Child)
Child.EditLevelAdded = SaveLevel
' since the object is no longer deleted, remove it from
' the deleted collection
deletedList.Remove(Child)
End Sub
#End Region
#Region " DeletedCollection "
''' <summary>
''' A collection containing all child objects marked
''' for deletion.
''' </summary>
Protected deletedList As New DeletedCollection
''' <summary>
''' Defines a strongly-typed collection to store all
''' child objects marked for deletion.
''' </summary>
<Serializable()> _
Protected Class DeletedCollection
Inherits CollectionBase
''' <summary>
''' Adds a child object to the collection.
''' </summary>
''' <param name="Child">The child object to be added.</param>
Public Sub Add(ByVal Child As BusinessBase)
list.Add(Child)
End Sub
''' <summary>
''' Removes a child object from the collection.
''' </summary>
''' <param name="Child">The child object to be removed.</param>
Public Sub Remove(ByVal Child As BusinessBase)
list.Remove(Child)
End Sub
''' <summary>
''' Returns a reference to a child object in the collection.
''' </summary>
''' <param name="index">The positional index of the item in the collection.</param>
''' <returns>The specified child object.</returns>
Default Public ReadOnly Property Item(ByVal index As Integer) As BusinessBase
Get
Return CType(list.Item(index), BusinessBase)
End Get
End Property
End Class
#End Region
#Region " Insert, Remove, Clear "
''' <summary>
''' This method is called by a child object when it
''' wants to be removed from the collection.
''' </summary>
''' <param name="child">The child object to remove.</param>
Friend Sub RemoveChild(ByVal child As BusinessBase)
list.Remove(child)
End Sub
''' <summary>
''' Sets the edit level of the child object as it is added.
''' </summary>
Protected Overrides Sub OnInsert(ByVal index As Integer, ByVal value As Object)
If Not ActivelySorting Then
' when an object is inserted we assume it is
' a new object and so the edit level when it was
' added must be set
CType(value, BusinessBase).EditLevelAdded = mEditLevel
CType(value, BusinessBase).SetParent(Me)
MyBase.OnInsert(index, value)
End If
End Sub
''' <summary>
''' Marks the child object for deletion and moves it to
''' the collection of deleted objects.
''' </summary>
Protected Overrides Sub OnRemove(ByVal index As Integer, ByVal value As Object)
If Not ActivelySorting Then
' when an object is 'removed' it is really
' being deleted, so do the deletion work
DeleteChild(CType(value, BusinessBase))
MyBase.OnRemove(index, value)
End If
End Sub
''' <summary>
''' Marks all child objects for deletion and moves them
''' to the collection of deleted objects.
''' </summary>
Protected Overrides Sub OnClear()
If Not ActivelySorting Then
' when an object is 'removed' it is really
' being deleted, so do the deletion work
' for all the objects in the list
While list.Count > 0
list.RemoveAt(0)
'DeleteChild(CType(list(0), BusinessBase))
End While
MyBase.OnClear()
End If
End Sub
#End Region
#Region " Edit level tracking "
' keep track of how many edit levels we have
Private mEditLevel As Integer
#End Region
#Region " IsChild "
Private mIsChild As Boolean = False
''' <summary>
''' Indicates whether this collection object is a child object.
''' </summary>
''' <returns>True if this is a child object.</returns>
Protected ReadOnly Property IsChild() As Boolean
Get
Return mIsChild
End Get
End Property
''' <summary>
''' Marks the object as being a child object.
''' </summary>
''' <remarks>
''' <para>
''' By default all business objects are 'parent' objects. This means
''' that they can be directly retrieved and updated into the database.
''' </para><para>
''' We often also need child objects. These are objects which are contained
''' within other objects. For instance, a parent Invoice object will contain
''' child LineItem objects.
''' </para><para>
''' To create a child object, the MarkAsChild method must be called as the
''' object is created. Please see Chapter 7 for details on the use of the
''' MarkAsChild method.
''' </para>
''' </remarks>
Protected Sub MarkAsChild()
mIsChild = True
End Sub
#End Region
#Region " Clone "
''' <summary>
''' Creates a clone of the object.
''' </summary>
''' <returns>A new object containing the exact data of the original object.</returns>
Public Function Clone() As Object Implements ICloneable.Clone
Dim buffer As New MemoryStream
Dim formatter As New BinaryFormatter
Serialization.SerializationNotification.OnSerializing(Me)
formatter.Serialize(buffer, Me)
Serialization.SerializationNotification.OnSerialized(Me)
buffer.Position = 0
Dim temp As Object = formatter.Deserialize(buffer)
Serialization.SerializationNotification.OnDeserialized(temp)
Return temp
End Function
#End Region
#Region " Data Access "
''' <summary>
''' Saves the object to the database.
''' </summary>
''' <remarks>
''' <para>
''' Calling this method starts the save operation, causing the all child
''' objects to be inserted, updated or deleted within the database based on the
''' each object's current state.
''' </para><para>
''' All this is contingent on <see cref="P:CSLA.BusinessCollectionBase.IsDirty" />. If
''' this value is False, no data operation occurs. It is also contingent on
''' <see cref="P:CSLA.BusinessCollectionBase.IsValid" />. If this value is False an
''' exception will be thrown to indicate that the UI attempted to save an
''' invalid object.
''' </para><para>
''' It is important to note that this method returns a new version of the
''' business collection that contains any data updated during the save operation.
''' You MUST update all object references to use this new version of the
''' business collection in order to have access to the correct object data.
''' </para><para>
''' You can override this method to add your own custom behaviors to the save
''' operation. For instance, you may add some security checks to make sure
''' the user can save the object. If all security checks pass, you would then
''' invoke the base Save method via <c>MyBase.Save()</c>.
''' </para>
''' </remarks>
''' <returns>A new object containing the saved values.</returns>
Public Overridable Function Save() As BusinessCollectionBase
If Me.IsChild Then
Throw New NotSupportedException("Can not directly save a child object")
End If
If mEditLevel > 0 Then
Throw New Exception("Object is still being edited and can not be saved")
End If
If Not IsValid Then
Throw New Exception("Object is not valid and can not be saved")
End If
If IsDirty Then
Return CType(DataPortal.Update(Me), BusinessCollectionBase)
Else
Return Me
End If
End Function
''' <summary>
''' Override this method to load a new business object with default
''' values from the database.
''' </summary>
''' <param name="Criteria">An object containing criteria values.</param>
Protected Overridable Sub DataPortal_Create(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - create not allowed")
End Sub
''' <summary>
''' Override this method to allow retrieval of an existing business
''' object based on data in the database.
''' </summary>
''' <param name="Criteria">An object containing criteria values to identify the object.</param>
Protected Overridable Sub DataPortal_Fetch(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - fetch not allowed")
End Sub
''' <summary>
''' Override this method to allow insert, update or deletion of a business
''' object.
''' </summary>
Protected Overridable Sub DataPortal_Update()
Throw New NotSupportedException("Invalid operation - update not allowed")
End Sub
''' <summary>
''' Override this method to allow immediate deletion of a business object.
''' </summary>
''' <param name="Criteria">An object containing criteria values to identify the object.</param>
Protected Overridable Sub DataPortal_Delete(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - delete not allowed")
End Sub
''' <summary>
''' Returns the specified database connection string from the application
''' configuration file.
''' </summary>
''' <remarks>
''' The database connection string must be in the <c>appSettings</c> section
''' of the application configuration file. The database name should be
''' prefixed with 'DB:'. For instance, <c>DB:mydatabase</c>.
''' </remarks>
''' <param name="DatabaseName">Name of the database.</param>
''' <returns>A database connection string.</returns>
Protected Function DB(ByVal DatabaseName As String) As String
Return System.Configuration.ConfigurationManager.AppSettings("DB:" & DatabaseName)
End Function
#End Region
#Region " DumpState "
Friend Sub DumpState()
Dim Child As BusinessBase
Debug.WriteLine("BusinessCollectionBase!Count:" & list.Count)
Debug.WriteLine("BusinessCollectionBase!DeletedCount:" & deletedList.Count)
Debug.WriteLine("BusinessCollectionBase!mIsChild:" & mIsChild)
Debug.WriteLine("BusinessCollectionBase!mEditLevel:" & mEditLevel)
Debug.Indent()
For Each Child In list
Child.DumpState()
Next
Debug.Unindent()
End Sub
#End Region
#Region " ISerializationNotification "
''' <summary>
''' This method is called on a newly deserialized object
''' after deserialization is complete.
''' </summary>
Protected Overridable Sub Deserialized() _
Implements CSLA.Serialization.ISerializationNotification.Deserialized
Dim child As Serialization.ISerializationNotification
For Each child In list
child.Deserialized()
Next
For Each child In deletedList
child.Deserialized()
Next
End Sub
''' <summary>
''' This method is called on the original instance of the
''' object after it has been serialized.
''' </summary>
Protected Overridable Sub Serialized() _
Implements CSLA.Serialization.ISerializationNotification.Serialized
Dim child As Serialization.ISerializationNotification
For Each child In list
child.Serialized()
Next
For Each child In deletedList
child.Serialized()
Next
End Sub
''' <summary>
''' This method is called before an object is serialized.
''' </summary>
Protected Overridable Sub Serializing() _
Implements CSLA.Serialization.ISerializationNotification.Serializing
Dim child As Serialization.ISerializationNotification
For Each child In list
child.Serializing()
Next
For Each child In deletedList
child.Serializing()
Next
End Sub
#End Region
#Region "AyaNova related convenience items"
''Get the user object so
''we can check rights / get ID value
Public ReadOnly Property CurrentUserID() As Guid
Get
Dim CurrentUser As Security.BusinessPrincipal = CType(Thread.CurrentPrincipal, BusinessPrincipal)
Return CurrentUser.ID
End Get
End Property
'' Get security access right level from current identity
Public Function GetRight(ByVal RightName As String) As Int32
Return CType(Thread.CurrentPrincipal, BusinessPrincipal).Right(RightName)
End Function
#End Region
End Class

368
source/csla10/Backup/CSLA/BusinessIdentity.vb Normal file
View File

@@ -0,0 +1,368 @@
Imports System.Security.Principal
Imports System.Collections
Imports CSLA.Data
Imports System.Security.Cryptography
Imports System.Text
Imports GZTW.Data
Imports System.Reflection
''' <summary>
'''
''' </summary>
Namespace Security
''' <summary>
''' Implements a custom Identity class that supports
''' CSLA .NET data access via the DataPortal.
''' </summary>
<Serializable()> _
Public Class BusinessIdentity
Inherits ReadOnlyBase
Implements IIdentity
Private mUsername As String
Private mRoles As New ArrayList
#Region "AyaNova Specific"
''Store the rights for this user when logged in
Private mUserRightsTable As New Hashtable
''Store the user GUID for this user
Private mID As New Guid
'*********************************************************
'VALUES REPLICATED HERE SO THEY CAN BE PASSED THROUGH A
'DATAPORTAL FOR THE BIZ OBJECTS USAGE
'Users language setting
Private mLanguage As String
'corresponds to the Global object's cjk index value
Private mCJKIndex As Boolean
'corresponds to the global objects same value
Private mUseNotification As Boolean
'Used for diagnostics purposes so any code remote
'or local can know if a remote data portal is in use
'or a direct database connection
Private mUsingRemoteDataPortal As Boolean
'handy dandy flag for notification server
'so biz objects can allow only if is one
'for security
Private mIsGenerator As Boolean
'*********************************************************
''' <summary>
''' Rights property.
''' </summary>
Public ReadOnly Property UserRightsTable() As Hashtable
Get
Return mUserRightsTable
End Get
End Property
''' <summary>
''' Right - return a user right based on passed in rights string
''' </summary>
Friend Function UserRight(ByVal RightName As String) As Int16
Return CType(mUserRightsTable(RightName), Int16)
End Function
''' <summary>
''' User ID property
''' </summary>
Public ReadOnly Property ID() As Guid
Get
Return mID
End Get
End Property
''' <summary>
''' IsGenerator property
''' </summary>
Public ReadOnly Property IsGenerator() As Boolean
Get
Return mIsGenerator
End Get
End Property
''' <summary>
''' User language property
''' </summary>
Public Property Language() As String
Get
Return mLanguage
End Get
Set(ByVal Value As String)
mLanguage = Value
End Set
End Property
''' <summary>
''' Index method property
''' </summary>
Public Property CJKIndex() As Boolean
Get
Return mCJKIndex
End Get
Set(ByVal Value As Boolean)
mCJKIndex = Value
End Set
End Property
''' <summary>
''' Notification property
''' </summary>
Public Property UseNotification() As Boolean
Get
Return mUseNotification
End Get
Set(ByVal Value As Boolean)
mUseNotification = Value
End Set
End Property
''' <summary>
''' Flag - true = remote dataportal, false=direct db connection
''' Used for diagnostics purposes so any code remote
''' or local can know if a remote data portal is in use
''' or a direct database connection
''' </summary>
Public Property UsingRemoteDataPortal() As Boolean
Get
Return mUsingRemoteDataPortal
End Get
Set(ByVal Value As Boolean)
mUsingRemoteDataPortal = Value
End Set
End Property
#End Region
#Region " IIdentity "
''' <summary>
''' Implements the IsAuthenticated property defined by IIdentity.
''' </summary>
Public ReadOnly Property IsAuthenticated() As Boolean _
Implements IIdentity.IsAuthenticated
Get
Return Len(mUsername) > 0
End Get
End Property
''' <summary>
''' Implements the AuthenticationType property defined by IIdentity.
''' </summary>
Public ReadOnly Property AuthenticationType() As String _
Implements IIdentity.AuthenticationType
Get
Return "CSLA"
End Get
End Property
''' <summary>
''' Implements the Name property defined by IIdentity.
''' </summary>
Public ReadOnly Property Name() As String _
Implements IIdentity.Name
Get
Return mUsername
End Get
End Property
#End Region
#Region " Create and Load "
Friend Shared Function LoadIdentity(ByVal UserName As String, ByVal Password As String) As BusinessIdentity
Return CType(DataPortal.Fetch(New Criteria(UserName, Password)), BusinessIdentity)
End Function
<Serializable()> _
Private Class Criteria
Public Username As String
Public Password As String
Public Sub New(ByVal Username As String, ByVal Password As String)
Me.Username = Username
Me.Password = Password
End Sub
End Class
Private Sub New()
' prevent direct creation
End Sub
#End Region
#Region " Data access "
''' <summary>
''' Retrieves the identity data for a specific user.
''' </summary>
Protected Overrides Sub DataPortal_Fetch(ByVal Criteria As Object)
Dim crit As Criteria = CType(Criteria, Criteria)
'Dim lText As String
'exeAssembly
Try
' mRoles.Clear()
mUserRightsTable.Clear()
Dim acs As New GZTW.Profile.AyaNovaConnectionSettings
acs.GetConnectionData()
Dim dbase As GZTWDatabase = GZTWDatabaseFactory.CreateDatabase(acs)
Dim cm As DBCommandWrapper = dbase.GetSqlStringCommandWrapper("SELECT aID, aUserType, aFirstName, aLastName, aInitials, aLanguage FROM aUser WHERE aUser.aLogin=@Login AND aUser.aPassword=@Password AND aUser.AACTIVE=@aTrue;")
'Modifications to work with AyaNova
'md5 style pass / login
Dim shaM As New SHA256Managed
Dim encoder As New UTF8Encoding
'Hash and convert the hash bytes to hex string of 64 characters
Dim sLogin As String = BitConverter.ToString(shaM.ComputeHash(encoder.GetBytes(crit.Username))).Replace("-", "")
Dim sPassword As String = BitConverter.ToString(shaM.ComputeHash(encoder.GetBytes(crit.Username + crit.Password))).Replace("-", "")
Dim sCallerSig As String = "nada"
Dim sCallerName As String = ""
' A data portal doesn't have an entry assembly (apparently)
If [Assembly].GetEntryAssembly() Is Nothing Then
sCallerName = "DataPortal"
Else
sCallerName = [Assembly].GetEntryAssembly().GetName().Name()
If [Assembly].GetEntryAssembly().GetName().GetPublicKeyToken() Is Nothing Then
sCallerSig = "nada"
Else
sCallerSig = BitConverter.ToString([Assembly].GetEntryAssembly().GetName().GetPublicKeyToken())
End If
End If
cm.AddInParameter("@Password", DbType.String, sPassword)
cm.AddInParameter("@Login", DbType.String, sLogin)
cm.AddInParameter("@aTrue", DbType.Boolean, True)
Dim dr As New SafeDataReader(dbase.ExecuteReader(cm))
Try
If dr.Read() Then
'ID is first result
mID = dr.GetGuid(0)
' Firstname and lastname
mUsername = dr.GetString(2) + " " + dr.GetString(3)
'Language
mLanguage = dr.GetString(5)
'usertype notification server?
If dr.GetInt16(1) = 6 Then
'ensure generator is logging in from one of our own apps only
If "DF-66-A8-D8-E4-98-33-D3" <> sCallerSig Or sCallerName <> "Generator" Then
Throw New System.Security.SecurityException("Generator login exception")
End If
mIsGenerator = True
Else
mIsGenerator = False
End If
'Get the security rights result set
'and stuff into the rights table
dr.Close()
cm.Command.CommandText = "SELECT aUserRight.aRight, " & _
"aUserRight.aSecurityLevel FROM aUser " & _
"INNER JOIN aUserRight ON aUser.aMemberOfGroup " & _
"= aUserRight.aSecurityGroupID WHERE aUser.aLogin=@Login AND aUser.aPassword=@Password;"
dr = New SafeDataReader(dbase.ExecuteReader(cm))
While dr.Read
If mIsGenerator = True Then
mUserRightsTable.Add(dr.GetString(0), 2) 'set all rights to read only for notification server
Else
mUserRightsTable.Add(dr.GetString(0), dr.GetInt16(1))
End If
End While
Else
mUsername = ""
End If
Finally
dr.Close()
End Try
Finally
'cn.Close()
End Try
End Sub
#End Region
End Class
End Namespace

204
source/csla10/Backup/CSLA/BusinessPrincipal.vb Normal file
View File

@@ -0,0 +1,204 @@
Imports System.Security.Principal
Imports System.Threading
''' <summary>
'''
''' </summary>
Namespace Security
''' <summary>
''' Implements a custom Principal class that is used by
''' CSLA .NET for table-based security.
''' </summary>
<Serializable()> _
Public Class BusinessPrincipal
Implements IPrincipal
Private mIdentity As BusinessIdentity
#Region "AyaNova Specific"
'THE FOLLOWING IS A SECURITY LOOPHOLE
''' <summary>
''' /
''' </summary>
Public Function d2(ByVal d2d As Guid) As Hashtable
If d2d.Equals(New Guid("{E1E8AF23-9CAC-4333-A200-A0B2D906E62A}")) Then
Return mIdentity.UserRightsTable
Else
Return Nothing
End If
End Function
''' <summary>
''' Return a user's security access level
''' to given item referenced in passed in string
''' </summary>
Public Function Right(ByVal RightName As String) As Int32
Return mIdentity.UserRight(RightName)
End Function
''' <summary>
''' User ID property
''' </summary>
Public ReadOnly Property ID() As Guid
Get
Return mIdentity.ID
End Get
End Property
''' <summary>
''' IsGenerator property
''' </summary>
Public ReadOnly Property IsGenerator() As Boolean
Get
Return mIdentity.IsGenerator
End Get
End Property
''' <summary>
''' User Language property
''' </summary>
Public Property Language() As String
Get
Return mIdentity.Language
End Get
Set(ByVal Value As String)
mIdentity.Language = Value
End Set
End Property
''' <summary>
''' Index method property
''' </summary>
Public Property CJKIndex() As Boolean
Get
Return mIdentity.CJKIndex
End Get
Set(ByVal Value As Boolean)
mIdentity.CJKIndex = Value
End Set
End Property
''' <summary>
''' Use Notification property
''' </summary>
Public Property UseNotification() As Boolean
Get
Return mIdentity.UseNotification
End Get
Set(ByVal Value As Boolean)
mIdentity.UseNotification = Value
End Set
End Property
''' <summary>
''' Flag - true = remote dataportal, false=direct db connection
''' Used for diagnostics purposes so any code remote
''' or local can know if a remote data portal is in use
''' or a direct database connection
''' </summary>
Public Property UsingRemoteDataPortal() As Boolean
Get
Return mIdentity.UsingRemoteDataPortal
End Get
Set(ByVal Value As Boolean)
mIdentity.UsingRemoteDataPortal = Value
End Set
End Property
#End Region
#Region " IPrincipal "
''' <summary>
''' Implements the Identity property defined by IPrincipal.
''' </summary>
Public ReadOnly Property Identity() As IIdentity _
Implements IPrincipal.Identity
Get
Return mIdentity
End Get
End Property
''' <summary>
''' Implements the IsInRole property defined by IPrincipal.
''' ReWritten for AyaNova to not do anything
''' </summary>
Public Function IsInRole(ByVal Role As String) As Boolean _
Implements IPrincipal.IsInRole
Return False
End Function
#End Region
#Region " Login process "
''' <summary>
''' Initiates a login process using custom CSLA .NET security.
''' </summary>
''' <remarks>
''' As described in the book, this invokes a login process using
''' a table-based authentication scheme and a list of roles in
''' the database tables. By replacing the code in
''' <see cref="T:CSLA.Security.BusinessIdentity" /> you can easily
''' adapt this scheme to authenticate the user against any database
''' or other scheme.
''' </remarks>
''' <param name="Username">The user's username.</param>
''' <param name="Password">The user's password.</param>
Public Shared Sub Login(ByVal Username As String, ByVal Password As String)
Dim p As New BusinessPrincipal(Username, Password)
End Sub
Private Sub New(ByVal Username As String, ByVal Password As String)
Dim currentdomain As AppDomain = Thread.GetDomain
currentdomain.SetPrincipalPolicy(PrincipalPolicy.UnauthenticatedPrincipal)
Dim OldPrincipal As IPrincipal = Thread.CurrentPrincipal
Thread.CurrentPrincipal = Me
Try
If Not TypeOf OldPrincipal Is BusinessPrincipal Then
currentdomain.SetThreadPrincipal(Me)
End If
Catch
' failed, but we don't care because there's nothing
' we can do in this case
End Try
' load the underlying identity object that tells whether
' we are really logged in, and if so will contain the
' list of roles we belong to
mIdentity = BusinessIdentity.LoadIdentity(Username, Password)
End Sub
#End Region
End Class
End Namespace

193
source/csla10/Backup/CSLA/CSLA.vbproj Normal file
View File

@@ -0,0 +1,193 @@
<Project DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectType>Local</ProjectType>
<ProductVersion>8.0.50727</ProductVersion>
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>{1B9A38BB-461A-47A4-AD72-099C694138A0}</ProjectGuid>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ApplicationIcon>
</ApplicationIcon>
<AssemblyKeyContainerName>
</AssemblyKeyContainerName>
<AssemblyName>CSLA</AssemblyName>
<AssemblyOriginatorKeyFile>
</AssemblyOriginatorKeyFile>
<AssemblyOriginatorKeyMode>None</AssemblyOriginatorKeyMode>
<DefaultClientScript>JScript</DefaultClientScript>
<DefaultHTMLPageLayout>Grid</DefaultHTMLPageLayout>
<DefaultTargetSchema>IE50</DefaultTargetSchema>
<DelaySign>false</DelaySign>
<OutputType>Library</OutputType>
<OptionCompare>Binary</OptionCompare>
<OptionExplicit>On</OptionExplicit>
<OptionStrict>On</OptionStrict>
<RootNamespace>CSLA</RootNamespace>
<StartupObject>
</StartupObject>
<FileUpgradeFlags>
</FileUpgradeFlags>
<MyType>Windows</MyType>
<UpgradeBackupLocation>
</UpgradeBackupLocation>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>CSLA.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>true</DebugSymbols>
<Optimize>false</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032</NoWarn>
<DebugType>full</DebugType>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>CSLA.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>false</DebugSymbols>
<Optimize>true</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032</NoWarn>
<DebugType>none</DebugType>
</PropertyGroup>
<ItemGroup>
<Reference Include="System">
<Name>System</Name>
</Reference>
<Reference Include="System.configuration" />
<Reference Include="System.Data">
<Name>System.Data</Name>
</Reference>
<Reference Include="System.Runtime.Remoting">
<Name>System.Runtime.Remoting</Name>
</Reference>
<Reference Include="System.Xml">
<Name>System.XML</Name>
</Reference>
<ProjectReference Include="..\..\Data\Data\GZTW.Data.csproj">
<Name>GZTW.Data</Name>
<Project>{701893AA-C042-4FB2-8643-E139372C1117}</Project>
<Package>{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}</Package>
<Private>False</Private>
</ProjectReference>
<ProjectReference Include="..\..\Profile\GZTW.Profile\GZTW.Profile.csproj">
<Name>GZTW.Profile</Name>
<Project>{EDE897E2-E2E6-441D-9F83-0B973AE09670}</Project>
<Package>{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}</Package>
<Private>False</Private>
</ProjectReference>
<ProjectReference Include="..\CSLA.Core.Bindablebase\CSLA.Core.Bindablebase.csproj">
<Name>CSLA.Core.Bindablebase</Name>
<Project>{C2392355-12A9-4197-A1D3-603C390B1E62}</Project>
<Package>{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}</Package>
<Private>False</Private>
</ProjectReference>
<ProjectReference Include="..\CSLA.Server.DataPortal\CSLA.Server.DataPortal.vbproj">
<Name>CSLA.Server.DataPortal</Name>
<Project>{80828E2C-E9FB-4E73-A27C-7F9CDB96FCDE}</Project>
<Package>{F184B08F-C81C-45F6-A57F-5ABD9991F28F}</Package>
<Private>False</Private>
</ProjectReference>
<ProjectReference Include="..\CSLA.Server.ServicedDataPortal\CSLA.Server.ServicedDataPortal.vbproj">
<Name>CSLA.Server.ServicedDataPortal</Name>
<Project>{AD60DF60-2D14-4403-B5A8-41D4E06AB7AD}</Project>
<Package>{F184B08F-C81C-45F6-A57F-5ABD9991F28F}</Package>
<Private>False</Private>
</ProjectReference>
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
</ItemGroup>
<ItemGroup>
<Compile Include="AssemblyInfo.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="BrokenRules.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="BusinessBase.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="BusinessCollectionBase.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="BusinessIdentity.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="BusinessPrincipal.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="DataPortal.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="NameValueList.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="NotUndoableAttribute.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="ObjectAdapter.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="ReadOnlyBase.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="ReadOnlyCollectionBase.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="RunLocalAttribute.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="SafeDataReader.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="SmartDate.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="SortedCollectionBase.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="TransactionalAttribute.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="UndoableBase.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="ValidationException.vb">
<SubType>Code</SubType>
</Compile>
</ItemGroup>
<ItemGroup>
<Folder Include="My Project\" />
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Microsoft.VisualBasic.targets" />
<PropertyGroup>
<PreBuildEvent>
</PreBuildEvent>
<PostBuildEvent>
</PostBuildEvent>
</PropertyGroup>
</Project>

58
source/csla10/Backup/CSLA/CSLA.vbproj.user Normal file
View File

@@ -0,0 +1,58 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<LastOpenVersion>7.10.3077</LastOpenVersion>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ReferencePath>
</ReferencePath>
<CopyProjectDestinationFolder>
</CopyProjectDestinationFolder>
<CopyProjectUncPath>
</CopyProjectUncPath>
<CopyProjectOption>0</CopyProjectOption>
<ProjectView>ShowAllFiles</ProjectView>
<ProjectTrust>0</ProjectTrust>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>true</StartWithIE>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>true</StartWithIE>
</PropertyGroup>
</Project>

292
source/csla10/Backup/CSLA/DataPortal.vb Normal file
View File

@@ -0,0 +1,292 @@
Imports System.Reflection
Imports System.Runtime.Remoting
Imports System.Runtime.Remoting.Channels
Imports System.Runtime.Remoting.Channels.Http
Imports System.Configuration
''' <summary>
''' This is the client-side DataPortal as described in
''' Chapter 5.
''' </summary>
Public Class DataPortal
Private Shared mPortalRemote As Boolean = False
#Region " Data Access methods "
''' <summary>
''' Called by a factory method in a business class to create
''' a new object, which is loaded with default
''' values from the database.
''' </summary>
''' <param name="Criteria">Object-specific criteria.</param>
''' <returns>A new object, populated with default values.</returns>
Public Shared Function Create(ByVal Criteria As Object) As Object
Dim obj As Object
Dim method As MethodInfo = GetMethod(GetObjectType(Criteria), "DataPortal_Create")
Dim forceLocal As Boolean = RunLocal(method)
If IsTransactionalMethod(method) Then
obj = ServicedPortal(forceLocal).Create(Criteria, _
New Server.DataPortalContext(GetPrincipal, mPortalRemote AndAlso Not forceLocal))
Else
obj = Portal(forceLocal).Create(Criteria, _
New Server.DataPortalContext(GetPrincipal, mPortalRemote AndAlso Not forceLocal))
End If
If mPortalRemote AndAlso Not forceLocal Then
Serialization.SerializationNotification.OnDeserialized(obj)
End If
Return obj
End Function
''' <summary>
''' Called by a factory method in a business class to retrieve
''' an object, which is loaded with values from the database.
''' </summary>
''' <param name="Criteria">Object-specific criteria.</param>
''' <returns>An object populated with values from the database.</returns>
Public Shared Function Fetch(ByVal Criteria As Object) As Object
Dim obj As Object
Dim method As MethodInfo = GetMethod(GetObjectType(Criteria), "DataPortal_Fetch")
Dim forceLocal As Boolean = RunLocal(method)
If IsTransactionalMethod(method) Then
obj = ServicedPortal(forceLocal).Fetch(Criteria, _
New Server.DataPortalContext(GetPrincipal, mPortalRemote AndAlso Not forceLocal))
Else
obj = Portal(forceLocal).Fetch(Criteria, _
New Server.DataPortalContext(GetPrincipal, mPortalRemote AndAlso Not forceLocal))
End If
If mPortalRemote AndAlso Not forceLocal Then
Serialization.SerializationNotification.OnDeserialized(obj)
End If
Return obj
End Function
''' <summary>
''' Called by the <see cref="M:CSLA.BusinessBase.Save" /> method to
''' insert, update or delete an object in the database.
''' </summary>
''' <remarks>
''' Note that this method returns a reference to the updated business object.
''' If the server-side DataPortal is running remotely, this will be a new and
''' different object from the original, and all object references MUST be updated
''' to use this new object.
''' </remarks>
''' <param name="obj">A reference to the business object to be updated.</param>
''' <returns>A reference to the updated business object.</returns>
Public Shared Function Update(ByVal obj As Object) As Object
Dim updated As Object
Dim method As MethodInfo = GetMethod(obj.GetType, "DataPortal_Update")
Dim forceLocal As Boolean = RunLocal(method)
If mPortalRemote AndAlso Not forceLocal Then
Serialization.SerializationNotification.OnSerializing(obj)
End If
If IsTransactionalMethod(method) Then
updated = ServicedPortal(forceLocal).Update(obj, _
New Server.DataPortalContext(GetPrincipal, mPortalRemote))
Else
updated = Portal(forceLocal).Update(obj, _
New Server.DataPortalContext(GetPrincipal, mPortalRemote))
End If
If mPortalRemote AndAlso Not forceLocal Then
Serialization.SerializationNotification.OnSerialized(obj)
Serialization.SerializationNotification.OnDeserialized(updated)
End If
Return updated
End Function
''' <summary>
''' Called by a <c>Shared</c> method in the business class to cause
''' immediate deletion of a specific object from the database.
''' </summary>
''' <param name="Criteria">Object-specific criteria.</param>
Public Shared Sub Delete(ByVal Criteria As Object)
Dim method As MethodInfo = GetMethod(GetObjectType(Criteria), "DataPortal_Delete")
Dim forceLocal As Boolean = RunLocal(method)
If IsTransactionalMethod(method) Then
ServicedPortal(forceLocal).Delete(Criteria, _
New Server.DataPortalContext(GetPrincipal, mPortalRemote AndAlso Not forceLocal))
Else
Portal(forceLocal).Delete(Criteria, _
New Server.DataPortalContext(GetPrincipal, mPortalRemote AndAlso Not forceLocal))
End If
End Sub
#End Region
#Region " Server-side DataPortal "
Private Shared mPortal As Server.DataPortal
Private Shared mServicedPortal As Server.ServicedDataPortal.DataPortal
Private Shared mRemotePortal As Server.DataPortal
Private Shared mRemoteServicedPortal As Server.ServicedDataPortal.DataPortal
Private Shared Function Portal(ByVal forceLocal As Boolean) As Server.DataPortal
If Not forceLocal AndAlso mPortalRemote Then
' return remote instance
If mRemotePortal Is Nothing Then
mRemotePortal = CType(Activator.GetObject(GetType(Server.DataPortal), PORTAL_SERVER), _
Server.DataPortal)
End If
Return mRemotePortal
Else
' return local instance
If mPortal Is Nothing Then
mPortal = New Server.DataPortal()
End If
Return mPortal
End If
End Function
Private Shared Function ServicedPortal(ByVal forceLocal As Boolean) As Server.ServicedDataPortal.DataPortal
If Not forceLocal AndAlso mPortalRemote Then
' return remote instance
If mRemoteServicedPortal Is Nothing Then
mRemoteServicedPortal = _
CType(Activator.GetObject(GetType(Server.ServicedDataPortal.DataPortal), _
SERVICED_PORTAL_SERVER), _
Server.ServicedDataPortal.DataPortal)
End If
Return mRemoteServicedPortal
Else
' return local instance
If mServicedPortal Is Nothing Then
mServicedPortal = New Server.ServicedDataPortal.DataPortal()
End If
Return mServicedPortal
End If
End Function
Private Shared Function PORTAL_SERVER() As String
Return System.Configuration.ConfigurationManager.AppSettings("PortalServer")
End Function
Private Shared Function SERVICED_PORTAL_SERVER() As String
Return System.Configuration.ConfigurationManager.AppSettings("ServicedPortalServer")
End Function
#End Region
#Region " Security "
Private Shared Function AUTHENTICATION() As String
Return System.Configuration.ConfigurationManager.AppSettings("Authentication")
End Function
Private Shared Function GetPrincipal() As System.Security.Principal.IPrincipal
If AUTHENTICATION() = "Windows" Then
' Windows integrated security
Return Nothing
Else
' we assume using the CSLA framework security
Return System.Threading.Thread.CurrentPrincipal
End If
End Function
#End Region
#Region " Helper methods "
Private Shared Function IsTransactionalMethod(ByVal Method As MethodInfo) As Boolean
Return Attribute.IsDefined(Method, GetType(TransactionalAttribute))
'Dim attrib() As Object = Method.GetCustomAttributes(GetType(TransactionalAttribute), True)
'Return (UBound(attrib) > -1)
End Function
Private Shared Function RunLocal(ByVal Method As MethodInfo) As Boolean
Return Attribute.IsDefined(Method, GetType(RunLocalAttribute))
End Function
Private Shared 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
Private Shared Function GetObjectType(ByVal criteria As Object) As Type
If criteria.GetType.IsSubclassOf(GetType(CriteriaBase)) Then
' get the type of the actual business object
' from CriteriaBase (using the new scheme)
Return CType(criteria, CriteriaBase).ObjectType
Else
' get the type of the actual business object
' based on the nested class scheme in the book
Return criteria.GetType.DeclaringType
End If
End Function
Shared Sub New()
' see if we need to configure remoting at all
If Len(PORTAL_SERVER) > 0 OrElse Len(SERVICED_PORTAL_SERVER) > 0 Then
mPortalRemote = True
' create and register our custom HTTP channel
' that uses the binary formatter
Dim properties As New Hashtable()
properties("name") = "HttpBinary"
If AUTHENTICATION() = "Windows" Then
' make sure we pass the user's Windows credentials
' to the server
properties("useDefaultCredentials") = True
End If
Dim formatter As New BinaryClientFormatterSinkProvider()
Dim channel As New HttpChannel(properties, formatter, Nothing)
ChannelServices.RegisterChannel(channel)
'' register the data portal types as being remote
'If Len(PORTAL_SERVER) > 0 Then
' RemotingConfiguration.RegisterWellKnownClientType( _
' GetType(Server.DataPortal), PORTAL_SERVER)
'End If
'If Len(SERVICED_PORTAL_SERVER) > 0 Then
' RemotingConfiguration.RegisterWellKnownClientType( _
' GetType(Server.ServicedDataPortal.DataPortal), SERVICED_PORTAL_SERVER)
'End If
End If
End Sub
#End Region
End Class

407
source/csla10/Backup/CSLA/NameValueList.vb Normal file
View File

@@ -0,0 +1,407 @@
Imports System.Collections.Specialized
Imports System.IO
Imports System.Runtime.Serialization
Imports System.Runtime.Serialization.Formatters.Binary
Imports System.Configuration
Imports GZTW.Data
''' <summary>
''' This is a base class from which readonly name/value
''' business classes can be quickly and easily created.
''' </summary>
''' <remarks>
''' As discussed in Chapter 5, inherit from this class to
''' quickly and easily create name/value list objects for
''' population of ListBox or ComboBox controls and for
''' validation of list-based data items in your business
''' objects.
''' </remarks>
<Serializable()> _
Public MustInherit Class NameValueList
Inherits NameObjectCollectionBase
Implements ICloneable
#Region " Clone "
''' <summary>
''' Creates a clone of the object.
''' </summary>
''' <returns>A new object containing the exact data of the original object.</returns>
Public Function Clone() As Object Implements ICloneable.Clone
Dim buffer As New MemoryStream()
Dim formatter As New BinaryFormatter()
formatter.Serialize(buffer, Me)
buffer.Position = 0
Return formatter.Deserialize(buffer)
End Function
#End Region
#Region " Collection methods "
''' <summary>
''' Returns a value from the list.
''' </summary>
''' <param name="index">The positional index of the value in the collection.</param>
''' <returns>The specified value.</returns>
Default Public ReadOnly Property Item(ByVal Index As Integer) As String
Get
Return CStr(MyBase.BaseGet(Index))
End Get
End Property
''' <summary>
''' Returns a value from the list.
''' </summary>
''' <param name="Name">The name of the value.</param>
''' <returns>The specified value.</returns>
Default Public ReadOnly Property Item(ByVal Name As String) As String
Get
Return CStr(MyBase.BaseGet(Name))
End Get
End Property
''' <summary>
''' Adds a name/value pair to the list.
''' </summary>
''' <param name="Name">The name of the item.</param>
''' <param name="Value">The value to be added.</param>
Protected Sub Add(ByVal Name As String, ByVal Value As String)
MyBase.BaseAdd(Name, Value)
End Sub
''' <summary>
''' Returns the first name found in the list with the specified
''' value.
''' </summary>
''' <remarks>
''' This method throws an exception if no matching value is found
''' in the list.
''' </remarks>
''' <param name="Item">The value to search for in the list.</param>
''' <returns>The name of the item found.</returns>
Public ReadOnly Property Key(ByVal Item As String) As String
Get
Dim keyName As String
For Each keyName In Me
If Me.Item(keyName) = Item Then
Return keyName
End If
Next
' we didn't find a match - throw an exception
Throw New ApplicationException("No matching item in collection")
End Get
End Property
#End Region
#Region " Create and Load "
''' <summary>
''' Creates a new NameValueList.
''' </summary>
Protected Sub New()
' prevent public creation
End Sub
''' <summary>
''' Creates a new NameValueList.
''' </summary>
Protected Sub New(ByVal info As SerializationInfo, _
ByVal context As StreamingContext)
MyBase.New(info, context)
End Sub
#End Region
#Region " Data Access "
Private Sub DataPortal_Create(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - create not allowed")
End Sub
''' <summary>
''' Override this method to allow retrieval of an existing business
''' object based on data in the database.
''' </summary>
''' <remarks>
''' In many cases you can call the SimpleFetch method to
''' retrieve simple name/value data from a single table in
''' a database. In more complex cases you may need to implement
''' your own data retrieval code using ADO.NET.
''' </remarks>
''' <param name="Criteria">An object containing criteria values to identify the object.</param>
Protected Overridable Sub DataPortal_Fetch(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - fetch not allowed")
End Sub
Private Sub DataPortal_Update()
Throw New NotSupportedException("Invalid operation - update not allowed")
End Sub
Private Sub DataPortal_Delete(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - delete not allowed")
End Sub
''' <summary>
''' Returns the specified database connection string from the application
''' configuration file.
''' </summary>
''' <remarks>
''' The database connection string must be in the <c>appSettings</c> section
''' of the application configuration file. The database name should be
''' prefixed with 'DB:'. For instance, <c>DB:mydatabase</c>.
''' </remarks>
''' <param name="DatabaseName">Name of the database.</param>
''' <returns>A database connection string.</returns>
Protected Function DB(ByVal DatabaseName As String) As String
Return System.Configuration.ConfigurationManager.AppSettings("DB:" & DatabaseName)
End Function
''' <summary>
''' Provides default/simple loading for most lists.
''' It is called to load data from the database
''' </summary>
''' <param name="dbase">
''' The DAL database to read
''' </param>
''' <param name="TableName">The name of the table to read.</param>
''' <param name="NameColumn">The name of the column containing name or key values.</param>
''' <param name="ValueColumn">The name of the column containing data values.</param>
Protected Sub SimpleFetch(ByVal dbase As GZTWDatabase, ByVal TableName As String, ByVal NameColumn As String, ByVal ValueColumn As String)
Dim dbcw As DBCommandWrapper
dbcw = dbase.GetSqlStringCommandWrapper("SELECT " & NameColumn & "," & ValueColumn & " FROM " & TableName)
Dim dr As New Data.SafeDataReader(dbase.ExecuteReader(dbcw))
Try
While dr.Read()
Add(CStr(dr.GetValue(0)), CStr(dr.GetValue(1)))
End While
Finally
dr.Close()
End Try
End Sub
''' <summary>
''' Provides default/simple loading for most lists.
''' It is called to load data from the database
''' Customized by JOHN - Modified version to deal with GUID as id column
''' </summary>
''' <param name="dbase">
''' The DAL database to read
''' </param>
''' <param name="TableName">The name of the table to read.</param>
''' <param name="NameColumn">The name of the column containing name or key values.</param>
''' <param name="ValueColumn">The name of the column containing data values.</param>
Protected Sub SimpleFetchG(ByVal dbase As GZTWDatabase, ByVal TableName As String, ByVal NameColumn As String, ByVal ValueColumn As String)
Dim dbcw As DBCommandWrapper
dbcw = dbase.GetSqlStringCommandWrapper("SELECT " & NameColumn & "," & ValueColumn & " FROM " & TableName)
Dim dr As New Data.SafeDataReader(dbase.ExecuteReader(dbcw))
Try
While dr.Read()
'Modified to accept a Guid as the id value
'NVCHANGED
Add(dr.GetGuid(1).ToString(), CStr(dr.GetValue(0)))
End While
Finally
dr.Close()
End Try
End Sub
''' <summary>
''' Same as SimpleFetchG, but only loads records with Active=true
'''
''' Provides default/simple loading for most lists.
''' It is called to load data from the database
''' Customized by JOHN - Modified version to deal with GUID as id column
''' </summary>
''' <param name="dbase">
''' The DAL database to read
''' </param>
''' <param name="TableName">The name of the table to read.</param>
''' <param name="NameColumn">The name of the column containing name or key values.</param>
''' <param name="ValueColumn">The name of the column containing data values.</param>
Protected Sub SimpleFetchGActiveOnly(ByVal dbase As GZTWDatabase, ByVal TableName As String, ByVal NameColumn As String, ByVal ValueColumn As String)
Dim dbcw As DBCommandWrapper
dbcw = dbase.GetSqlStringCommandWrapper("SELECT " & NameColumn & "," & ValueColumn & " FROM " & TableName & " WHERE AACTIVE=@aTrue")
dbcw.AddInParameter("@aTrue", DbType.Boolean, True)
Dim dr As New Data.SafeDataReader(dbase.ExecuteReader(dbcw))
Try
While dr.Read()
'Modified to accept a Guid as the id value
'NVCHANGED
Add(dr.GetGuid(1).ToString(), CStr(dr.GetValue(0)))
End While
Finally
dr.Close()
End Try
End Sub
''' <summary>
''' Loads name value list based on passed sql query text
''' Customized by JOHN - Modified version to deal with GUID as id column
''' and to allow passing in a string to specify sql
''' </summary>
''' <param name="dbase">
''' The DAL database to read
''' </param>
''' <param name="SQLText">The sql query to run. **MUST return the name as the first parameter
''' And a GUID value as the second parameter, anything else is indeterminate</param>
Protected Sub SQLFetchG(ByVal dbase As GZTWDatabase, ByVal SQLText As String)
Dim dbcw As DBCommandWrapper
dbcw = dbase.GetSqlStringCommandWrapper(SQLText)
Dim dr As New Data.SafeDataReader(dbase.ExecuteReader(dbcw))
Try
While dr.Read()
'Modified to accept a Guid as the id value
'NVCHANGED
Add(dr.GetGuid(0).ToString(), CStr(dr.GetValue(1)))
End While
Finally
dr.Close()
End Try
End Sub
''' <summary>
''' Loads name value list based on passed sql stored procedure name
''' Customized by JOHN - Modified version to deal with GUID as id column
''' and to allow passing in a string to specify sql
''' </summary>
''' <param name="DataBaseName">
''' The name of the database to read. This database name
''' must correspond to a database entry in the application
''' configuration file.
''' </param>
''' <param name="StoredProcedure">The sql stored procedure query to run. **MUST return the name as the first parameter
''' And a GUID value as the second parameter, anything else is indeterminate</param>
'Protected Sub SPFetchG(ByVal DataBaseName As String, ByVal StoredProcedure As String)
' Dim cn As New SqlConnection(DB(DataBaseName))
' Dim cm As New SqlCommand
' cn.Open()
' Try
' With cm
' .Connection = cn
' .CommandType = CommandType.StoredProcedure
' .CommandText = StoredProcedure
' Dim dr As New Data.SafeDataReader(.ExecuteReader)
' Try
' While dr.Read()
' 'Modified to accept a Guid as the id value
' Add(CStr(dr.GetValue(0)), dr.GetGuid(1).ToString())
' End While
' Finally
' dr.Close()
' End Try
' End With
' Finally
' cn.Close()
' End Try
'End Sub
''' <summary>
''' Loads name value list based on passed sql query text
''' Customized by JOHN - to allow passing in a string to specify sql
''' </summary>
''' <param name="dbase">
''' The DAL database to read
''' </param>
''' <param name="SQLText">The sql query to run. **MUST return the name as the first parameter
''' And a string value as the second parameter, anything else is indeterminate</param>
Protected Sub SQLFetch(ByVal dbase As GZTWDatabase, ByVal SQLText As String)
Dim dbcw As DBCommandWrapper
dbcw = dbase.GetSqlStringCommandWrapper(SQLText)
Dim dr As New Data.SafeDataReader(dbase.ExecuteReader(dbcw))
Try
While dr.Read()
Add(CStr(dr.GetValue(0)), CStr(dr.GetValue(1)))
End While
Finally
dr.Close()
End Try
'Before DAL WAS:
'Dim cn As New SqlConnection(DB(DataBaseName))
'Dim cm As New SqlCommand
'cn.Open()
'Try
' With cm
' .Connection = cn
' .CommandText = SQLText
' Dim dr As New Data.SafeDataReader(.ExecuteReader)
' Try
' While dr.Read()
' 'Modified to accept a Guid as the id value
' Add(CStr(dr.GetValue(0)), CStr(dr.GetValue(1)))
' End While
' Finally
' dr.Close()
' End Try
' End With
'Finally
' cn.Close()
'End Try
End Sub
#End Region
#Region " Binding "
'Customized by John for combo list
Private FBindableList As ArrayList
ReadOnly Property BindableList() As ArrayList
Get
If FBindableList Is Nothing Then
FBindableList = New ArrayList
For Each cKey As String In Me.Keys
FBindableList.Add(New DictionaryEntry(cKey, Me.Item(cKey)))
Next
End If
Return FBindableList
End Get
End Property
#End Region
End Class

14
source/csla10/Backup/CSLA/NotUndoableAttribute.vb Normal file
View File

@@ -0,0 +1,14 @@
''' <summary>
''' Allows us to mark fields that should not be copied as part of the undo process
''' </summary>
''' <remarks>
''' Marking a variable with this attribute will cause the n-level
''' undo process to ignore that variable's value. The value will
''' not be included in a snapshot when BeginEdit is called, nor
''' will it be restored when CancelEdit is called.
''' </remarks>
<AttributeUsage(AttributeTargets.Field)> _
Public Class NotUndoableAttribute
Inherits Attribute
End Class

276
source/csla10/Backup/CSLA/ObjectAdapter.vb Normal file
View File

@@ -0,0 +1,276 @@
Imports System.ComponentModel
Imports System.Reflection
''' <summary>
'''
''' </summary>
Namespace Data
''' <summary>
''' An ObjectAdapter is used to convert data in an object
''' or collection into a DataTable.
''' </summary>
Public Class ObjectAdapter
Private mColumns As New ArrayList
''' <summary>
''' Fills the DataSet with data from an object or collection.
''' </summary>
''' <remarks>
''' The name of the DataTable being filled is will be the class name of
''' the object acting as the data source. The
''' DataTable will be inserted if it doesn't already exist in the DataSet.
''' </remarks>
''' <param name="ds">A reference to the DataSet to be filled.</param>
''' <param name="source">A reference to the object or collection acting as a data source.</param>
Public Sub Fill(ByVal ds As DataSet, ByVal source As Object)
Dim className As String
className = TypeName(source)
Fill(ds, className, source)
End Sub
''' <summary>
''' Fills the DataSet with data from an object or collection.
''' </summary>
''' <remarks>
''' The name of the DataTable being filled is specified as a parameter. The
''' DataTable will be inserted if it doesn't already exist in the DataSet.
''' </remarks>
''' <param name="ds">A reference to the DataSet to be filled.</param>
''' <param name="TableName"></param>
''' <param name="source">A reference to the object or collection acting as a data source.</param>
Public Sub Fill(ByVal ds As DataSet, _
ByVal TableName As String, ByVal source As Object)
Dim dt As DataTable
Dim exists As Boolean
dt = ds.Tables(TableName)
exists = Not dt Is Nothing
If Not exists Then
dt = New DataTable(TableName)
End If
Fill(dt, source)
If Not exists Then
ds.Tables.Add(dt)
End If
End Sub
''' <summary>
''' Fills a DataTable with data values from an object or collection.
''' </summary>
''' <param name="dt">A reference to the DataTable to be filled.</param>
''' <param name="source">A reference to the object or collection acting as a data source.</param>
Public Sub Fill(ByVal dt As DataTable, ByVal source As Object)
AutoDiscover(source)
DataCopy(dt, source)
End Sub
#Region " Data Copy "
Private Sub DataCopy(ByVal dt As DataTable, ByVal source As Object)
If source Is Nothing Then Exit Sub
If mColumns.Count < 1 Then Exit Sub
If TypeOf source Is IListSource Then
DataCopyIList(dt, CType(source, IListSource).GetList)
ElseIf TypeOf source Is IList Then
DataCopyIList(dt, CType(source, IList))
Else
' they gave us a regular object - create a list
Dim col As New ArrayList
col.Add(source)
DataCopyIList(dt, CType(col, IList))
End If
End Sub
Private Sub DataCopyIList(ByVal dt As DataTable, ByVal ds As IList)
Dim index As Integer
Dim column As String
Dim item As String
' create columns if needed
For Each column In mColumns
If Not dt.Columns.Contains(column) Then
dt.Columns.Add(column)
End If
Next
' load the data into the control
dt.BeginLoadData()
For index = 0 To ds.Count - 1
Dim dr As DataRow = dt.NewRow
For Each column In mColumns
Try
dr(column) = GetField(ds(index), column)
Catch ex As Exception
dr(column) = ex.Message
End Try
Next
dt.Rows.Add(dr)
Next
dt.EndLoadData()
End Sub
#End Region
#Region " AutoDiscover "
Private Sub AutoDiscover(ByVal source As Object)
Dim innerSource As Object
If TypeOf source Is IListSource Then
innerSource = CType(source, IListSource).GetList
Else
innerSource = source
End If
mColumns.Clear()
If TypeOf innerSource Is DataView Then
ScanDataView(CType(innerSource, DataView))
ElseIf TypeOf innerSource Is IList Then
ScanIList(CType(innerSource, IList))
Else
' they gave us a regular object
ScanObject(innerSource)
End If
End Sub
Private Sub ScanDataView(ByVal ds As DataView)
Dim field As Integer
For field = 0 To ds.Table.Columns.Count - 1
mColumns.Add(ds.Table.Columns(field).ColumnName)
Next
End Sub
Private Sub ScanIList(ByVal ds As IList)
If ds.Count > 0 Then
' retrieve the first item from the list
Dim obj As Object = ds.Item(0)
If TypeOf obj Is ValueType AndAlso obj.GetType.IsPrimitive Then
' the value is a primitive value type
mColumns.Add("Value")
ElseIf TypeOf obj Is String Then
' the value is a simple string
mColumns.Add("Text")
Else
' we have a complex Structure or object
ScanObject(obj)
End If
End If
End Sub
Private Sub ScanObject(ByVal Source As Object)
Dim SourceType As Type = Source.GetType
Dim column As Integer
' retrieve a list of all public properties
Dim props As PropertyInfo() = SourceType.GetProperties()
If UBound(props) >= 0 Then
For column = 0 To UBound(props)
If props(column).CanRead Then
mColumns.Add(props(column).Name)
End If
Next
End If
' retrieve a list of all public fields
Dim fields As FieldInfo() = SourceType.GetFields()
If UBound(fields) >= 0 Then
For column = 0 To UBound(fields)
mColumns.Add(fields(column).Name)
Next
End If
End Sub
#End Region
#Region " GetField "
Private Function GetField(ByVal obj As Object, ByVal FieldName As String) As String
If TypeOf obj Is DataRowView Then
' this is a DataRowView from a DataView
Return CType(obj, DataRowView).Item(FieldName).ToString
ElseIf TypeOf obj Is ValueType AndAlso obj.GetType.IsPrimitive Then
' this is a primitive value type
Return obj.ToString
ElseIf TypeOf obj Is String Then
' this is a simple string
Return CStr(obj)
Else
' this is an object or Structure
Try
Dim sourcetype As Type = obj.GetType
' see if the field is a property
Dim prop As PropertyInfo = sourcetype.GetProperty(FieldName)
If prop Is Nothing OrElse Not prop.CanRead Then
' no readable property of that name exists - check for a field
Dim field As FieldInfo = sourcetype.GetField(FieldName)
If field Is Nothing Then
' no field exists either, throw an exception
Throw New System.Data.DataException( _
"No such value exists: " & FieldName)
Else
' got a field, return its value
Return field.GetValue(obj).ToString
End If
Else
' found a property, return its value
Return prop.GetValue(obj, Nothing).ToString
End If
Catch ex As Exception
Throw New System.Data.DataException( _
"Error reading value: " & FieldName, ex)
End Try
End If
End Function
#End Region
End Class
End Namespace

177
source/csla10/Backup/CSLA/ReadOnlyBase.vb Normal file
View File

@@ -0,0 +1,177 @@
Imports System.IO
Imports System.Runtime.Serialization.Formatters.Binary
Imports System.Configuration
Imports System.Reflection
''' <summary>
''' This is a base class from which readonly business classes
''' can be derived.
''' </summary>
''' <remarks>
''' This base class only supports data retrieve, not updating or
''' deleting. Any business classes derived from this base class
''' should only implement readonly properties.
''' </remarks>
<Serializable()> _
Public MustInherit Class ReadOnlyBase
Implements ICloneable
Implements Serialization.ISerializationNotification
#Region " Clone "
''' <summary>
''' Creates a clone of the object.
''' </summary>
''' <returns>A new object containing the exact data of the original object.</returns>
Public Function Clone() As Object Implements ICloneable.Clone
Dim buffer As New MemoryStream()
Dim formatter As New BinaryFormatter()
Serialization.SerializationNotification.OnSerializing(Me)
formatter.Serialize(buffer, Me)
Serialization.SerializationNotification.OnSerialized(Me)
buffer.Position = 0
Dim temp As Object = formatter.Deserialize(buffer)
Serialization.SerializationNotification.OnDeserialized(temp)
Return temp
End Function
#End Region
#Region " Data Access "
Private Sub DataPortal_Create(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - create not allowed")
End Sub
''' <summary>
''' Override this method to allow retrieval of an existing business
''' object based on data in the database.
''' </summary>
''' <param name="Criteria">An object containing criteria values to identify the object.</param>
Protected Overridable Sub DataPortal_Fetch(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - fetch not allowed")
End Sub
Private Sub DataPortal_Update()
Throw New NotSupportedException("Invalid operation - update not allowed")
End Sub
Private Sub DataPortal_Delete(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - delete not allowed")
End Sub
''' <summary>
''' Returns the specified database connection string from the application
''' configuration file.
''' </summary>
''' <remarks>
''' The database connection string must be in the <c>appSettings</c> section
''' of the application configuration file. The database name should be
''' prefixed with 'DB:'. For instance, <c>DB:mydatabase</c>.
''' </remarks>
''' <param name="DatabaseName">Name of the database.</param>
''' <returns>A database connection string.</returns>
Protected Function DB(ByVal DatabaseName As String) As String
Return System.Configuration.ConfigurationManager.AppSettings("DB:" & DatabaseName)
End Function
#End Region
#Region " ISerializationNotification "
''' <summary>
''' This method is called on a newly deserialized object
''' after deserialization is complete.
''' </summary>
Protected Overridable Sub Deserialized() _
Implements CSLA.Serialization.ISerializationNotification.Deserialized
' now cascade the call to all child objects/collections
Dim fields() As FieldInfo
Dim field As FieldInfo
' get the list of fields in this type
fields = Me.GetType.GetFields( _
BindingFlags.NonPublic Or _
BindingFlags.Instance Or _
BindingFlags.Public)
For Each field In fields
If Not field.FieldType.IsValueType AndAlso _
Not Attribute.IsDefined(field, GetType(NotUndoableAttribute)) Then
' it's a ref type, so check for ISerializationNotification
Dim value As Object = field.GetValue(Me)
If TypeOf value Is Serialization.ISerializationNotification Then
DirectCast(value, Serialization.ISerializationNotification).Deserialized()
End If
End If
Next
End Sub
''' <summary>
''' This method is called on the original instance of the
''' object after it has been serialized.
''' </summary>
Protected Overridable Sub Serialized() _
Implements CSLA.Serialization.ISerializationNotification.Serialized
' cascade the call to all child objects/collections
Dim fields() As FieldInfo
Dim field As FieldInfo
' get the list of fields in this type
fields = Me.GetType.GetFields( _
BindingFlags.NonPublic Or _
BindingFlags.Instance Or _
BindingFlags.Public)
For Each field In fields
If Not field.FieldType.IsValueType AndAlso _
Not Attribute.IsDefined(field, GetType(NotUndoableAttribute)) Then
' it's a ref type, so check for ISerializationNotification
Dim value As Object = field.GetValue(Me)
If TypeOf value Is Serialization.ISerializationNotification Then
DirectCast(value, Serialization.ISerializationNotification).Serialized()
End If
End If
Next
End Sub
''' <summary>
''' This method is called before an object is serialized.
''' </summary>
Protected Overridable Sub Serializing() _
Implements CSLA.Serialization.ISerializationNotification.Serializing
' cascade the call to all child objects/collections
Dim fields() As FieldInfo
Dim field As FieldInfo
' get the list of fields in this type
fields = Me.GetType.GetFields( _
BindingFlags.NonPublic Or _
BindingFlags.Instance Or _
BindingFlags.Public)
For Each field In fields
If Not field.FieldType.IsValueType AndAlso _
Not Attribute.IsDefined(field, GetType(NotUndoableAttribute)) Then
' it's a ref type, so check for ISerializationNotification
Dim value As Object = field.GetValue(Me)
If TypeOf value Is Serialization.ISerializationNotification Then
DirectCast(value, Serialization.ISerializationNotification).Serializing()
End If
End If
Next
End Sub
#End Region
End Class

214
source/csla10/Backup/CSLA/ReadOnlyCollectionBase.vb Normal file
View File

@@ -0,0 +1,214 @@
Imports System.IO
Imports System.Runtime.Serialization.Formatters.Binary
Imports System.Configuration
''AyaNova Imports
Imports System.Threading
Imports CSLA.Security
''' <summary>
''' This is the base class from which readonly collections
''' of readonly objects should be derived.
''' </summary>
<Serializable()> _
Public MustInherit Class ReadOnlyCollectionBase
Inherits CSLA.Core.SortableCollectionBase
Implements ICloneable
Implements Serialization.ISerializationNotification
''' <summary>
''' Creates a new ReadOnlyCollectionBase object.
''' </summary>
Public Sub New()
AllowEdit = False
AllowNew = False
AllowRemove = False
End Sub
#Region " Remove, Clear, Set "
''' <summary>
''' Indicates that the collection is locked, so insert, remove
''' and change operations are disallowed.
''' </summary>
Protected Locked As Boolean = True
''' <summary>
''' Prevents insertion of new items into the collection when the
''' collection is locked.
''' </summary>
Protected Overrides Sub OnInsert(ByVal index As Integer, ByVal value As Object)
If Not ActivelySorting AndAlso Locked Then
Throw New NotSupportedException("Insert is invalid for a read-only collection")
End If
End Sub
''' <summary>
''' Prevents removal of items from the collection when the
''' collection is locked.
''' </summary>
Protected Overrides Sub OnRemove(ByVal index As Integer, ByVal value As Object)
If Not ActivelySorting AndAlso Locked Then
Throw New NotSupportedException("Remove is invalid for a read-only collection")
End If
End Sub
''' <summary>
''' Prevents clearing the collection when the
''' collection is locked.
''' </summary>
Protected Overrides Sub OnClear()
If Not ActivelySorting AndAlso Locked Then
Throw New NotSupportedException("Clear is invalid for a read-only collection")
End If
End Sub
''' <summary>
''' Prevents changing an item reference when the
''' collection is locked.
''' </summary>
Protected Overrides Sub OnSet(ByVal index As Integer, ByVal oldValue As Object, ByVal newValue As Object)
If Not ActivelySorting AndAlso Locked Then
Throw New NotSupportedException("Items can not be changed in a read-only collection")
End If
End Sub
#End Region
#Region " Clone "
''' <summary>
''' Creates a clone of the object.
''' </summary>
''' <returns>A new object containing the exact data of the original object.</returns>
Public Function Clone() As Object Implements ICloneable.Clone
Dim buffer As New MemoryStream()
Dim formatter As New BinaryFormatter()
Serialization.SerializationNotification.OnSerializing(Me)
formatter.Serialize(buffer, Me)
Serialization.SerializationNotification.OnSerialized(Me)
buffer.Position = 0
Dim temp As Object = formatter.Deserialize(buffer)
Serialization.SerializationNotification.OnDeserialized(temp)
Return temp
End Function
#End Region
#Region " Data Access "
Private Sub DataPortal_Create(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - create not allowed")
End Sub
''' <summary>
''' Override this method to allow retrieval of an existing business
''' object based on data in the database.
''' </summary>
''' <param name="Criteria">An object containing criteria values to identify the object.</param>
Protected Overridable Sub DataPortal_Fetch(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - fetch not allowed")
End Sub
Private Sub DataPortal_Update()
Throw New NotSupportedException("Invalid operation - update not allowed")
End Sub
Private Sub DataPortal_Delete(ByVal Criteria As Object)
Throw New NotSupportedException("Invalid operation - delete not allowed")
End Sub
''' <summary>
''' Returns the specified database connection string from the application
''' configuration file.
''' </summary>
''' <remarks>
''' The database connection string must be in the <c>appSettings</c> section
''' of the application configuration file. The database name should be
''' prefixed with 'DB:'. For instance, <c>DB:mydatabase</c>.
''' </remarks>
''' <param name="DatabaseName">Name of the database.</param>
''' <returns>A database connection string.</returns>
Protected Function DB(ByVal DatabaseName As String) As String
Return System.Configuration.ConfigurationManager.AppSettings("DB:" & DatabaseName)
End Function
#End Region
#Region " ISerializationNotification "
''' <summary>
''' This method is called on a newly deserialized object
''' after deserialization is complete.
''' </summary>
Protected Overridable Sub Deserialized() _
Implements CSLA.Serialization.ISerializationNotification.Deserialized
Dim child As Object
For Each child In list
If TypeOf child Is Serialization.ISerializationNotification Then
DirectCast(child, Serialization.ISerializationNotification).Deserialized()
End If
Next
End Sub
''' <summary>
''' This method is called on the original instance of the
''' object after it has been serialized.
''' </summary>
Protected Overridable Sub Serialized() _
Implements CSLA.Serialization.ISerializationNotification.Serialized
Dim child As Object
For Each child In list
If TypeOf child Is Serialization.ISerializationNotification Then
DirectCast(child, Serialization.ISerializationNotification).Serialized()
End If
Next
End Sub
''' <summary>
''' This method is called before an object is serialized.
''' </summary>
Protected Overridable Sub Serializing() _
Implements CSLA.Serialization.ISerializationNotification.Serializing
Dim child As Object
For Each child In list
If TypeOf child Is Serialization.ISerializationNotification Then
DirectCast(child, Serialization.ISerializationNotification).Serializing()
End If
Next
End Sub
#End Region
#Region "AyaNova related convenience items"
''Get the user object so
''we can check rights / get ID value
Public ReadOnly Property CurrentUserID() As Guid
Get
Dim CurrentUser As Security.BusinessPrincipal = CType(Thread.CurrentPrincipal, BusinessPrincipal)
Return CurrentUser.ID
End Get
End Property
'' Get security access right level from current identity
Public Function GetRight(ByVal RightName As String) As Int32
Return CType(Thread.CurrentPrincipal, BusinessPrincipal).Right(RightName)
End Function
#End Region
End Class

34
source/csla10/Backup/CSLA/RunLocalAttribute.vb Normal file
View File

@@ -0,0 +1,34 @@
''' <summary>
''' Allows us to mark DataPortal_xxx methods to
''' be run on the client even if the server-side
''' DataPortal is configured for remote use.
''' </summary>
''' <remarks>
''' <para>
''' The primary purpose for this attribute is to
''' mark DataPortal_Create to run locally in the case
''' where we don't need to load default values
''' from the database as the object is being created.
''' </para><para>
''' By running DataPortal_Create locally we avoid all
''' the network overhead of going to the server for
''' no purpose.
''' </para><para>
''' <b>Note that if you DO need to actually interact with
''' the database in your DataPortal_xxx method you SHOULD
''' NOT apply this attribute to your DataPortal_xxx method!</b>
''' </para><para>
''' Also note that if you apply this attribute and the
''' Transactional attribute to the same method, you MUST
''' register the ServicedDataPortal DLL with COM+ on the
''' client machine or you'll get a runtime failure. The
''' exception to this is if the user is an administrator
''' on the client machine, in which case Enterprise Services
''' will automatically register the DLL with COM+.
''' </para>
''' </remarks>
<AttributeUsage(AttributeTargets.Method)> _
Public Class RunLocalAttribute
Inherits Attribute
End Class

592
source/csla10/Backup/CSLA/SafeDataReader.vb Normal file
View File

@@ -0,0 +1,592 @@
Imports System.Data
''' <summary>
'''
''' </summary>
Namespace Data
''' <summary>
''' This is a DataReader that 'fixes' any null values before
''' they are returned to our business code.
''' </summary>
<Serializable()> _
Public Class SafeDataReader
Implements IDataReader
Private mDataReader As IDataReader
Private mIndex As Integer = -1
''' <summary>
''' Initializes the SafeDataReader object to use data from
''' the provided DataReader object.
''' </summary>
''' <param name="DataReader">The source DataReader object containing the data.</param>
Public Sub New(ByVal DataReader As IDataReader)
mDataReader = DataReader
End Sub
''' <summary>
''' Gets a string value from the datareader.
''' </summary>
''' <remarks>
''' Returns empty string for null.
''' </remarks>
Public Function GetString(ByVal i As Integer) As String Implements IDataReader.GetString
If mDataReader.IsDBNull(i) Then
Return ""
Else
Return mDataReader.GetString(i)
End If
End Function
''' <summary>
''' Gets a string value from the datareader.
''' </summary>
''' <remarks>
''' Returns "" for null.
''' </remarks>
Public Function GetString(ByVal Name As String) As String
'Changed: 21-March-2006 added toupper to all Me.GetOrdinal in this file
'to fix problem with norwegian aA combination as in AACTIVE etc
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetString(mIndex)
End Function
''' <summary>
''' Gets a value of type <see cref="System.Object" /> from the datareader.
''' </summary>
''' <remarks>
''' Returns Nothing for null.
''' </remarks>
Public Function GetValue(ByVal i As Integer) As Object Implements IDataReader.GetValue
If mDataReader.IsDBNull(i) Then
Return Nothing
Else
Return mDataReader.GetValue(i)
End If
End Function
''' <summary>
''' Gets a value of type <see cref="System.Object" /> from the datareader.
''' </summary>
''' <remarks>
''' Returns Nothing for null.
''' </remarks>
Public Function GetValue(ByVal Name As String) As Object
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetValue(mIndex)
End Function
''' <summary>
''' Gets an integer from the datareader.
''' </summary>
''' <remarks>
''' Returns 0 for null.
''' </remarks>
Public Function GetInt32(ByVal i As Integer) As Integer Implements IDataReader.GetInt32
If mDataReader.IsDBNull(i) Then
Return 0
Else
Return mDataReader.GetInt32(i)
End If
End Function
''' <summary>
''' Gets an integer from the datareader.
''' </summary>
''' <remarks>
''' Returns 0 for null.
''' </remarks>
Public Function GetInt32(ByVal Name As String) As Integer
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetInt32(mIndex)
End Function
''' <summary>
''' Gets a double from the datareader.
''' </summary>
''' <remarks>
''' Returns 0 for null.
''' </remarks>
Public Function GetDouble(ByVal i As Integer) As Double Implements IDataReader.GetDouble
If mDataReader.IsDBNull(i) Then
Return 0
Else
Return mDataReader.GetDouble(i)
End If
End Function
''' <summary>
''' Gets a double from the datareader.
''' </summary>
''' <remarks>
''' Returns 0 for null.
''' </remarks>
Public Function GetDouble(ByVal Name As String) As Double
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetDouble(mIndex)
End Function
''' <summary>
''' Gets a <see cref="T:CSLA.SmartDate" /> from the datareader.
''' </summary>
''' <remarks>
''' A null is converted into the min possible date
''' See Chapter 5 for more details on the SmartDate class.
''' </remarks>
''' <param name="i">The column number within the datareader.</param>
Public Function GetSmartDate(ByVal i As Integer) As SmartDate
If mDataReader.IsDBNull(i) Then
Return New SmartDate(True)
Else
Return New SmartDate(mDataReader.GetDateTime(i), True)
End If
End Function
''' <summary>
''' Gets a <see cref="T:CSLA.SmartDate" /> from the datareader.
''' </summary>
''' <remarks>
''' A null is converted into either the min or max possible date
''' depending on the MinIsEmpty parameter. See Chapter 5 for more
''' details on the SmartDate class.
''' </remarks>
''' <param name="i">The column number within the datareader.</param>
''' <param name="MinIsEmpty">A flag indicating whether the min or max value of a data means an empty date.</param>
Public Function GetSmartDate(ByVal i As Integer, ByVal MinIsEmpty As Boolean) As SmartDate
If mDataReader.IsDBNull(i) Then
Return New SmartDate(MinIsEmpty)
Else
Return New SmartDate(mDataReader.GetDateTime(i), MinIsEmpty)
End If
End Function
''' <summary>
''' Gets a <see cref="T:CSLA.SmartDate" /> from the datareader.
''' </summary>
''' <remarks>
''' A null is converted into min possible date
''' See Chapter 5 for more details on the SmartDate class.
''' </remarks>
''' <param name="i">The column number within the datareader.</param>
Public Function GetSmartDate(ByVal Name As String) As SmartDate
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetSmartDate(mIndex, True)
End Function
''' <summary>
''' Gets a <see cref="T:CSLA.SmartDate" /> from the datareader.
''' </summary>
''' <remarks>
''' A null is converted into either the min or max possible date
''' depending on the MinIsEmpty parameter. See Chapter 5 for more
''' details on the SmartDate class.
''' </remarks>
''' <param name="i">The column number within the datareader.</param>
''' <param name="MinIsEmpty">A flag indicating whether the min or max value of a data means an empty date.</param>
Public Function GetSmartDate(ByVal Name As String, ByVal MinIsEmpty As Boolean) As SmartDate
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetSmartDate(mIndex, MinIsEmpty)
End Function
''' <summary>
''' Gets a Guid value from the datareader.
''' </summary>
Public Function GetGuid(ByVal i As Integer) As Guid Implements IDataReader.GetGuid
If mDataReader.IsDBNull(i) Then
Return Guid.Empty
Else
Return mDataReader.GetGuid(i)
End If
End Function
''' <summary>
''' Gets a Guid value from the datareader.
''' </summary>
Public Function GetGuid(ByVal Name As String) As Guid
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetGuid(mIndex)
End Function
''' <summary>
''' Reads the next row of data from the datareader.
''' </summary>
Public Function Read() As Boolean Implements IDataReader.Read
Return mDataReader.Read
End Function
''' <summary>
''' Moves to the next result set in the datareader.
''' </summary>
Public Function NextResult() As Boolean Implements IDataReader.NextResult
Return mDataReader.NextResult()
End Function
''' <summary>
''' Closes the datareader.
''' </summary>
Public Sub Close() Implements IDataReader.Close
mDataReader.Close()
End Sub
''' <summary>
''' Returns the depth property value from the datareader.
''' </summary>
Public ReadOnly Property Depth() As Integer Implements System.Data.IDataReader.Depth
Get
Return mDataReader.Depth
End Get
End Property
''' <summary>
''' Calls the Dispose method on the underlying datareader.
''' </summary>
Public Sub Dispose() Implements System.IDisposable.Dispose
mDataReader.Dispose()
End Sub
''' <summary>
''' Returns the FieldCount property from the datareader.
''' </summary>
Public ReadOnly Property FieldCount() As Integer Implements System.Data.IDataReader.FieldCount
Get
Return mDataReader.FieldCount
End Get
End Property
''' <summary>
''' Gets a boolean value from the datareader.
''' </summary>
Public Function GetBoolean(ByVal i As Integer) As Boolean Implements System.Data.IDataReader.GetBoolean
If mDataReader.IsDBNull(i) Then
Return False
Else
Return mDataReader.GetBoolean(i)
End If
End Function
''' <summary>
''' Gets a boolean value from the datareader.
''' </summary>
Public Function GetBoolean(ByVal Name As String) As Boolean
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetBoolean(mIndex)
End Function
''' <summary>
''' Gets a byte value from the datareader.
''' </summary>
Public Function GetByte(ByVal i As Integer) As Byte Implements System.Data.IDataReader.GetByte
If mDataReader.IsDBNull(i) Then
Return 0
Else
Return mDataReader.GetByte(i)
End If
End Function
''' <summary>
''' Gets a byte value from the datareader.
''' </summary>
Public Function GetByte(ByVal Name As String) As Byte
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetByte(mIndex)
End Function
''' <summary>
''' Invokes the GetBytes method of the underlying datareader.
''' </summary>
Public Function GetBytes(ByVal i As Integer, ByVal fieldOffset As Long, ByVal buffer() As Byte, ByVal bufferoffset As Integer, ByVal length As Integer) As Long Implements System.Data.IDataReader.GetBytes
If mDataReader.IsDBNull(i) Then
Return 0
Else
Return mDataReader.GetBytes(i, fieldOffset, buffer, bufferoffset, length)
End If
End Function
''' <summary>
''' Invokes the GetBytes method of the underlying datareader.
''' </summary>
Public Function GetBytes(ByVal Name As String, ByVal fieldOffset As Long, ByVal buffer() As Byte, ByVal bufferoffset As Integer, ByVal length As Integer) As Long
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetBytes(mIndex, fieldOffset, buffer, bufferoffset, length)
End Function
''' <summary>
''' Gets a char value from the datareader.
''' </summary>
Public Function GetChar(ByVal i As Integer) As Char Implements System.Data.IDataReader.GetChar
If mDataReader.IsDBNull(i) Then
Return Char.MinValue
Else
Return mDataReader.GetChar(i)
End If
End Function
''' <summary>
''' Gets a char value from the datareader.
''' </summary>
Public Function GetChar(ByVal Name As String) As Char
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetChar(mIndex)
End Function
''' <summary>
''' Invokes the GetChars method of the underlying datareader.
''' </summary>
Public Function GetChars(ByVal i As Integer, ByVal fieldoffset As Long, ByVal buffer() As Char, ByVal bufferoffset As Integer, ByVal length As Integer) As Long Implements System.Data.IDataReader.GetChars
If mDataReader.IsDBNull(i) Then
Return 0
Else
Return mDataReader.GetChars(i, fieldoffset, buffer, bufferoffset, length)
End If
End Function
''' <summary>
''' Invokes the GetChars method of the underlying datareader.
''' </summary>
Public Function GetChars(ByVal Name As String, ByVal fieldoffset As Long, ByVal buffer() As Char, ByVal bufferoffset As Integer, ByVal length As Integer) As Long
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetChars(mIndex, fieldoffset, buffer, bufferoffset, length)
End Function
''' <summary>
''' Invokes the GetData method of the underlying datareader.
''' </summary>
Public Function GetData(ByVal i As Integer) As System.Data.IDataReader Implements System.Data.IDataReader.GetData
Return mDataReader.GetData(i)
End Function
''' <summary>
''' Invokes the GetData method of the underlying datareader.
''' </summary>
Public Function GetData(ByVal Name As String) As System.Data.IDataReader
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetData(mIndex)
End Function
''' <summary>
''' Invokes the GetDataTypeName method of the underlying datareader.
''' </summary>
Public Function GetDataTypeName(ByVal i As Integer) As String Implements System.Data.IDataReader.GetDataTypeName
Return mDataReader.GetDataTypeName(i)
End Function
''' <summary>
''' Invokes the GetDataTypeName method of the underlying datareader.
''' </summary>
Public Function GetDataTypeName(ByVal Name As String) As String
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetDataTypeName(mIndex)
End Function
''' <summary>
''' Gets a date value from the datareader.
''' </summary>
Public Function GetDateTime(ByVal i As Integer) As Date Implements System.Data.IDataReader.GetDateTime
If mDataReader.IsDBNull(i) Then
Return Date.MinValue
Else
Return mDataReader.GetDateTime(i)
End If
End Function
''' <summary>
''' Gets a date value from the datareader.
''' </summary>
Public Function GetDateTime(ByVal Name As String) As Date
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetDateTime(mIndex)
End Function
''' <summary>
''' Gets a decimal value from the datareader.
''' </summary>
Public Function GetDecimal(ByVal i As Integer) As Decimal Implements System.Data.IDataReader.GetDecimal
If mDataReader.IsDBNull(i) Then
Return 0
Else
Return mDataReader.GetDecimal(i)
End If
End Function
''' <summary>
''' Gets a decimal value from the datareader.
''' </summary>
Public Function GetDecimal(ByVal Name As String) As Decimal
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetDecimal(mIndex)
End Function
''' <summary>
''' Invokes the GetFieldType method of the underlying datareader.
''' </summary>
Public Function GetFieldType(ByVal i As Integer) As System.Type Implements System.Data.IDataReader.GetFieldType
Return mDataReader.GetFieldType(i)
End Function
''' <summary>
''' Invokes the GetFieldType method of the underlying datareader.
''' </summary>
Public Function GetFieldType(ByVal Name As String) As System.Type
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetFieldType(mIndex)
End Function
''' <summary>
''' Gets a Single value from the datareader.
''' </summary>
Public Function GetFloat(ByVal i As Integer) As Single Implements System.Data.IDataReader.GetFloat
If mDataReader.IsDBNull(i) Then
Return 0
Else
Return mDataReader.GetFloat(i)
End If
End Function
''' <summary>
''' Gets a Single value from the datareader.
''' </summary>
Public Function GetFloat(ByVal Name As String) As Single
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetFloat(mIndex)
End Function
''' <summary>
''' Gets a Short value from the datareader.
''' </summary>
Public Function GetInt16(ByVal i As Integer) As Short Implements System.Data.IDataReader.GetInt16
If mDataReader.IsDBNull(i) Then
Return 0
Else
Return mDataReader.GetInt16(i)
End If
End Function
''' <summary>
''' Gets a Short value from the datareader.
''' </summary>
Public Function GetInt16(ByVal Name As String) As Short
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetInt16(mIndex)
End Function
''' <summary>
''' Gets a Long value from the datareader.
''' </summary>
Public Function GetInt64(ByVal i As Integer) As Long Implements System.Data.IDataReader.GetInt64
If mDataReader.IsDBNull(i) Then
Return 0
Else
Return mDataReader.GetInt64(i)
End If
End Function
''' <summary>
''' Gets a Long value from the datareader.
''' </summary>
Public Function GetInt64(ByVal Name As String) As Long
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.GetInt64(mIndex)
End Function
''' <summary>
''' Invokes the GetName method of the underlying datareader.
''' </summary>
Public Function GetName(ByVal i As Integer) As String Implements System.Data.IDataReader.GetName
Return mDataReader.GetName(i)
End Function
''' <summary>
''' Gets an ordinal value from the datareader.
''' </summary>
Public Function GetOrdinal(ByVal name As String) As Integer Implements System.Data.IDataReader.GetOrdinal
Return mDataReader.GetOrdinal(name)
End Function
''' <summary>
''' Invokes the GetSchemaTable method of the underlying datareader.
''' </summary>
Public Function GetSchemaTable() As System.Data.DataTable Implements System.Data.IDataReader.GetSchemaTable
Return mDataReader.GetSchemaTable
End Function
''' <summary>
''' Invokes the GetValues method of the underlying datareader.
''' </summary>
Public Function GetValues(ByVal values() As Object) As Integer Implements System.Data.IDataReader.GetValues
Return mDataReader.GetValues(values)
End Function
''' <summary>
''' Returns the IsClosed property value from the datareader.
''' </summary>
Public ReadOnly Property IsClosed() As Boolean Implements System.Data.IDataReader.IsClosed
Get
Return mDataReader.IsClosed
End Get
End Property
''' <summary>
''' Invokes the IsDBNull method of the underlying datareader.
''' </summary>
Public Function IsDBNull(ByVal i As Integer) As Boolean Implements System.Data.IDataReader.IsDBNull
Return mDataReader.IsDBNull(i)
End Function
''' <summary>
''' Invokes the IsDBNull method of the underlying datareader.
''' </summary>
Public Function IsDBNull(ByVal Name As String) As Boolean
mIndex = Me.GetOrdinal(Name.ToUpper(System.Globalization.CultureInfo.InvariantCulture))
Return Me.IsDBNull(mIndex)
End Function
''' <summary>
''' Returns a value from the datareader.
''' </summary>
''' <remarks>
''' Returns Nothing if the value is null.
''' </remarks>
Default Public Overloads ReadOnly Property Item(ByVal name As String) As Object Implements System.Data.IDataReader.Item
Get
Dim value As Object = mDataReader.Item(name)
If DBNull.Value.Equals(value) Then
Return Nothing
Else
Return value
End If
End Get
End Property
''' <summary>
''' Returns a value from the datareader.
''' </summary>
''' <remarks>
''' Returns Nothing if the value is null.
''' </remarks>
Default Public Overloads ReadOnly Property Item(ByVal i As Integer) As Object Implements System.Data.IDataReader.Item
Get
If mDataReader.IsDBNull(i) Then
Return Nothing
Else
Return mDataReader.Item(i)
End If
End Get
End Property
''' <summary>
''' Returns the RecordsAffected property value from the underlying datareader.
''' </summary>
Public ReadOnly Property RecordsAffected() As Integer Implements System.Data.IDataReader.RecordsAffected
Get
Return mDataReader.RecordsAffected
End Get
End Property
End Class
End Namespace

481
source/csla10/Backup/CSLA/SmartDate.vb Normal file
View File

@@ -0,0 +1,481 @@
''' <summary>
''' Provides a date data type that understands the concept
''' of an empty date value.
''' </summary>
''' <remarks>
''' See Chapter 5 for a full discussion of the need for this
''' data type and the design choices behind it.
''' </remarks>
<Serializable()> _
Public NotInheritable Class SmartDate
Implements IComparable
Private mDate As Date
Private mEmptyIsMin As Boolean
#Region " Constructors "
''' <summary>
''' Creates a new SmartDate object.
''' </summary>
''' <remarks>
''' The SmartDate created will use the min possible
''' date to represent an empty date.
''' </remarks>
Public Sub New()
mEmptyIsMin = True
mDate = Date.MinValue
End Sub
''' <summary>
''' Creates a new SmartDate object.
''' </summary>
''' <param name="EmptyIsMin">Indicates whether an empty date is the min or max date value.</param>
Public Sub New(ByVal EmptyIsMin As Boolean)
mEmptyIsMin = EmptyIsMin
If mEmptyIsMin Then
mDate = Date.MinValue
Else
mDate = Date.MaxValue
End If
End Sub
''' <summary>
''' Creates a new SmartDate object.
''' </summary>
''' <remarks>
''' The SmartDate created will use the min possible
''' date to represent an empty date.
''' </remarks>
''' <param name="Value">The initial value of the object.</param>
Public Sub New(ByVal Value As Date)
mEmptyIsMin = True
mDate = Value
End Sub
''' <summary>
''' Creates a new SmartDate object.
''' </summary>
''' <param name="Value">The initial value of the object.</param>
''' <param name="EmptyIsMin">Indicates whether an empty date is the min or max date value.</param>
Public Sub New(ByVal Value As Date, ByVal EmptyIsMin As Boolean)
mEmptyIsMin = EmptyIsMin
mDate = Value
End Sub
''' <summary>
''' Creates a new SmartDate object.
''' </summary>
''' <remarks>
''' The SmartDate created will use the min possible
''' date to represent an empty date.
''' </remarks>
''' <param name="Value">The initial value of the object (as text).</param>
Public Sub New(ByVal Value As String)
mEmptyIsMin = True
Me.Text = Value
End Sub
''' <summary>
''' Creates a new SmartDate object.
''' </summary>
''' <param name="Value">The initial value of the object (as text).</param>
''' <param name="EmptyIsMin">Indicates whether an empty date is the min or max date value.</param>
Public Sub New(ByVal Value As String, ByVal EmptyIsMin As Boolean)
mEmptyIsMin = EmptyIsMin
Me.Text = Value
End Sub
#End Region
#Region " Text Support "
Private mFormat As String = "g" '"Short date"
''' <summary>
''' Gets or sets the format string used to format a date
''' value when it is returned as text.
''' </summary>
''' <remarks>
''' The format string should follow the requirements for the
''' Visual Basic .NET Format() statement.
''' </remarks>
''' <value>A format string.</value>
Public Property FormatString() As String
Get
Return mFormat
End Get
Set(ByVal Value As String)
mFormat = Value
End Set
End Property
''' <summary>
''' Gets or sets the date value.
''' </summary>
''' <remarks>
''' <para>
''' This property can be used to set the date value by passing a
''' text representation of the date. Any text date representation
''' that can be parsed by the .NET runtime is valid.
''' </para><para>
''' When the date value is retrieved via this property, the text
''' is formatted by using the format specified by the
''' <see cref="P:CSLA.SmartDate.FormatString" /> property. The default is the
''' "Short Date" format.
''' </para>
''' </remarks>
''' <returns></returns>
Public Property Text() As String
Get
Return DateToString(mDate, mFormat, mEmptyIsMin)
End Get
Set(ByVal Value As String)
mDate = StringToDate(Value, mEmptyIsMin)
End Set
End Property
#End Region
#Region " Date Support "
''' <summary>
''' Gets or sets the date value.
''' </summary>
Public Property [Date]() As Date
Get
Return mDate
End Get
Set(ByVal Value As Date)
mDate = Value
End Set
End Property
#End Region
#Region " System.Object overrides "
''' <summary>
''' Returns a text representation of the date value.
''' </summary>
Public Overrides Function ToString() As String
Return Me.Text
End Function
''' <summary>
''' Returns True if the objects are equal.
''' </summary>
Public Overloads Shared Function Equals(ByVal objA As Object, ByVal objB As Object) As Boolean
If TypeOf objA Is SmartDate AndAlso TypeOf objB Is SmartDate Then
Return DirectCast(objA, SmartDate).Equals(DirectCast(objB, SmartDate))
Else
Return False
End If
End Function
''' <summary>
''' Returns True if the object is equal to this SmartDate.
''' </summary>
Public Overloads Overrides Function Equals(ByVal obj As Object) As Boolean
If TypeOf obj Is SmartDate Then
Return Me.Equals(DirectCast(obj, SmartDate))
ElseIf TypeOf obj Is Date Then
Return Me.Equals(DirectCast(obj, Date))
ElseIf TypeOf obj Is String Then
Return Me.Equals(CStr(obj))
Else
Return False
End If
End Function
''' <summary>
''' Returns True if the SmartDate is equal to this SmartDate.
''' </summary>
Public Overloads Function Equals(ByVal obj As SmartDate) As Boolean
Return Me.CompareTo(obj) = 0
End Function
''' <summary>
''' Returns True if the date is equal to this SmartDate.
''' </summary>
Public Overloads Function Equals(ByVal obj As Date) As Boolean
Return Me.CompareTo(obj) = 0
End Function
''' <summary>
''' Returns True if the text (as a date) is equal to this SmartDate.
''' </summary>
Public Overloads Function Equals(ByVal obj As String) As Boolean
Return Me.CompareTo(obj) = 0
End Function
''' <summary>
''' Returns a hash code for this object.
''' </summary>
Public Overrides Function GetHashCode() As Integer
Return mDate.GetHashCode
End Function
#End Region
#Region " DBValue "
''' MODIFIED BY JOHN TO SET AS WELL AS GET from an object
''this is designed to work with an infragistics datetime editor
'that defaults to DBNull for empty dates and vb "Date" type for actualy
'date selections
''' <summary>
''' Gets / Sets a database-friendly version of the date value.
''' </summary>
''' <remarks>
''' <para>
''' If the SmartDate contains an empty date, this returns DBNull. Otherwise
''' the actual date value is returned as type Date.
''' </para><para>
''' This property is very useful when setting parameter values for
''' a Command object, since it automatically stores null values into
''' the database for empty date values.
''' </para><para>
''' When you also use the SafeDataReader and its GetSmartDate method,
''' you can easily read a null value from the database back into a
''' SmartDate object so it remains considered as an empty date value.
''' </para>
''' </remarks>
Public Property DBValue() As Object
Get
If Me.IsEmpty Then
Return DBNull.Value
Else
Return mDate
End If
End Get
Set(ByVal Value As Object)
If Value Is DBNull.Value Then
If mEmptyIsMin Then
mDate = Date.MinValue
Else
mDate = Date.MaxValue
End If
Else
mDate = CDate(Value)
End If
End Set
End Property
#End Region
#Region " Empty Dates "
''' <summary>
''' Indicates whether this object contains an empty date.
''' </summary>
''' <returns>True if the date is empty.</returns>
Public ReadOnly Property IsEmpty() As Boolean
Get
If mEmptyIsMin Then
Return mDate.Equals(Date.MinValue)
Else
Return mDate.Equals(Date.MaxValue)
End If
End Get
End Property
''' <summary>
''' Indicates whether an empty date is the min or max possible date value.
''' </summary>
''' <remarks>
''' Whether an empty date is considered to be the smallest or largest possible
''' date is only important for comparison operations. This allows you to
''' compare an empty date with a real date and get a meaningful result.
''' </remarks>
''' <returns>True if an empty date is the smallest date, False if it is the largest.</returns>
Public ReadOnly Property EmptyIsMin() As Boolean
Get
Return mEmptyIsMin
End Get
End Property
#End Region
#Region " Conversion Functions "
''' <summary>
''' Converts a text date representation into a Date value.
''' </summary>
''' <remarks>
''' An empty string is assumed to represent an empty date. An empty date
''' is returned as the MinValue of the Date datatype.
''' </remarks>
''' <param name="Value">The text representation of the date.</param>
''' <returns>A Date value.</returns>
Public Shared Function StringToDate(ByVal Value As String) As Date
Return StringToDate(Value, True)
End Function
''' <summary>
''' Converts a text date representation into a Date value.
''' </summary>
''' <remarks>
''' An empty string is assumed to represent an empty date. An empty date
''' is returned as the MinValue or MaxValue of the Date datatype depending
''' on the EmptyIsMin parameter.
''' </remarks>
''' <param name="Value">The text representation of the date.</param>
''' <param name="EmptyIsMin">Indicates whether an empty date is the min or max date value.</param>
''' <returns>A Date value.</returns>
Public Shared Function StringToDate(ByVal Value As String, ByVal EmptyIsMin As Boolean) As Date
If Len(Value) = 0 Then
If EmptyIsMin Then
Return Date.MinValue
Else
Return Date.MaxValue
End If
ElseIf IsDate(Value) Then
Return CDate(Value)
Else
Select Case LCase(Trim(Value))
Case "t", "today", "."
Return Now
Case "y", "yesterday", "-"
Return DateAdd(DateInterval.Day, -1, Now)
Case "tom", "tomorrow", "+"
Return DateAdd(DateInterval.Day, 1, Now)
Case Else
Throw New ArgumentException("String value can not be converted to a date")
End Select
End If
End Function
''' <summary>
''' Converts a date value into a text representation.
''' </summary>
''' <remarks>
''' The date is considered empty if it matches the min value for
''' the Date datatype. If the date is empty, this
''' method returns an empty string. Otherwise it returns the date
''' value formatted based on the FormatString parameter.
''' </remarks>
''' <param name="Value">The date value to convert.</param>
''' <param name="FormatString">The format string used to format the date into text.</param>
''' <returns>Text representation of the date value.</returns>
Public Shared Function DateToString(ByVal Value As Date, ByVal FormatString As String) As String
Return DateToString(Value, FormatString, True)
End Function
''' <summary>
''' Converts a date value into a text representation.
''' </summary>
''' <remarks>
''' Whether the date value is considered empty is determined by
''' the EmptyIsMin parameter value. If the date is empty, this
''' method returns an empty string. Otherwise it returns the date
''' value formatted based on the FormatString parameter.
''' </remarks>
''' <param name="Value">The date value to convert.</param>
''' <param name="FormatString">The format string used to format the date into text.</param>
''' <param name="EmptyIsMin">Indicates whether an empty date is the min or max date value.</param>
''' <returns>Text representation of the date value.</returns>
Public Shared Function DateToString(ByVal Value As Date, ByVal FormatString As String, ByVal EmptyIsMin As Boolean) As String
If EmptyIsMin AndAlso Value = Date.MinValue Then
Return ""
ElseIf Not EmptyIsMin AndAlso Value = Date.MaxValue Then
Return ""
Else
Return Format(Value, FormatString)
End If
End Function
#End Region
#Region " Manipulation Functions "
''' <summary>
''' Compares one SmartDate to another.
''' </summary>
''' <remarks>
''' This method works the same as the CompareTo method
''' on the Date datetype, with the exception that it
''' understands the concept of empty date values.
''' </remarks>
''' <param name="Value">The date to which we are being compared.</param>
''' <returns>A value indicating if the comparison date is less than, equal to or greater than this date.</returns>
Public Function CompareTo(ByVal Value As SmartDate) As Integer
If Me.IsEmpty AndAlso Value.IsEmpty Then
Return 0
Else
Return mDate.CompareTo(Value.Date)
End If
End Function
''' <summary>
''' Compares one SmartDate to another.
''' </summary>
''' <remarks>
''' This method works the same as the CompareTo method
''' on the Date datetype, with the exception that it
''' understands the concept of empty date values.
''' </remarks>
''' <param name="Value">The date to which we are being compared.</param>
''' <returns>A value indicating if the comparison date is less than, equal to or greater than this date.</returns>
Public Function CompareTo(ByVal Value As Object) As Integer _
Implements IComparable.CompareTo
If TypeOf Value Is SmartDate Then
Return CompareTo(DirectCast(Value, SmartDate))
Else
Throw New ArgumentException("Value is not a SmartDate")
End If
End Function
''' <summary>
''' Compares a SmartDate to a text date value.
''' </summary>
''' <param name="Value">The date to which we are being compared.</param>
''' <returns>A value indicating if the comparison date is less than, equal to or greater than this date.</returns>
Public Function CompareTo(ByVal Value As String) As Integer
If Not IsDate(Value) Then
Throw New ArgumentException("Value must be a valid date")
Else
Return mDate.CompareTo(CDate(Value))
End If
End Function
''' <summary>
''' Compares a SmartDate to a date value.
''' </summary>
''' <param name="Value">The date to which we are being compared.</param>
''' <returns>A value indicating if the comparison date is less than, equal to or greater than this date.</returns>
Public Function CompareTo(ByVal Value As Date) As Integer
Return mDate.CompareTo(Value)
End Function
''' <summary>
''' Adds a TimeSpan onto the object.
''' </summary>
Public Sub Add(ByVal Value As TimeSpan)
mDate = mDate.Add(Value)
End Sub
''' <summary>
''' Subtracts a TimeSpan from the object.
''' </summary>
Public Sub Subtract(ByVal Value As TimeSpan)
mDate = mDate.Subtract(Value)
End Sub
#End Region
End Class

341
source/csla10/Backup/CSLA/SortedCollectionBase.vb Normal file
View File

@@ -0,0 +1,341 @@
Imports System.ComponentModel
''' <summary>
'''
''' </summary>
Namespace Core
''' <summary>
''' This class implements sorting functionality for collections.
''' </summary>
''' <remarks>
''' <para>
''' This class inhirits from Core.BindableCollectionBase and adds
''' sorting capability to collections. BusinessCollectionBase inherits
''' from this class, and business collections should inherit from
''' BusinessCollectionBase. Core.SortedCollectionBase is for internal
''' framework use only.
''' </para><para>
''' The Core.BindableCollectionBase class implements the IBindableList
''' interface. However, it doesn't actually implement sorting. Instead
''' it delegates the sorting functionality to a set of protected virtual
''' methods. This class provides the actual sorting implementation
''' by overriding those methods.
''' </para>
''' </remarks>
<Serializable()> _
Public Class SortableCollectionBase
Inherits BindableCollectionBase
<NotUndoable()> _
Private mIsSorted As Boolean = False
<NonSerialized(), NotUndoable()> _
Private mSortProperty As PropertyDescriptor
<NotUndoable()> _
Private mSortPropertyName As String
<NotUndoable()> _
Private mListSortDirection As ListSortDirection = ListSortDirection.Ascending
<NotUndoable()> _
Private mUnsortedList As ArrayList
<NotUndoable()> _
Private mActivelySorting As Boolean = False
#Region " Properties "
''' <summary>
''' Indicates whether the collection is in the process of
''' being sorted at this time.
''' </summary>
Protected ReadOnly Property ActivelySorting() As Boolean
Get
Return mActivelySorting
End Get
End Property
''' <summary>
''' Returns a value indicating whether the collection is currently
''' sorted.
''' </summary>
Protected Overrides ReadOnly Property IBindingList_IsSorted() As Boolean
Get
Return mIsSorted
End Get
End Property
''' <summary>
''' Returns the property by which the collection is currently sorted.
''' </summary>
''' <remarks>
''' This method is invoked via the IBindingList interface and is not
''' intended for use by code in your business class.
''' </remarks>
Protected Overrides ReadOnly Property IBindingList_SortProperty() As PropertyDescriptor
Get
If mSortProperty Is Nothing AndAlso Len(mSortPropertyName) > 0 Then
Try
' we need to recreate the sortproperty value
Dim childType As Type
If list.Count > 0 Then
' get child type from the first element in the collection
childType = list.Item(0).GetType
Else
' get child type from Item property
Try
childType = Me.GetType.GetProperty("Item", New Type() {GetType(Integer)}).PropertyType
Catch
childType = GetType(Object)
End Try
End If
' now get the property descriptor from the type
mSortProperty = _
TypeDescriptor.GetProperties(childType).Item(mSortPropertyName)
Catch
' we failed to recreate it - return nothing
mSortProperty = Nothing
End Try
End If
Return mSortProperty
End Get
End Property
''' <summary>
''' Returns the current sort direction.
''' </summary>
''' <remarks>
''' This method is invoked via the IBindingList interface and is not
''' intended for use by code in your business class.
''' </remarks>
Protected Overrides ReadOnly Property IBindingList_SortDirection() As ListSortDirection
Get
Return mListSortDirection
End Get
End Property
#End Region
#Region " ApplySort "
''' <summary>
''' Structure to store temporary data for sorting.
''' </summary>
Private Structure SortData
Private mKey As Object
Public Value As Object
Public Sub New(ByVal Key As Object, ByVal Value As Object)
mKey = Key
Me.Value = Value
End Sub
Public ReadOnly Property Key() As Object
Get
If IsNumeric(mKey) OrElse TypeOf mKey Is String Then
Return mKey
Else
Return mKey.ToString
End If
End Get
End Property
End Structure
''' <summary>
''' Contains code to compare SortData structures
''' </summary>
''' <remarks>
''' This performs a case sensitive comparison. If you want a case insensitive
''' comparison, change the code to use CaseInsensitiveComparer.Default instead.
''' </remarks>
Private Class SortDataCompare
Implements IComparer
Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements System.Collections.IComparer.Compare
Dim item1 As SortData = DirectCast(x, SortData)
Dim item2 As SortData = DirectCast(y, SortData)
Return Comparer.Default.Compare(item1.Key, item2.Key)
End Function
End Class
''' <summary>
''' Applies a sort to the collection.
''' </summary>
''' <remarks>
''' This method is invoked via the IBindingList interface and is not
''' intended for use by code in your business class.
''' </remarks>
Protected Overrides Sub IBindingList_ApplySort(ByVal [property] As System.ComponentModel.PropertyDescriptor, ByVal direction As System.ComponentModel.ListSortDirection)
If Not AllowSort Then
Throw New NotSupportedException("Sorting is not supported by this collection.")
End If
mSortProperty = [property]
mSortPropertyName = mSortProperty.Name
mListSortDirection = direction
If Not mIsSorted AndAlso list.Count > 0 Then
' this is our first time sorting so
' make sure to store the original order
mUnsortedList = New ArrayList()
Dim item As Object
For Each item In list
mUnsortedList.Add(item)
Next
End If
If list.Count > 1 Then
Try
Dim count As Integer
mActivelySorting = True
' copy the key/value pairs into a sorted list
Dim sortList As New ArrayList()
For count = 0 To list.Count - 1
sortList.Add(New SortData(CallByName(list.Item(count), mSortPropertyName, CallType.Get), list.Item(count)))
Next
sortList.Sort(New SortDataCompare())
list.Clear()
If direction = ListSortDirection.Ascending Then
Dim item As SortData
For Each item In sortList
list.Add(item.Value)
Next
Else ' direction = ListSortDirection.Descending
Dim item As SortData
For count = sortList.Count - 1 To 0 Step -1
item = DirectCast(sortList(count), SortData)
list.Add(item.value)
Next
End If
mIsSorted = True
Catch
IBindingList_RemoveSort()
Finally
mActivelySorting = False
End Try
ElseIf list.Count = 1 Then
mIsSorted = True
End If
End Sub
#End Region
#Region " RemoveSort "
''' <summary>
''' Removes any sort from the collection.
''' </summary>
''' <remarks>
''' This method is invoked via the IBindingList interface and is not
''' intended for use by code in your business class.
''' </remarks>
Protected Overrides Sub IBindingList_RemoveSort()
If Not AllowSort Then
Throw New NotSupportedException("Sorting is not supported by this collection.")
End If
If mIsSorted Then
mActivelySorting = True
'Return the list to its unsorted state
list.Clear()
Dim item As Object
For Each item In mUnsortedList
list.Add(item)
Next
mUnsortedList = Nothing
mIsSorted = False
mSortProperty = Nothing
mSortPropertyName = ""
mListSortDirection = ListSortDirection.Ascending
mActivelySorting = False
End If
End Sub
#End Region
#Region " Collection events "
''' <summary>
''' Ensures that any sort is maintained as a new item is inserted.
''' </summary>
Protected Overrides Sub OnInsertComplete(ByVal index As Integer, ByVal value As Object)
If mIsSorted AndAlso Not ActivelySorting Then
mUnsortedList.Add(value)
End If
MyBase.OnInsertComplete(index, value)
End Sub
''' <summary>
''' Ensures that any sort is maintained as the list is cleared.
''' </summary>
Protected Overrides Sub OnClearComplete()
If mIsSorted AndAlso Not ActivelySorting Then
mUnsortedList.Clear()
End If
MyBase.OnClearComplete()
End Sub
''' <summary>
''' Ensures that any sort is maintained as an item is removed.
''' </summary>
Protected Overrides Sub OnRemoveComplete(ByVal index As Integer, ByVal value As Object)
If mIsSorted AndAlso Not ActivelySorting Then
mUnsortedList.Remove(value)
End If
MyBase.OnRemoveComplete(index, value)
End Sub
#End Region
#Region " Search/Find "
''' <summary>
''' Implements search/find functionality for the collection.
''' </summary>
Protected Overrides Function IBindingList_Find(ByVal [property] As PropertyDescriptor, ByVal key As Object) As Integer
If Not AllowFind Then
Throw New NotSupportedException("Searching is not supported by this collection.")
End If
Dim index As Integer
Dim tmp As Object
Dim prop As String = [property].Name
For index = 0 To list.Count - 1
tmp = CallByName(list.Item(index), prop, CallType.Get)
If tmp.Equals(key) Then
' we found a match
Return index
End If
Next
' we didn't find anything
Return -1
End Function
#End Region
End Class
End Namespace

16
source/csla10/Backup/CSLA/TransactionalAttribute.vb Normal file
View File

@@ -0,0 +1,16 @@
' this attribute allows us to mark dataportal methods
' as transactional to trigger use of EnterpriseServices
''' <summary>
''' Allows us to mark the DataPortal_xxx methods in our business
''' classes as transactional.
''' </summary>
''' <remarks>
''' When a method is marked as transactional, the DataPortal
''' mechanism runs the method within a COM+ transactional
''' context, so the data access is protected by a 2-phase
''' distributed transaction.
''' </remarks>
<AttributeUsage(AttributeTargets.Method)> _
Public Class TransactionalAttribute
Inherits Attribute
End Class

354
source/csla10/Backup/CSLA/UndoableBase.vb Normal file
View File

@@ -0,0 +1,354 @@
Option Strict On
Imports System.Reflection
Imports System.IO
Imports System.Runtime.Serialization
Imports System.Runtime.Serialization.Formatters.Binary
''' <summary>
'''
''' </summary>
Namespace Core
''' <summary>
''' Implements n-level undo capabilities.
''' </summary>
''' <remarks>
''' You should not directly derive from this class. Your
''' business classes should derive from
''' <see cref="CSLA.BusinessBase" />.
''' </remarks>
<Serializable()> _
Public MustInherit Class UndoableBase
Inherits CSLA.Core.BindableBase
' keep a stack of object state values
<NotUndoable()> _
Private mStateStack As New Stack
' variables containing type info for comparisons
Private Shared UndoableType As Type = GetType(UndoableBase)
Private Shared BusinessType As Type = GetType(BusinessBase)
Private Shared CollectionType As Type = GetType(BusinessCollectionBase)
''' <summary>
''' Returns the current edit level of the object.
''' </summary>
Protected ReadOnly Property EditLevel() As Integer
Get
Return mStateStack.Count
End Get
End Property
''' <summary>
''' Copies the state of the object and places the copy
''' onto the state stack.
''' </summary>
Protected Friend Sub CopyState()
Dim currentType As Type = Me.GetType
Dim state As New Hashtable()
Dim fields() As FieldInfo
Dim field As FieldInfo
Dim fieldName As String
Debug.WriteLine("CopyState" & currentType.ToString() & " EditLevel:" & Me.EditLevel.ToString())
Do
' get the list of fields in this type
fields = currentType.GetFields( _
BindingFlags.NonPublic Or _
BindingFlags.Instance Or _
BindingFlags.Public)
For Each field In fields
' make sure we process only our variables
If field.DeclaringType Is currentType Then
' see if this field is marked as not undoable
If Not NotUndoableField(field) Then
' the field is undoable, so it needs to be processed
Dim value As Object = field.GetValue(Me)
If TypeInheritsFrom(field.FieldType, CollectionType) Then
' make sure the variable has a value
If Not value Is Nothing Then
' this is a child collection, cascade the call
CType(value, BusinessCollectionBase).CopyState()
End If
ElseIf TypeInheritsFrom(field.FieldType, BusinessType) Then
' make sure the variable has a value
If Not value Is Nothing Then
' this is a child object, cascade the call
CType(value, BusinessBase).CopyState()
End If
Else
' this is a normal field, simply trap the value
fieldName = field.DeclaringType.Name & "!" & field.Name
state.Add(fieldName, value)
End If
End If
End If
Next
currentType = currentType.BaseType
Loop Until currentType Is UndoableType
' serialize the state and stack it
Dim buffer As New MemoryStream()
Dim formatter As New BinaryFormatter()
formatter.Serialize(buffer, state)
mStateStack.Push(buffer.ToArray)
End Sub
''' <summary>
''' Restores the object's state to the most recently
''' copied values from the state stack.
''' </summary>
''' <remarks>
''' Restores the state of the object to its
''' previous value by taking the data out of
''' the stack and restoring it into the fields
''' of the object.
''' </remarks>
Protected Friend Sub UndoChanges()
' if we are a child object we might be asked to
' undo below the level where we stacked states,
' so just do nothing in that case
If EditLevel > 0 Then
Dim buffer As New MemoryStream(CType(mStateStack.Pop(), Byte()))
buffer.Position = 0
Dim formatter As New BinaryFormatter()
Dim state As Hashtable = CType(formatter.Deserialize(buffer), Hashtable)
Dim currentType As Type = Me.GetType
Dim fields() As FieldInfo
Dim field As FieldInfo
Dim fieldName As String
Do
' get the list of fields in this type
fields = currentType.GetFields( _
BindingFlags.NonPublic Or _
BindingFlags.Instance Or _
BindingFlags.Public)
For Each field In fields
If field.DeclaringType Is currentType Then
' see if the field is undoable or not
If Not NotUndoableField(field) Then
' the field is undoable, so restore its value
If TypeInheritsFrom(field.FieldType, CollectionType) Then
' this is a child collection, cascade the call
CType(field.GetValue(Me), BusinessCollectionBase).UndoChanges()
ElseIf TypeInheritsFrom(field.FieldType, BusinessType) Then
' this is a child object, cascade the call
CType(field.GetValue(Me), BusinessBase).UndoChanges()
Else
' this is a regular field, restore its value
fieldName = field.DeclaringType.Name & "!" & field.Name
field.SetValue(Me, state.Item(fieldName))
End If
End If
End If
Next
currentType = currentType.BaseType
Loop Until currentType Is UndoableType
End If
End Sub
''' <summary>
''' Accepts any changes made to the object since the last
''' state copy was made.
''' </summary>
''' <remarks>
''' The most recent state copy is removed from the state
''' stack and discarded, thus committing any changes made
''' to the object's state.
''' </remarks>
Protected Friend Sub AcceptChanges()
If EditLevel > 0 Then
mStateStack.Pop()
Dim currentType As Type = Me.GetType
Dim fields() As FieldInfo
Dim field As FieldInfo
Dim fieldName As String
Do
' get the list of fields in this type
fields = currentType.GetFields( _
BindingFlags.NonPublic Or _
BindingFlags.Instance Or _
BindingFlags.Public)
For Each field In fields
If field.DeclaringType Is currentType Then
' see if the field is undoable or not
If Not NotUndoableField(field) Then
' the field is undoable so see if it is a collection
If TypeInheritsFrom(field.FieldType, CollectionType) Then
' it is a collection so cascade the call
CType(field.GetValue(Me), BusinessCollectionBase).AcceptChanges()
ElseIf TypeInheritsFrom(field.FieldType, BusinessType) Then
' it is a child object so cascade the call
' JOHN AYANOVA CUSTOMIZED: Added check if is not nothing
' below because some objects have uninitialized children
'(workorder)
If Not field.GetValue(Me) Is Nothing Then
CType(field.GetValue(Me), BusinessBase).AcceptChanges()
End If
End If
End If
End If
Next
currentType = currentType.BaseType
Loop Until currentType Is UndoableType
End If
End Sub
#Region " Helper Functions "
Private Function NotUndoableField(ByVal Field As FieldInfo) As Boolean
Return Attribute.IsDefined(Field, GetType(NotUndoableAttribute))
'' get a list of all NotUndoableAttributes for this field
'Dim attribs() As Object = _
' Field.GetCustomAttributes(GetType(NotUndoableAttribute), True)
'' return True if any NotUndoableAttributes exist on this field
'Return (UBound(attribs) > -1)
End Function
Private Function TypeInheritsFrom( _
ByVal TypeToCheck As Type, ByVal CheckAgainst As Type) As Boolean
Dim base As Type = TypeToCheck
' scan up through the inheritance hierarchy, checking each
' class to see if it is the one we're looking for
While Not base.BaseType Is Nothing
' if we find the target class return True
If base Is CheckAgainst Then Return True
base = base.BaseType
End While
' the target class is not in the inheritance hierarchy so
' return False
Return False
End Function
#End Region
#Region " DumpState "
''' <summary>
''' Writes the object's field data into the debugger
''' output window in VS.NET.
''' </summary>
Public Sub DumpState()
Dim currentType As Type = Me.GetType
Dim state As New Hashtable()
Dim field As FieldInfo
Dim fieldName As String
Dim fields() As FieldInfo
Debug.IndentSize = 2
Debug.WriteLine("OBJECT " & currentType.Name)
Debug.WriteLine("UndoableBase!EditLevel: " & EditLevel)
Do
' get the list of fields in this type
fields = currentType.GetFields( _
BindingFlags.NonPublic Or _
BindingFlags.Instance Or _
BindingFlags.Public)
For Each field In fields
If field.DeclaringType Is currentType Then
fieldName = field.DeclaringType.Name & "!" & field.Name
' see if this field is marked as not undoable
If Not NotUndoableField(field) Then
' the field is undoable, so it needs to be processed
If TypeInheritsFrom(field.FieldType, CollectionType) Then
' this is a child collection, cascade the call
Debug.Indent()
Debug.WriteLine("COLLECTION " & fieldName)
If Not field.GetValue(Me) Is Nothing Then
CType(field.GetValue(Me), BusinessCollectionBase).DumpState()
Else
Debug.WriteLine("<Nothing>")
End If
Debug.Unindent()
ElseIf TypeInheritsFrom(field.FieldType, BusinessType) Then
' this is a child object, cascade the call
Debug.Indent()
Debug.WriteLine("CHILD OBJECT " & fieldName)
If Not field.GetValue(Me) Is Nothing Then
CType(field.GetValue(Me), BusinessBase).DumpState()
Else
Debug.WriteLine("<Nothing>")
End If
Debug.Unindent()
Else
' this is a normal field, simply trap the value
If Not field.GetValue(Me) Is Nothing Then
Debug.WriteLine(fieldName & ": " & field.GetValue(Me).ToString)
Else
Debug.WriteLine(fieldName & ": <Nothing>")
End If
End If
Else
' field is not undoable
If Not field.GetValue(Me) Is Nothing Then
Debug.WriteLine("<NotUndoable()> " & fieldName & ": " & field.GetValue(Me).ToString)
Else
Debug.WriteLine("<NotUndoable()> " & fieldName & ": <Nothing>")
End If
End If
End If
Next
currentType = currentType.BaseType
Loop Until currentType Is UndoableType
End Sub
#End Region
End Class
End Namespace

52
source/csla10/Backup/CSLA/ValidationException.vb Normal file
View File

@@ -0,0 +1,52 @@
''' <summary>
''' Exception class indicating that there was a validation
''' problem with a business object.
''' </summary>
<Serializable()> _
Public Class ValidationException
Inherits ApplicationException
''' <summary>
''' Initializes a new instance of the
''' <see cref="T:CSLA.ValidationException" /> class.
''' </summary>
Public Sub New()
End Sub
''' <summary>
''' Initializes a new instance of the
''' <see cref="T:CSLA.ValidationException" /> class
''' with a specified error message.
''' </summary>
Public Sub New(ByVal message As String)
MyBase.New(message)
End Sub
''' <summary>
''' Initializes a new instance of the
''' <see cref="T:CSLA.ValidationException" /> class
''' with a specified error message and a reference to the
''' inner exception that is the cause of this exception.
''' </summary>
Public Sub New(ByVal message As String, ByVal innerException As Exception)
MyBase.New(message, innerException)
End Sub
''' <summary>
''' Initializes a new instance of the
''' <see cref="T:CSLA.ValidationException" /> class
''' with serialized data.
''' </summary>
Protected Sub New(ByVal info As System.Runtime.Serialization.SerializationInfo, _
ByVal context As System.Runtime.Serialization.StreamingContext)
MyBase.New(info, context)
End Sub
End Class

65
source/csla10/Backup/CSLA10.sln Normal file
View File

@@ -0,0 +1,65 @@
Microsoft Visual Studio Solution File, Format Version 8.00
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "CSLA", "CSLA\CSLA.vbproj", "{1B9A38BB-461A-47A4-AD72-099C694138A0}"
ProjectSection(ProjectDependencies) = postProject
EndProjectSection
EndProject
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "CSLA.Core.Bindablebase", "CSLA.Core.Bindablebase\CSLA.Core.Bindablebase.csproj", "{C2392355-12A9-4197-A1D3-603C390B1E62}"
ProjectSection(ProjectDependencies) = postProject
EndProjectSection
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "CSLA.Server.DataPortal", "CSLA.Server.DataPortal\CSLA.Server.DataPortal.vbproj", "{80828E2C-E9FB-4E73-A27C-7F9CDB96FCDE}"
ProjectSection(ProjectDependencies) = postProject
EndProjectSection
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "CSLA.Server.ServicedDataPortal", "CSLA.Server.ServicedDataPortal\CSLA.Server.ServicedDataPortal.vbproj", "{AD60DF60-2D14-4403-B5A8-41D4E06AB7AD}"
ProjectSection(ProjectDependencies) = postProject
EndProjectSection
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "CSLA.BatchQueue", "CSLA.BatchQueue\CSLA.BatchQueue.vbproj", "{F8E2709C-E0DE-4253-9A1A-59F4F59B0EBD}"
ProjectSection(ProjectDependencies) = postProject
EndProjectSection
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "NetRun", "NetRun\NetRun.vbproj", "{24FFD3D5-D449-403F-88F3-04D9E17422A6}"
ProjectSection(ProjectDependencies) = postProject
EndProjectSection
EndProject
Global
GlobalSection(SolutionConfiguration) = preSolution
Debug = Debug
Release = Release
EndGlobalSection
GlobalSection(ProjectConfiguration) = postSolution
{1B9A38BB-461A-47A4-AD72-099C694138A0}.Debug.ActiveCfg = Debug|.NET
{1B9A38BB-461A-47A4-AD72-099C694138A0}.Debug.Build.0 = Debug|.NET
{1B9A38BB-461A-47A4-AD72-099C694138A0}.Release.ActiveCfg = Release|.NET
{1B9A38BB-461A-47A4-AD72-099C694138A0}.Release.Build.0 = Release|.NET
{C2392355-12A9-4197-A1D3-603C390B1E62}.Debug.ActiveCfg = Debug|.NET
{C2392355-12A9-4197-A1D3-603C390B1E62}.Debug.Build.0 = Debug|.NET
{C2392355-12A9-4197-A1D3-603C390B1E62}.Release.ActiveCfg = Release|.NET
{C2392355-12A9-4197-A1D3-603C390B1E62}.Release.Build.0 = Release|.NET
{80828E2C-E9FB-4E73-A27C-7F9CDB96FCDE}.Debug.ActiveCfg = Debug|.NET
{80828E2C-E9FB-4E73-A27C-7F9CDB96FCDE}.Debug.Build.0 = Debug|.NET
{80828E2C-E9FB-4E73-A27C-7F9CDB96FCDE}.Release.ActiveCfg = Release|.NET
{80828E2C-E9FB-4E73-A27C-7F9CDB96FCDE}.Release.Build.0 = Release|.NET
{AD60DF60-2D14-4403-B5A8-41D4E06AB7AD}.Debug.ActiveCfg = Debug|.NET
{AD60DF60-2D14-4403-B5A8-41D4E06AB7AD}.Debug.Build.0 = Debug|.NET
{AD60DF60-2D14-4403-B5A8-41D4E06AB7AD}.Release.ActiveCfg = Release|.NET
{AD60DF60-2D14-4403-B5A8-41D4E06AB7AD}.Release.Build.0 = Release|.NET
{F8E2709C-E0DE-4253-9A1A-59F4F59B0EBD}.Debug.ActiveCfg = Debug|.NET
{F8E2709C-E0DE-4253-9A1A-59F4F59B0EBD}.Debug.Build.0 = Debug|.NET
{F8E2709C-E0DE-4253-9A1A-59F4F59B0EBD}.Release.ActiveCfg = Release|.NET
{F8E2709C-E0DE-4253-9A1A-59F4F59B0EBD}.Release.Build.0 = Release|.NET
{24FFD3D5-D449-403F-88F3-04D9E17422A6}.Debug.ActiveCfg = Debug|.NET
{24FFD3D5-D449-403F-88F3-04D9E17422A6}.Debug.Build.0 = Debug|.NET
{24FFD3D5-D449-403F-88F3-04D9E17422A6}.Release.ActiveCfg = Release|.NET
{24FFD3D5-D449-403F-88F3-04D9E17422A6}.Release.Build.0 = Release|.NET
EndGlobalSection
GlobalSection(SolutionItems) = postSolution
license.txt = license.txt
readme.txt = readme.txt
EndGlobalSection
GlobalSection(ExtensibilityGlobals) = postSolution
EndGlobalSection
GlobalSection(ExtensibilityAddIns) = postSolution
EndGlobalSection
EndGlobal

BIN
source/csla10/Backup/CSLA10.suo Normal file
View File

Binary file not shown.

31
source/csla10/Backup/NetRun/AssemblyInfo.vb Normal file
View File

@@ -0,0 +1,31 @@
Imports System.Reflection
Imports System.Runtime.InteropServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("NetRun")>
<Assembly: AssemblyDescription("No-touch deployment utility")>
<Assembly: AssemblyCompany("Rockford Lhotka")>
<Assembly: AssemblyProduct("NetRun")>
<Assembly: AssemblyCopyright("Copyright 2003 Rockford Lhotka. All rights reserved.")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("65567A5E-28FC-48E1-B027-F79552E755A9")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
<Assembly: AssemblyVersion("1.3.*")>

174
source/csla10/Backup/NetRun/Launcher.vb Normal file
View File

@@ -0,0 +1,174 @@
Imports System.Reflection
Imports System.Security
Imports System.Security.Policy
Imports System.Security.Permissions
Public Class Launcher
Inherits MarshalByRefObject
Private mAppURL As String
Private mAppDir As String
Private mAppName As String
Private mGroupExisted As Boolean
Public Sub RunApp(ByVal AppURL As String)
' before we do anything, invoke the workaround
' for the serialization bug
SerializationWorkaround()
Try
' get and parse the URL for the app we are
' launching
mAppURL = AppURL
mAppDir = GetAppDirectory(mAppURL)
mAppName = GetAppName(mAppURL)
' TODO: MAKE SURE TO TIGHTEN SECURITY BEFORE USING!!!!
' see http://www.lhotka.net/Articles.aspx?id=2f5a8115-b425-4aa1-bae2-b8f80766ecb3
SetSecurity()
' load the assembly into our AppDomain
Dim asm As [Assembly]
asm = [Assembly].LoadFrom(AppURL)
' run the program by invoking its entry point
asm.EntryPoint.Invoke(asm.EntryPoint, Nothing)
Finally
RemoveSecurity()
End Try
End Sub
#Region " Serialization bug workaround "
Private Sub SerializationWorkaround()
' hook up the AssemblyResolve
' event so deep serialization works properly
' this is a workaround for a bug in the .NET runtime
Dim currentDomain As AppDomain = AppDomain.CurrentDomain
AddHandler currentDomain.AssemblyResolve, _
AddressOf ResolveEventHandler
End Sub
Private Function ResolveEventHandler(ByVal sender As Object, ByVal args As ResolveEventArgs) As [Assembly]
' get a list of all the assemblies loaded in our appdomain
Dim list() As [Assembly] = AppDomain.CurrentDomain.GetAssemblies()
' search the list to find the assemby that was not found automatically
' and return the assembly from the list
Dim asm As [Assembly]
For Each asm In list
If asm.FullName = args.Name Then
Return asm
End If
Next
End Function
#End Region
#Region " SetSecurity to FullTrust "
Private Sub SetSecurity()
Dim ph As System.Collections.IEnumerator
Dim pl As System.Security.Policy.PolicyLevel
Dim found As Boolean
' retrieve the security policy hierarchy
ph = SecurityManager.PolicyHierarchy
' loop through to find the Machine level sub-tree
Do While ph.MoveNext
pl = CType(ph.Current, PolicyLevel)
If pl.Label = "Machine" Then
found = True
Exit Do
End If
Loop
If found Then
' see if the codegroup for this app already exists
' as a machine-level entry
Dim cg As CodeGroup
For Each cg In pl.RootCodeGroup.Children
If cg.Name = mAppName Then
' codegroup already exists
' we assume it is set to a valid
' permission level
mGroupExisted = True
Exit Sub
End If
Next
' the codegroup doesn't already exist, so
' we'll add a url group with FullTrust
mGroupExisted = False
Dim ucg As UnionCodeGroup = _
New UnionCodeGroup(New UrlMembershipCondition(mAppDir & "/*"), _
New PolicyStatement(New NamedPermissionSet("FullTrust")))
ucg.Description = "Temporary entry for " & mAppURL
ucg.Name = mAppName
pl.RootCodeGroup.AddChild(ucg)
SecurityManager.SavePolicy()
End If
End Sub
#End Region
#Region " RemoveSecurity "
Private Sub RemoveSecurity()
' if the group existed before NetRun was used
' we want to leave the group intact, so we
' can just exit
If mGroupExisted Then Exit Sub
' on the other hand, if the group didn't already
' exist then we need to remove it now that
' the business application is closed
Dim ph As System.Collections.IEnumerator
Dim pl As System.Security.Policy.PolicyLevel
Dim found As Boolean
' retrieve the security policy hierarchy
ph = SecurityManager.PolicyHierarchy
' loop through to find the Machine level sub-tree
Do While ph.MoveNext
pl = CType(ph.Current, PolicyLevel)
If pl.Label = "Machine" Then
found = True
Exit Do
End If
Loop
If found Then
' see if the codegroup for this app exists
' as a machine-level entry
Dim cg As CodeGroup
For Each cg In pl.RootCodeGroup.Children
If cg.Name = mAppName Then
' codegroup exits - remove it
pl.RootCodeGroup.RemoveChild(cg)
SecurityManager.SavePolicy()
Exit For
End If
Next
End If
End Sub
#End Region
End Class

114
source/csla10/Backup/NetRun/Main.vb Normal file
View File

@@ -0,0 +1,114 @@
Imports System.IO
Imports System.Reflection
Imports System.Security
Imports System.Security.Policy
Imports System.Security.Permissions
Module Main
Public Sub Main()
Try
' launch the app based on the URL provided by the user
RunAppliation(Microsoft.VisualBasic.Command)
Catch ex As Exception
Dim sb As New System.Text.StringBuilder()
sb.Append("NetRun was unable to launch the application")
sb.Append(vbCrLf)
sb.Append(Microsoft.VisualBasic.Command)
sb.Append(vbCrLf)
sb.Append(vbCrLf)
sb.Append(ex.ToString)
MsgBox(sb.ToString, MsgBoxStyle.Exclamation)
End Try
End Sub
#Region " RunApplication "
Private Sub RunAppliation(ByVal AppURL As String)
' create setup object for the new app domain
Dim setupDomain As New AppDomainSetup()
With setupDomain
' give it a valid base path
.ApplicationBase = CurrentDomainPath()
' give it a safe config file name
.ConfigurationFile = AppURL + ".remoteconfig"
End With
' create new application domain
Dim newDomain As AppDomain = _
AppDomain.CreateDomain( _
GetAppName(AppURL), Nothing, setupDomain)
' create launcher object in new appdomain
Dim launcher As Launcher = _
CType(newDomain.CreateInstanceAndUnwrap( _
"NetRun", "NetRun.Launcher"), _
Launcher)
' use launcher object from the new domain
' to launch the remote app in that appdomain
launcher.RunApp(AppURL)
End Sub
#End Region
#Region " GetCurrentDomainPath "
Private Function CurrentDomainPath() As String
' get path of current assembly
Dim currentPath As String = [Assembly].GetExecutingAssembly.CodeBase
' convert it to a URI for ease of use
Dim currentURI As Uri = New Uri(currentPath)
' get the path portion of the URI
Dim currentLocalPath As String = currentURI.LocalPath
' return the full name of the path
Return New DirectoryInfo(currentLocalPath).Parent.FullName
End Function
#End Region
#Region " URL parsing functions "
Public Function GetAppDirectory(ByVal AppURL As String) As String
' get the path without prog name
Dim appURI As New System.Uri(AppURL)
Dim appPath As String = appURI.GetLeftPart(UriPartial.Path)
Dim pos As Integer
For pos = Len(appPath) To 1 Step -1
If Mid(appPath, pos, 1) = "/" OrElse Mid(appPath, pos, 1) = "\" Then
Return Left(appPath, pos - 1)
End If
Next
Return ""
End Function
Public Function GetAppName(ByVal AppURL As String) As String
' get the prog name without path
Dim appURI As New System.Uri(AppURL)
Dim appPath As String = appURI.GetLeftPart(UriPartial.Path)
Dim pos As Integer
For pos = Len(appPath) To 1 Step -1
If Mid(appPath, pos, 1) = "/" OrElse Mid(appPath, pos, 1) = "\" Then
Return Mid(appPath, pos + 1)
End If
Next
Return ""
End Function
#End Region
End Module

35
source/csla10/Backup/NetRun/NetRun.vbproj Normal file
View File

@@ -0,0 +1,35 @@
<VisualStudioProject>
<VisualBasic ProjectType="Local" ProductVersion="7.10.3077" SchemaVersion="2.0" ProjectGuid="{24FFD3D5-D449-403F-88F3-04D9E17422A6}">
<Build>
<Settings ApplicationIcon="" AssemblyKeyContainerName="" AssemblyName="NetRun" AssemblyOriginatorKeyFile="" AssemblyOriginatorKeyMode="None" DefaultClientScript="JScript" DefaultHTMLPageLayout="Grid" DefaultTargetSchema="IE50" DelaySign="false" OutputType="WinExe" OptionCompare="Binary" OptionExplicit="On" OptionStrict="Off" RootNamespace="NetRun" StartupObject="">
<Config Name="Debug" BaseAddress="285212672" ConfigurationOverrideFile="" DefineConstants="" DefineDebug="true" DefineTrace="true" DebugSymbols="true" IncrementalBuild="true" Optimize="false" OutputPath="bin\" RegisterForComInterop="false" RemoveIntegerChecks="false" TreatWarningsAsErrors="false" WarningLevel="1" />
<Config Name="Release" BaseAddress="285212672" ConfigurationOverrideFile="" DefineConstants="" DefineDebug="false" DefineTrace="true" DebugSymbols="false" IncrementalBuild="false" Optimize="true" OutputPath="bin\" RegisterForComInterop="false" RemoveIntegerChecks="false" TreatWarningsAsErrors="false" WarningLevel="1" />
</Settings>
<References>
<Reference Name="System" AssemblyName="System" />
<Reference Name="System.Data" AssemblyName="System.Data" />
<Reference Name="System.Drawing" AssemblyName="System.Drawing" />
<Reference Name="System.Windows.Forms" AssemblyName="System.Windows.Forms" />
<Reference Name="System.XML" AssemblyName="System.Xml" />
</References>
<Imports>
<Import Namespace="Microsoft.VisualBasic" />
<Import Namespace="System" />
<Import Namespace="System.Collections" />
<Import Namespace="System.Data" />
<Import Namespace="System.Drawing" />
<Import Namespace="System.Diagnostics" />
<Import Namespace="System.Windows.Forms" />
</Imports>
</Build>
<Files>
<Include>
<File RelPath="AssemblyInfo.vb" SubType="Code" BuildAction="Compile" />
<File RelPath="Launcher.vb" SubType="Code" BuildAction="Compile" />
<File RelPath="Main.vb" SubType="Code" BuildAction="Compile" />
</Include>
</Files>
<UserProperties GenerateXMLDocForProject="FALSE" />
</VisualBasic>
</VisualStudioProject>

48
source/csla10/Backup/NetRun/NetRun.vbproj.user Normal file
View File

@@ -0,0 +1,48 @@
<VisualStudioProject>
<VisualBasic LastOpenVersion = "7.10.3077" >
<Build>
<Settings ReferencePath = "" >
<Config
Name = "Debug"
EnableASPDebugging = "false"
EnableASPXDebugging = "false"
EnableUnmanagedDebugging = "false"
EnableSQLServerDebugging = "false"
RemoteDebugEnabled = "false"
RemoteDebugMachine = ""
StartAction = "Project"
StartArguments = ""
StartPage = ""
StartProgram = ""
StartURL = ""
StartWorkingDirectory = ""
StartWithIE = "false"
/>
<Config
Name = "Release"
EnableASPDebugging = "false"
EnableASPXDebugging = "false"
EnableUnmanagedDebugging = "false"
EnableSQLServerDebugging = "false"
RemoteDebugEnabled = "false"
RemoteDebugMachine = ""
StartAction = "Project"
StartArguments = ""
StartPage = ""
StartProgram = ""
StartURL = ""
StartWorkingDirectory = ""
StartWithIE = "false"
/>
</Settings>
</Build>
<OtherProjectSettings
CopyProjectDestinationFolder = ""
CopyProjectUncPath = ""
CopyProjectOption = "0"
ProjectView = "ProjectFiles"
ProjectTrust = "0"
/>
</VisualBasic>
</VisualStudioProject>

31
source/csla10/BatchQueueTest/AssemblyInfo.vb Normal file
View File

@@ -0,0 +1,31 @@
Imports System.Reflection
Imports System.Runtime.InteropServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("")>
<Assembly: AssemblyCopyright("")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("FC6A4A67-59F2-4C89-8B0E-07C650FC448E")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
<Assembly: AssemblyVersion("1.0.*")>

32
source/csla10/BatchQueueTest/BatchQueueTest.vbproj Normal file
View File

@@ -0,0 +1,32 @@
<VisualStudioProject>
<VisualBasic ProjectType="Local" ProductVersion="7.0.9466" SchemaVersion="1.0" ProjectGuid="{B517A542-01E9-4BBE-8C76-D99467257B70}">
<Build>
<Settings ApplicationIcon="" AssemblyKeyContainerName="" AssemblyName="BatchQueueTest" AssemblyOriginatorKeyFile="" AssemblyOriginatorKeyMode="None" DefaultClientScript="JScript" DefaultHTMLPageLayout="Grid" DefaultTargetSchema="IE50" DelaySign="false" OutputType="Exe" OptionCompare="Binary" OptionExplicit="On" OptionStrict="Off" RootNamespace="BatchQueueTest" StartupObject="BatchQueueTest.Module1">
<Config Name="Debug" BaseAddress="285212672" ConfigurationOverrideFile="" DefineConstants="" DefineDebug="true" DefineTrace="true" DebugSymbols="true" IncrementalBuild="true" Optimize="false" OutputPath="bin\" RegisterForComInterop="false" RemoveIntegerChecks="false" TreatWarningsAsErrors="false" WarningLevel="1" />
<Config Name="Release" BaseAddress="285212672" ConfigurationOverrideFile="" DefineConstants="" DefineDebug="false" DefineTrace="true" DebugSymbols="false" IncrementalBuild="false" Optimize="true" OutputPath="bin\" RegisterForComInterop="false" RemoveIntegerChecks="false" TreatWarningsAsErrors="false" WarningLevel="1" />
</Settings>
<References>
<Reference Name="System" AssemblyName="System" />
<Reference Name="System.Data" AssemblyName="System.Data" />
<Reference Name="System.XML" AssemblyName="System.Xml" />
<Reference Name="CSLA" Project="{1B9A38BB-461A-47A4-AD72-099C694138A0}" Package="{F184B08F-C81C-45F6-A57F-5ABD9991F28F}" />
<Reference Name="CSLA.Core.Bindablebase" Project="{C2392355-12A9-4197-A1D3-603C390B1E62}" Package="{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}" />
<Reference Name="CSLA.BatchQueue" Project="{F8E2709C-E0DE-4253-9A1A-59F4F59B0EBD}" Package="{F184B08F-C81C-45F6-A57F-5ABD9991F28F}" />
</References>
<Imports>
<Import Namespace="Microsoft.VisualBasic" />
<Import Namespace="System" />
<Import Namespace="System.Collections" />
<Import Namespace="System.Data" />
<Import Namespace="System.Diagnostics" />
</Imports>
</Build>
<Files>
<Include>
<File RelPath="AssemblyInfo.vb" SubType="Code" BuildAction="Compile" />
<File RelPath="Module1.vb" SubType="Code" BuildAction="Compile" />
</Include>
</Files>
</VisualBasic>
</VisualStudioProject>

7
source/csla10/BatchQueueTest/Module1.vb Normal file
View File

@@ -0,0 +1,7 @@
Module Module1
Sub Main()
End Sub
End Module

1
source/csla10/CSLA.BatchQueue/.cvsignore Normal file
View File

@@ -0,0 +1 @@
CSLA.BatchQueue.xml

32
source/csla10/CSLA.BatchQueue/AssemblyInfo.vb Normal file
View File

@@ -0,0 +1,32 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("CSLA.BatchQueue")>
<Assembly: AssemblyDescription("CSLA .NET framework")>
<Assembly: AssemblyCompany("Rockford Lhotka")>
<Assembly: AssemblyProduct("Expert One-on-One VB.NET Business Objects")>
<Assembly: AssemblyCopyright("Copyright 2003 Rockford Lhotka. All rights reserved.")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("EC45E25E-E411-4477-95FE-1F10004502E0")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
<Assembly: AssemblyVersion("1.3.*")>

49
source/csla10/CSLA.BatchQueue/BatchEntries.vb Normal file
View File

@@ -0,0 +1,49 @@
Imports System.Messaging
Imports System.Runtime.Serialization.Formatters.Binary
''' <summary>
''' Contains a list of holding, pending and active batch
''' queue entries.
''' </summary>
<Serializable()> _
Public Class BatchEntries
Inherits CollectionBase
''' <summary>
''' Returns a reference to an object with information about
''' a specific batch queue entry.
''' </summary>
Default Public ReadOnly Property Entry(ByVal index As Integer) As BatchEntryInfo
Get
Return CType(list.Item(index), BatchEntryInfo)
End Get
End Property
''' <summary>
''' Returns a reference to an object with information about
''' a specific batch queue entry.
''' </summary>
''' <param name="ID">The ID value of the entry to return.</param>
Default Public ReadOnly Property Entry(ByVal ID As Guid) As BatchEntryInfo
Get
Dim obj As BatchEntryInfo
For Each obj In list
If obj.ID.Equals(ID) Then
Return obj
End If
Next
End Get
End Property
Friend Sub New()
' prevent direct creation
End Sub
Friend Sub Add(ByVal Value As BatchEntryInfo)
list.Add(Value)
End Sub
End Class

225
source/csla10/CSLA.BatchQueue/BatchEntry.vb Normal file
View File

@@ -0,0 +1,225 @@
Imports System.Security.Principal
Imports System.Configuration
''' <summary>
'''
''' </summary>
Namespace Server
''' <summary>
''' A batch queue entry.
''' </summary>
''' <remarks>
''' Each batch queue entry consists of basic information about
''' the entry, a Principal object (if you are using CSLA .NET
''' security), the actual worker object containing the code
''' to be run and an optional state object containing arbitrary
''' state data.
''' </remarks>
<Serializable()> _
Public NotInheritable Class BatchEntry
Private mInfo As New BatchEntryInfo
Private mPrincipal As IPrincipal = GetPrincipal()
Private mWorker As IBatchEntry
Private mState As Object
''' <summary>
''' Returns a reference to the object containing information
''' about this batch entry.
''' </summary>
Public ReadOnly Property Info() As BatchEntryInfo
Get
Return mInfo
End Get
End Property
''' <summary>
''' Returns a reference to the
''' <see cref="T:CSLA.Security.BusinessPrincipal" />
''' object for the user that submitted this entry.
''' </summary>
Public ReadOnly Property Principal() As IPrincipal
Get
Return mPrincipal
End Get
End Property
''' <summary>
''' Returns a reference to the worker object that
''' contains the code which is to be executed as
''' a batch process.
''' </summary>
Public Property Entry() As IBatchEntry
Get
Return mWorker
End Get
Set(ByVal Value As IBatchEntry)
mWorker = Value
End Set
End Property
''' <summary>
''' Returns a reference to the optional state object.
''' </summary>
''' <returns></returns>
Public Property State() As Object
Get
Return mState
End Get
Set(ByVal Value As Object)
mState = Value
End Set
End Property
#Region " Batch execution "
' this will run in a background thread in the
' thread pool
Friend Sub Execute(ByVal State As Object)
Dim oldPrincipal As IPrincipal
Try
' set this thread's principal to our user
oldPrincipal = Threading.Thread.CurrentPrincipal
SetPrincipal(mPrincipal)
Try
' now run the user's code
mWorker.Execute(mState)
Dim sb As New Text.StringBuilder()
With sb
.Append("Batch job completed")
.Append(vbCrLf)
.AppendFormat("Batch job: {0}", Me.ToString)
.Append(vbCrLf)
.AppendFormat("Job object: {0}", CType(mWorker, Object).ToString)
.Append(vbCrLf)
End With
System.Diagnostics.EventLog.WriteEntry( _
BatchQueueService.Name, sb.ToString, EventLogEntryType.Information)
Catch ex As Exception
Dim sb As New Text.StringBuilder()
With sb
.Append("Batch job failed due to execution error")
.Append(vbCrLf)
.AppendFormat("Batch job: {0}", Me.ToString)
.Append(vbCrLf)
.AppendFormat("Job object: {0}", CType(mWorker, Object).ToString)
.Append(vbCrLf)
.Append(ex.ToString)
End With
System.Diagnostics.EventLog.WriteEntry( _
BatchQueueService.Name, sb.ToString, EventLogEntryType.Warning)
End Try
Finally
Server.BatchQueueService.Deactivate(Me)
' reset the thread's principal object
Threading.Thread.CurrentPrincipal = oldPrincipal
End Try
End Sub
#End Region
#Region " System.Object overrides "
Public Overrides Function ToString() As String
Return mInfo.ToString
End Function
Public Overloads Function Equals(ByVal Entry As BatchEntry) As Boolean
Return mInfo.Equals(Entry.Info)
End Function
Public Overrides Function GetHashCode() As Integer
Return mInfo.GetHashCode
End Function
#End Region
#Region " Constructors "
Friend Sub New(ByVal Entry As IBatchEntry)
mWorker = Entry
End Sub
Friend Sub New(ByVal Entry As IBatchEntry, ByVal State As Object)
mWorker = Entry
mState = State
End Sub
#End Region
#Region " Security "
Private Function AUTHENTICATION() As String
Return ConfigurationSettings.AppSettings("Authentication")
End Function
Private Function GetPrincipal() As System.Security.Principal.IPrincipal
If AUTHENTICATION() = "Windows" Then
' Windows integrated security
Return Nothing
Else
' we assume using the CSLA framework security
Return System.Threading.Thread.CurrentPrincipal
End If
End Function
Private Sub SetPrincipal(ByVal Principal As Object)
If AUTHENTICATION() = "Windows" Then
' when using integrated security, Principal must be Nothing
' and we need to set our policy to use the Windows principal
If Principal Is Nothing Then
AppDomain.CurrentDomain.SetPrincipalPolicy(PrincipalPolicy.WindowsPrincipal)
Exit Sub
Else
Throw New System.Security.SecurityException("No principal object should be passed to DataPortal when using Windows integrated security")
End If
End If
' we expect Principal to be of type BusinessPrincipal, but
' we can't enforce that since it causes a circular reference
' with the business library so instead we must use type Object
' for the parameter, so here we do a check on the type of the
' parameter
If Principal.ToString = "CSLA.Security.BusinessPrincipal" 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 System.Security.SecurityException("Principal must be of type BusinessPrincipal, not " & Principal.ToString)
End If
End Sub
#End Region
End Class
End Namespace

185
source/csla10/CSLA.BatchQueue/BatchEntryInfo.vb Normal file
View File

@@ -0,0 +1,185 @@
Imports System.Environment
''' <summary>
''' Values indicating the status of a batch queue entry.
''' </summary>
Public Enum BatchEntryStatus
Pending
Holding
Active
End Enum
''' <summary>
''' Contains information about a batch queue entry.
''' </summary>
''' <remarks>
''' This object contains information about batch entry including
''' when it was submitted, the user that submitted the job and
''' which machine the user was using at the time. It also contains
''' the job's priority, status and the optional date/time until
''' which the job should be held until it is run.
''' </remarks>
<Serializable()> _
Public Class BatchEntryInfo
Private mID As Guid = Guid.NewGuid
Private mSubmitted As Date = Now
Private mUser As String = System.Environment.UserName
Private mMachine As String = System.Environment.MachineName
Private mPriority As Messaging.MessagePriority = Messaging.MessagePriority.Normal
Private mMsgID As String
Private mHoldUntil As Date = Date.MinValue
Private mStatus As BatchEntryStatus = BatchEntryStatus.Pending
''' <summary>
''' Returns the unique ID value for this batch entry.
''' </summary>
Public ReadOnly Property ID() As Guid
Get
Return mID
End Get
End Property
''' <summary>
''' Returns the date and time that the batch entry
''' was submitted.
''' </summary>
Public ReadOnly Property Submitted() As Date
Get
Return mSubmitted
End Get
End Property
''' <summary>
''' Returns the Windows user id of the user that
''' was logged into the workstation when the job
''' was submitted.
''' </summary>
Public ReadOnly Property User() As String
Get
Return mUser
End Get
End Property
''' <summary>
''' Returns the name of the workstation from
''' which this job was submitted.
''' </summary>
Public ReadOnly Property Machine() As String
Get
Return mMachine
End Get
End Property
''' <summary>
''' Returns the priority of this batch entry.
''' </summary>
''' <remarks>
''' The priority values flow from System.Messaging and
''' the priority is used by MSMQ to order the entries
''' in the queue.
''' </remarks>
Public Property Priority() As Messaging.MessagePriority
Get
Return mPriority
End Get
Set(ByVal Value As Messaging.MessagePriority)
mPriority = Value
End Set
End Property
''' <summary>
''' Returns the MSMQ message ID of the batch entry.
''' </summary>
''' <remarks>
''' This value is only valid after the batch entry
''' has been submitted to the queue.
''' </remarks>
Public ReadOnly Property MessageID() As String
Get
Return mMsgID
End Get
End Property
Friend Sub SetMessageID(ByVal ID As String)
mMsgID = ID
End Sub
''' <summary>
''' Returns the date and time until which the
''' batch entry will be held before it can be run.
''' </summary>
''' <remarks>
''' This value is optional. If it was provided, the batch
''' entry will be held until this date/time. At this date/time,
''' the entry will switch from Holding status to Pending
''' status and will be queued based on its priority along
''' with all other Pending entries.
''' </remarks>
Public Property HoldUntil() As Date
Get
Return mHoldUntil
End Get
Set(ByVal Value As Date)
mHoldUntil = Value
End Set
End Property
''' <summary>
''' Returns the status of the batch entry.
''' </summary>
''' <remarks>
''' <para>
''' If the job is Holding, it means that the job
''' won't run until the data/time specified by
''' <see cref="P:CSLA.BatchQueue.BatchEntryInfo.HoldUntil" />.
''' </para><para>
''' If the job is Pending, it means that the job
''' will run as soon as possible, but that the queue
''' is busy. Pending entries are run in priority order based
''' on <see cref="P:CSLA.BatchQueue.BatchEntryInfo.Priority" />.
''' </para><para>
''' If the job is Active, it means that the job is
''' currently being executed on the server.
''' </para>
''' </remarks>
Public ReadOnly Property Status() As BatchEntryStatus
Get
If mHoldUntil > Now AndAlso mStatus = BatchEntryStatus.Pending Then
Return BatchEntryStatus.Holding
Else
Return mStatus
End If
End Get
End Property
Friend Sub SetStatus(ByVal Status As BatchEntryStatus)
mStatus = Status
End Sub
#Region " System.Object overrides "
Public Overrides Function ToString() As String
Return mUser & "@" & mMachine & ":" & mID.ToString
End Function
Public Overloads Function Equals(ByVal Info As BatchEntryInfo) As Boolean
Return mID.Equals(Info.ID)
End Function
Public Overrides Function GetHashCode() As Integer
Return mID.GetHashCode
End Function
#End Region
End Class

97
source/csla10/CSLA.BatchQueue/BatchJobRequest.vb Normal file
View File

@@ -0,0 +1,97 @@
''' <summary>
''' A helper object used to execute a specified class
''' from a specified DLL on the server.
''' </summary>
''' <remarks>
''' <para>
''' A worker object can be provided directly by the client
''' workstation. In that case, the worker object is passed
''' by value to the server where it is executed. The drawback
''' to such an approach is that the worker assembly must be
''' installed on both client and server.
''' </para><para>
''' BatchJobRequest is a worker object that specifies the
''' type and assembly name of a class on the server. When
''' this job is run, it dynamically creates an instance of
''' the specified class and executes it on the server. This
''' means that the actual worker assembly needs to be installed
''' only on the server, not on the client.
''' </para>
''' </remarks>
<Serializable()> _
Public Class BatchJobRequest
Implements IBatchEntry
Private mAssembly As String = ""
Private mType As String = ""
''' <summary>
''' Creates a new object, specifying the type and assembly
''' of the actual worker object.
''' </summary>
''' <param name="Type">The class name of the actual worker object.</param>
''' <param name="Assembly">The name of the assembly containing the actual worker class.</param>
Public Sub New(ByVal Type As String, ByVal [Assembly] As String)
mAssembly = [Assembly]
mType = Type
End Sub
''' <summary>
''' The class name of the worker object.
''' </summary>
Public Property Type() As String
Get
Return mType
End Get
Set(ByVal Value As String)
mType = Value
End Set
End Property
''' <summary>
''' The name of the assembly containing the actual worker class.
''' </summary>
Public Property [Assembly]() As String
Get
Return mAssembly
End Get
Set(ByVal Value As String)
mAssembly = Value
End Set
End Property
''' <summary>
''' Executes the batch job on the server.
''' </summary>
''' <remarks>
''' This method runs on the server - it is called
''' by <see cref="T:CSLA.BatchQueue.Server.BatchEntry" />,
''' which is called by
''' <see cref="T:CSLA.BatchQueue.Server.BatchQueueService" />.
''' </remarks>
''' <param name="State"></param>
Public Sub Execute(ByVal State As Object) _
Implements IBatchEntry.Execute
' create an instance of the specified object
Dim job As IBatchEntry
job = CType(AppDomain.CurrentDomain.CreateInstanceAndUnwrap(mAssembly, mType), IBatchEntry)
' execute the job
job.Execute(State)
End Sub
#Region " System.Object overrides "
Public Overrides Function ToString() As String
Return "BatchJobRequest: " & mType & "," & mAssembly
End Function
#End Region
End Class

257
source/csla10/CSLA.BatchQueue/BatchQueue.vb Normal file
View File

@@ -0,0 +1,257 @@
Imports System.Runtime.Remoting.Channels
Imports System.Runtime.Remoting.Channels.Tcp
Imports System.Configuration
''' <summary>
''' Provides easy access to the batch queue functionality.
''' </summary>
''' <remarks>
''' Client code should create an instance of this class to
''' interact with a batch queue. A BatchQueue object can
''' be used to interact with either the default batch queue
''' server or with a specific batch queue server.
''' </remarks>
Public Class BatchQueue
Private mQueueURL As String
Private mServer As Server.BatchQueue
#Region " Constructors and Initialization "
''' <summary>
''' Creates an instance of the object that allows interaction
''' with the default batch queue server as specified in the
''' application configuration file.
''' </summary>
Public Sub New()
mQueueURL = ConfigurationSettings.AppSettings("DefaultBatchQueueServer")
End Sub
''' <summary>
''' Creates an instance of the object that allows interaction
''' with a specific batch queue server as specified by
''' the URL passed as a parameter.
''' </summary>
''' <param name="QueueServerURL">A URL referencing the batch queue server.</param>
Public Sub New(ByVal QueueServerURL As String)
mQueueURL = QueueServerURL
End Sub
Private Function QueueServer() As Server.BatchQueue
If mServer Is Nothing Then
mServer = _
CType(Activator.GetObject(GetType(Server.BatchQueue), _
mQueueURL), _
Server.BatchQueue)
End If
Return mServer
End Function
#End Region
#Region " Submitting jobs "
''' <summary>
''' Submits an entry to the batch queue.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
Public Sub Submit(ByVal Entry As IBatchEntry)
QueueServer.Submit(New Server.BatchEntry(Entry))
End Sub
''' <summary>
''' Submits an entry to the batch queue with extra state data.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="State">A reference to a serializable object containing state data.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, ByVal State As Object)
QueueServer.Submit(New Server.BatchEntry(Entry, State))
End Sub
''' <summary>
''' Submits an entry to the batch queue with a specific priority.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="Priority">The priority of the entry.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, _
ByVal Priority As Messaging.MessagePriority)
Dim job As Server.BatchEntry = New Server.BatchEntry(Entry)
job.Info.Priority = Priority
QueueServer.Submit(job)
End Sub
''' <summary>
''' Submits an entry to the batch queue with extra state data and
''' a specific priority.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="State">A reference to a serializable object containing state data.</param>
''' <param name="Priority">The priority of the entry.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, _
ByVal State As Object, _
ByVal Priority As Messaging.MessagePriority)
Dim job As Server.BatchEntry = New Server.BatchEntry(Entry, State)
job.Info.Priority = Priority
QueueServer.Submit(job)
End Sub
''' <summary>
''' Submits an entry to the batch queue to be held until a specific date/time.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="HoldUntil">The date/time until which the entry should be held.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, ByVal HoldUntil As Date)
Dim job As Server.BatchEntry = New Server.BatchEntry(Entry)
job.Info.HoldUntil = HoldUntil
QueueServer.Submit(job)
End Sub
''' <summary>
''' Submits an entry to the batch queue with extra state data
''' and to be held until a specific date/time.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="State">A reference to a serializable object containing state data.</param>
''' <param name="HoldUntil">The date/time until which the entry should be held.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, _
ByVal State As Object, _
ByVal HoldUntil As Date)
Dim job As Server.BatchEntry = New Server.BatchEntry(Entry, State)
job.Info.HoldUntil = HoldUntil
QueueServer.Submit(job)
End Sub
''' <summary>
''' Submits an entry to the batch queue to be held until
''' a specific date/time and at a specific priority.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="HoldUntil">The date/time until which the entry should be held.</param>
''' <param name="Priority">The priority of the entry.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, _
ByVal HoldUntil As Date, ByVal Priority As Messaging.MessagePriority)
Dim job As Server.BatchEntry = New Server.BatchEntry(Entry)
job.Info.HoldUntil = HoldUntil
job.Info.Priority = Priority
QueueServer.Submit(job)
End Sub
''' <summary>
''' Submits an entry to the batch queue specifying all details.
''' </summary>
''' <param name="Entry">A reference to your worker object.</param>
''' <param name="State">A reference to a serializable object containing state data.</param>
''' <param name="HoldUntil">The date/time until which the entry should be held.</param>
''' <param name="Priority">The priority of the entry.</param>
Public Sub Submit(ByVal Entry As IBatchEntry, _
ByVal State As Object, _
ByVal HoldUntil As Date, _
ByVal Priority As Messaging.MessagePriority)
Dim job As Server.BatchEntry = New Server.BatchEntry(Entry, State)
job.Info.HoldUntil = HoldUntil
job.Info.Priority = Priority
QueueServer.Submit(job)
End Sub
#End Region
#Region " Public methods "
''' <summary>
''' Removes a holding or pending entry from the
''' batch queue.
''' </summary>
''' <param name="Entry">A reference to the entry to be removed.</param>
Public Sub Remove(ByVal Entry As BatchEntryInfo)
QueueServer.Remove(Entry)
End Sub
''' <summary>
''' Returns the URL which identifies the batch
''' queue server to which this object is attached.
''' </summary>
Public ReadOnly Property BatchQueueURL() As String
Get
Return mQueueURL
End Get
End Property
''' <summary>
''' Returns a collection of the batch entries currently
''' in the batch queue.
''' </summary>
Public ReadOnly Property Entries() As BatchEntries
Get
Return QueueServer.GetEntries(GetPrincipal)
End Get
End Property
#End Region
#Region " System.Object overrides "
Public Overrides Function ToString() As String
Return mQueueURL
End Function
Public Overloads Function Equals(ByVal Queue As BatchQueue) As Boolean
Return mQueueURL = Queue.BatchQueueURL
End Function
Public Overrides Function GetHashCode() As Integer
Return mQueueURL.GetHashCode
End Function
#End Region
#Region " Security "
Private Function AUTHENTICATION() As String
Return ConfigurationSettings.AppSettings("Authentication")
End Function
Private Function GetPrincipal() As System.Security.Principal.IPrincipal
If AUTHENTICATION() = "Windows" Then
' Windows integrated security
Return Nothing
Else
' we assume using the CSLA framework security
Return System.Threading.Thread.CurrentPrincipal
End If
End Function
#End Region
End Class

103
source/csla10/CSLA.BatchQueue/BatchQueueServer.vb Normal file
View File

@@ -0,0 +1,103 @@
Imports System.Security.Principal
Imports System.Configuration
Imports CSLA.Security
''' <summary>
'''
''' </summary>
Namespace Server
''' <summary>
''' This is the entry point for all queue requests from
''' the client via Remoting.
''' </summary>
Public Class BatchQueue
Inherits MarshalByRefObject
#Region " Public methods "
''' <summary>
''' Submits a batch entry to the queue.
''' </summary>
''' <param name="Entry">A reference to the batch entry.</param>
Public Sub Submit(ByVal Entry As BatchEntry)
BatchQueueService.Enqueue(Entry)
End Sub
''' <summary>
''' Removes a holding or pending entry from the queue.
''' </summary>
''' <param name="Entry">A reference to the info object for the batch entry.</param>
Public Sub Remove(ByVal Entry As BatchEntryInfo)
BatchQueueService.Dequeue(Entry)
End Sub
''' <summary>
''' Gets a list of the entries currently in the
''' batch queue.
''' </summary>
''' <param name="Principal">The requesting user's security credentials.</param>
Public Function GetEntries(ByVal Principal As IPrincipal) As BatchEntries
SetPrincipal(Principal)
Dim entries As New BatchEntries()
BatchQueueService.LoadEntries(entries)
Return entries
End Function
#End Region
#Region " Security "
Private Function AUTHENTICATION() As String
Return ConfigurationSettings.AppSettings("Authentication")
End Function
Private Sub SetPrincipal(ByVal Principal As Object)
If AUTHENTICATION() = "Windows" Then
' when using integrated security, Principal must be Nothing
' and we need to set our policy to use the Windows principal
If Principal Is Nothing Then
AppDomain.CurrentDomain.SetPrincipalPolicy(PrincipalPolicy.WindowsPrincipal)
Exit Sub
Else
Throw New System.Security.SecurityException("No principal object should be passed to DataPortal when using Windows integrated security")
End If
End If
' we expect Principal to be of type BusinessPrincipal, but
' we can't enforce that since it causes a circular reference
' with the business library so instead we must use type Object
' for the parameter, so here we do a check on the type of the
' parameter
If Principal.ToString = "CSLA.Security.BusinessPrincipal" 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 System.Security.SecurityException("Principal must be of type BusinessPrincipal, not " & Principal.ToString)
End If
End Sub
#End Region
End Class
End Namespace

337
source/csla10/CSLA.BatchQueue/BatchQueueService.vb Normal file
View File

@@ -0,0 +1,337 @@
Imports System.Configuration
Imports System.Messaging
Imports System.Runtime.Remoting
Imports System.Runtime.Remoting.Channels
Imports System.Runtime.Remoting.Channels.Tcp
Imports System.IO
Imports System.Runtime.Serialization.Formatters.Binary
''' <summary>
'''
''' </summary>
Namespace Server
''' <summary>
''' Implements the batch queue service.
''' </summary>
''' <remarks>
''' This class implements the server-side batch queue functionality.
''' It must be hosted within some process, typically a Windows Service.
''' It may also be hosted within a console application, which is
''' useful for testing and debugging.
''' </remarks>
Public Class BatchQueueService
Private Shared mChannel As TcpServerChannel
Private Shared mQueue As MessageQueue
Private Shared mMonitor As Threading.Thread
Private Shared WithEvents mTimer As New System.Timers.Timer
Private Shared mRunning As Boolean
Private Shared mActiveEntries As Hashtable = Hashtable.Synchronized(New Hashtable)
Private Shared mSync As New Threading.AutoResetEvent(False)
Private Shared mWaitToEnd As New Threading.ManualResetEvent(False)
''' <summary>
''' Returns the name of the batch queue server.
''' </summary>
Public Shared ReadOnly Property Name() As String
Get
Return LISTENER_NAME()
End Get
End Property
#Region " Start/Stop "
''' <summary>
''' Starts the batch queue.
''' </summary>
''' <remarks>
''' Call this as your Windows Service starts up to
''' start the batch queue itself. This will cause
''' the queue to start listening for user requests
''' via remoting and to the MSMQ for queued jobs.
''' </remarks>
Public Shared Sub Start()
mTimer.AutoReset = False
' open and/or create queue
If MessageQueue.Exists(QUEUE_NAME) Then
mQueue = New MessageQueue(QUEUE_NAME)
Else
mQueue = MessageQueue.Create(QUEUE_NAME)
End If
mQueue.MessageReadPropertyFilter.Extension = True
' start reading from queue
mRunning = True
mMonitor = New Threading.Thread(AddressOf MonitorQueue)
mMonitor.Name = "MonitorQueue"
mMonitor.Start()
' start remoting for Server.BatchQueue
If mChannel Is Nothing Then
' set application name (virtual root name)
RemotingConfiguration.ApplicationName = LISTENER_NAME()
' set up channel
Dim properties As New Hashtable()
properties("name") = "TcpBinary"
properties("priority") = "2"
properties("port") = CStr(PORT())
Dim svFormatter As New BinaryServerFormatterSinkProvider()
'TODO: uncomment the following line for .NET 1.1
'svFormatter.TypeFilterLevel = Runtime.Serialization.Formatters.TypeFilterLevel.Full
mChannel = New TcpServerChannel(properties, svFormatter)
Channels.ChannelServices.RegisterChannel(mChannel)
' register our class
RemotingConfiguration.RegisterWellKnownServiceType( _
GetType(Server.BatchQueue), _
"BatchQueue.rem", _
WellKnownObjectMode.SingleCall)
Else
mChannel.StartListening(Nothing)
End If
Dim sb As New Text.StringBuilder()
sb.Append("Batch queue processor started")
sb.Append(vbCrLf)
sb.AppendFormat("Name: {0}", Name)
sb.Append(vbCrLf)
sb.AppendFormat("Port: {0}", PORT)
sb.Append(vbCrLf)
sb.AppendFormat("Queue: {0}", QUEUE_NAME)
sb.Append(vbCrLf)
sb.AppendFormat("Max jobs: {0}", MAX_ENTRIES)
sb.Append(vbCrLf)
System.Diagnostics.EventLog.WriteEntry( _
Name, sb.ToString, EventLogEntryType.Information)
End Sub
''' <summary>
''' Stops the batch queue.
''' </summary>
''' <remarks>
''' <para>
''' Call this as your Windows Service is stopping. It
''' stops the batch queue, causing it to stop listening
''' for user requests via remoting and to stop looking for
''' jobs in the MSMQ queue.
''' </para><para>
''' NOTE that this method will not return until any
''' currently active (executing) batch jobs have completed.
''' </para>
''' </remarks>
Public Shared Sub [Stop]()
' stop remoting for Server.BatchQueue
mChannel.StopListening(Nothing)
' signal to stop working
mRunning = False
mSync.Set()
mMonitor.Join()
' close the queue
mQueue.Close()
If mActiveEntries.Count > 0 Then
' wait for work to end
mWaitToEnd.WaitOne()
End If
End Sub
#End Region
#Region " Process messages "
' this will be running on a background thread
Private Shared Sub MonitorQueue()
While mRunning
ScanQueue()
mSync.WaitOne()
End While
End Sub
' this runs on a threadpool thread
Private Shared Sub mTimer_Elapsed(ByVal sender As Object, _
ByVal e As System.Timers.ElapsedEventArgs) Handles mTimer.Elapsed
mTimer.Stop()
mSync.Set()
End Sub
' this is called by MonitorQueue
Private Shared Sub ScanQueue()
Dim msg As Message
Dim holdUntil As Date
Dim nextWake As Date = Date.MaxValue
Dim en As MessageEnumerator = mQueue.GetMessageEnumerator
While en.MoveNext()
msg = en.Current
holdUntil = CDate(Text.Encoding.ASCII.GetString(msg.Extension))
If holdUntil <= Now Then
If mActiveEntries.Count < MAX_ENTRIES() Then
ProcessEntry(mQueue.ReceiveById(msg.Id))
Else
' the queue is busy, go to sleep
Exit Sub
End If
ElseIf holdUntil < nextWake Then
' find the minimum holduntil value
nextWake = holdUntil
End If
End While
If nextWake < Date.MaxValue AndAlso nextWake > Now Then
' we have at least one entry holding, so set the
' timer to wake us when it should be run
mTimer.Interval = nextWake.Subtract(Now).TotalMilliseconds
mTimer.Start()
End If
End Sub
Private Shared Sub ProcessEntry(ByVal msg As Message)
' get entry from queue
Dim entry As BatchEntry
Dim formatter As New BinaryFormatter()
entry = CType(formatter.Deserialize(msg.BodyStream), BatchEntry)
' make active
entry.Info.SetStatus(BatchEntryStatus.Active)
mActiveEntries.Add(entry.Info.ID, entry.Info)
' start processing entry on background thread
Threading.ThreadPool.QueueUserWorkItem(AddressOf entry.Execute)
End Sub
' called by BatchEntry when it is done processing so
' we know that it is complete and we can start another
' job if needed
Friend Shared Sub Deactivate(ByVal entry As BatchEntry)
mActiveEntries.Remove(entry.Info.ID)
mSync.Set()
If Not mRunning AndAlso mActiveEntries.Count = 0 Then
' indicate that there are no active workers
mWaitToEnd.Set()
End If
End Sub
#End Region
#Region " Enqueue/Dequeue/LoadEntries "
Friend Shared Sub Enqueue(ByVal Entry As BatchEntry)
Dim msg As New Message()
Dim f As New BinaryFormatter()
With msg
.Label = Entry.ToString
.Priority = Entry.Info.Priority
.Extension = Text.Encoding.ASCII.GetBytes(CStr(Entry.Info.HoldUntil))
Entry.Info.SetMessageID(.Id)
f.Serialize(.BodyStream, Entry)
End With
mQueue.Send(msg)
mSync.Set()
End Sub
Friend Shared Sub Dequeue(ByVal Entry As BatchEntryInfo)
Dim label As String
Dim msg As Message
Dim msgID As String
label = Entry.ToString
Dim en As MessageEnumerator = mQueue.GetMessageEnumerator
mQueue.MessageReadPropertyFilter.Label = True
While en.MoveNext()
If en.Current.Label = label Then
' we found a match
msgID = en.Current.Id
Exit While
End If
End While
If Len(msgID) > 0 Then
mQueue.ReceiveById(msgID)
End If
End Sub
Friend Shared Sub LoadEntries(ByVal List As BatchEntries)
' load our list of BatchEntry objects
Dim msgs() As Message
Dim msg As Message
Dim formatter As New BinaryFormatter()
Dim de As DictionaryEntry
Dim entry As Server.BatchEntry
' get all active entries
SyncLock mActiveEntries.SyncRoot
For Each de In Server.BatchQueueService.mActiveEntries
List.Add(CType(de.Value, BatchEntryInfo))
Next
End SyncLock
' get all queued entries
msgs = mQueue.GetAllMessages
For Each msg In msgs
entry = CType(formatter.Deserialize(msg.BodyStream), Server.BatchEntry)
entry.Info.SetMessageID(msg.Id)
List.Add(entry.Info)
Next
End Sub
#End Region
#Region " Utility functions "
Private Shared Function QUEUE_NAME() As String
Return ".\private$\" & ConfigurationSettings.AppSettings("QueueName")
End Function
Private Shared Function LISTENER_NAME() As String
Return ConfigurationSettings.AppSettings("ListenerName")
End Function
Private Shared Function PORT() As Integer
Return CInt(ConfigurationSettings.AppSettings("ListenerPort"))
End Function
Private Shared Function MAX_ENTRIES() As Integer
Return CInt(ConfigurationSettings.AppSettings("MaxActiveEntries"))
End Function
#End Region
End Class
End Namespace

137
source/csla10/CSLA.BatchQueue/CSLA.BatchQueue.vbproj Normal file
View File

@@ -0,0 +1,137 @@
<Project DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectType>Local</ProjectType>
<ProductVersion>8.0.50727</ProductVersion>
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>{F8E2709C-E0DE-4253-9A1A-59F4F59B0EBD}</ProjectGuid>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ApplicationIcon>
</ApplicationIcon>
<AssemblyKeyContainerName>
</AssemblyKeyContainerName>
<AssemblyName>CSLA.BatchQueue</AssemblyName>
<AssemblyOriginatorKeyFile>
</AssemblyOriginatorKeyFile>
<AssemblyOriginatorKeyMode>None</AssemblyOriginatorKeyMode>
<DefaultClientScript>JScript</DefaultClientScript>
<DefaultHTMLPageLayout>Grid</DefaultHTMLPageLayout>
<DefaultTargetSchema>IE50</DefaultTargetSchema>
<DelaySign>false</DelaySign>
<OutputType>Library</OutputType>
<OptionCompare>Binary</OptionCompare>
<OptionExplicit>On</OptionExplicit>
<OptionStrict>Off</OptionStrict>
<RootNamespace>CSLA.BatchQueue</RootNamespace>
<StartupObject>
</StartupObject>
<FileUpgradeFlags>
</FileUpgradeFlags>
<MyType>Windows</MyType>
<UpgradeBackupLocation>
</UpgradeBackupLocation>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<OutputPath>bin\</OutputPath>
<DocumentationFile>CSLA.BatchQueue.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>true</DebugSymbols>
<Optimize>false</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032</NoWarn>
<DebugType>full</DebugType>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<OutputPath>bin\</OutputPath>
<DocumentationFile>CSLA.BatchQueue.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>false</DebugSymbols>
<Optimize>true</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032</NoWarn>
<DebugType>none</DebugType>
</PropertyGroup>
<ItemGroup>
<Reference Include="System">
<Name>System</Name>
</Reference>
<Reference Include="System.Data">
<Name>System.Data</Name>
</Reference>
<Reference Include="System.Messaging">
<Name>System.Messaging</Name>
</Reference>
<Reference Include="System.Runtime.Remoting">
<Name>System.Runtime.Remoting</Name>
</Reference>
<Reference Include="System.Xml">
<Name>System.XML</Name>
</Reference>
<ProjectReference Include="..\CSLA\CSLA.vbproj">
<Name>CSLA</Name>
<Project>{1B9A38BB-461A-47A4-AD72-099C694138A0}</Project>
<Package>{F184B08F-C81C-45F6-A57F-5ABD9991F28F}</Package>
</ProjectReference>
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
</ItemGroup>
<ItemGroup>
<Compile Include="AssemblyInfo.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="BatchEntries.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="BatchEntry.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="BatchEntryInfo.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="BatchJobRequest.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="BatchQueue.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="BatchQueueServer.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="BatchQueueService.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="IBatchEntry.vb">
<SubType>Code</SubType>
</Compile>
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Microsoft.VisualBasic.targets" />
<PropertyGroup>
<PreBuildEvent>
</PreBuildEvent>
<PostBuildEvent>
</PostBuildEvent>
</PropertyGroup>
</Project>

58
source/csla10/CSLA.BatchQueue/CSLA.BatchQueue.vbproj.user Normal file
View File

@@ -0,0 +1,58 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<LastOpenVersion>7.10.3077</LastOpenVersion>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ReferencePath>
</ReferencePath>
<CopyProjectDestinationFolder>
</CopyProjectDestinationFolder>
<CopyProjectUncPath>
</CopyProjectUncPath>
<CopyProjectOption>0</CopyProjectOption>
<ProjectView>ProjectFiles</ProjectView>
<ProjectTrust>0</ProjectTrust>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
</Project>

18
source/csla10/CSLA.BatchQueue/IBatchEntry.vb Normal file
View File

@@ -0,0 +1,18 @@
''' <summary>
''' Defines the interface that must be implemented by
''' all worker classes.
''' </summary>
''' <remarks>
''' To create a worker that can be executed within the
''' batch queue, implement this interface. The interface
''' will be invoked by the batch queue processor on the
''' server.
''' </remarks>
Public Interface IBatchEntry
''' <summary>
''' This method should contain your worker code that
''' is to be run in the batch queue.
''' </summary>
''' <param name="State">An optional object containing extra state data from the client.</param>
Sub Execute(ByVal State As Object)
End Interface

1
source/csla10/CSLA.BatchQueue/obj/CSLA.BatchQueue.vbproj.FileList.txt Normal file
View File

@@ -0,0 +1 @@
obj\Release\ResolveAssemblyReference.cache

BIN
source/csla10/CSLA.BatchQueue/obj/Release/ResolveAssemblyReference.cache Normal file
View File

Binary file not shown.

0
source/csla10/CSLA.BatchQueue/obj/Release/build.force Normal file
View File

1
source/csla10/CSLA.Core.Bindablebase/.cvsignore Normal file
View File

@@ -0,0 +1 @@
CSLA.Core.BindableBase.xml

60
source/csla10/CSLA.Core.Bindablebase/AssemblyInfo.cs Normal file
View File

@@ -0,0 +1,60 @@
using System.Reflection;
using System.Runtime.CompilerServices;
//
// General Information about an assembly is controlled through the following
// set of attributes. Change these attribute values to modify the information
// associated with an assembly.
//
[assembly: AssemblyTitle("CSLA.Core.BindableBase")]
[assembly: AssemblyDescription("CSLA .NET framework MODIFIED FROM ORIGINAL SIGNIFICANTLY")]
[assembly: AssemblyConfiguration("")]
[assembly: AssemblyCompany("Rockford Lhotka MODIFIED FROM ORIGINAL SIGNIFICANTLY")]
[assembly: AssemblyProduct("")]
[assembly: AssemblyCopyright("Copyright 2003 Rockford Lhotka. All rights reserved.")]
[assembly: AssemblyTrademark("")]
[assembly: AssemblyCulture("")]
//
// Version information for an assembly consists of the following four values:
//
// Major Version
// Minor Version
// Build Number
// Revision
//
// You can specify all the values or you can default the Revision and Build Numbers
// by using the '*' as shown below:
[assembly: AssemblyVersion("7.5.0.0")]
//
// In order to sign your assembly you must specify a key to use. Refer to the
// Microsoft .NET Framework documentation for more information on assembly signing.
//
// Use the attributes below to control which key is used for signing.
//
// Notes:
// (*) If no key is specified, the assembly is not signed.
// (*) KeyName refers to a key that has been installed in the Crypto WorkorderService
// Provider (CSP) on your machine. KeyFile refers to a file which contains
// a key.
// (*) If the KeyFile and the KeyName values are both specified, the
// following processing occurs:
// (1) If the KeyName can be found in the CSP, that key is used.
// (2) If the KeyName does not exist and the KeyFile does exist, the key
// in the KeyFile is installed into the CSP and used.
// (*) In order to create a KeyFile, you can use the sn.exe (Strong Name) utility.
// When specifying the KeyFile, the location of the KeyFile should be
// relative to the project output directory which is
// %Project Directory%\obj\<configuration>. For example, if your KeyFile is
// located in the project directory, you would specify the AssemblyKeyFile
// attribute as [assembly: AssemblyKeyFile("..\\..\\mykey.snk")]
// (*) Delay Signing is an advanced option - see the Microsoft .NET Framework
// documentation for more information on this.
//
//[assembly: AssemblyDelaySign(false)]
//[assembly: AssemblyKeyFile("..\\..\\..\\..\\..\\keys\\AyaNova.snk")]
//[assembly: AssemblyKeyName("")]
//[assembly:System.CLSCompliant(true)]
[assembly: AssemblyFileVersionAttribute("7.5.0.0")]

27
source/csla10/CSLA.Core.Bindablebase/BindableBase.cs Normal file
View File

@@ -0,0 +1,27 @@
using System;
namespace CSLA.Core
{
/// <summary>
/// This base class declares the IsDirtyChanged event
/// to be NonSerialized so serialization will work.
/// </summary>
[Serializable()]
public abstract class BindableBase
{
/// <summary>
/// Declares a serialization-safe IsDirtyChanged event.
/// </summary>
[field: NonSerialized]
public event EventHandler IsDirtyChanged;
/// <summary>
/// Call this method to raise the IsDirtyChanged event.
/// </summary>
virtual protected void OnIsDirtyChanged()
{
if (IsDirtyChanged != null)
IsDirtyChanged(this, EventArgs.Empty);
}
}
}

242
source/csla10/CSLA.Core.Bindablebase/BindableCollectionBase.cs Normal file
View File

@@ -0,0 +1,242 @@
using System;
using System.Collections;
using System.ComponentModel;
namespace CSLA.Core
{
/// <summary>
/// This is a base class that exposes an implementation
/// of IBindableList that does nothing other than
/// create a nonserialized version of the listchanged
/// event.
/// </summary>
[Serializable]
public abstract class BindableCollectionBase : CollectionBase, IBindingList
{
#region Protected control variables
/// <summary>
/// Set this to True to allow data binding to add new
/// child objects to the collection.
/// </summary>
/// <remarks>
/// If you set this to True, you must also override the OnAddNew
/// method. You must also set AllowEdit to True.
/// </remarks>
protected bool AllowNew = false;
/// <summary>
/// Set this to True to allow data binding to do in-place
/// editing of child objects in a grid control.
/// </summary>
protected bool AllowEdit = false;
/// <summary>
/// Set this to True to allow data binding to automatically
/// remove child objects from the collection.
/// </summary>
protected bool AllowRemove = false;
/// <summary>
/// Set this to True to allow this collection to be sorted.
/// </summary>
/// <remarks>
/// <para>
/// There is an overhead cost to enabling sorting. Specifically,
/// the collection must contain an internal collection containing
/// the original order of the items in the collection, so the order
/// can be reset if the sort is removed.
/// </para><para>
/// This overhead is only incurred if AllowSort is set to True, and is
/// only a major concern if you are using a remote DataPortal. The concern
/// there is that this extra collection must also be serialized, thus
/// increasing the overall amount of data sent across the wire.
/// </para>
/// </remarks>
protected bool AllowSort = false;
/// <summary>
/// Set this to True to allow this collection to be
/// searched.
/// </summary>
protected bool AllowFind = false;
#endregion
#region ListChanged event
/// <summary>
/// Declares a serialization-safe ListChanged event.
/// </summary>
[field: NonSerialized]
public event System.ComponentModel.ListChangedEventHandler ListChanged;
/// <summary>
/// Call this method to raise the ListChanged event.
/// </summary>
virtual protected void OnListChanged(System.ComponentModel.ListChangedEventArgs e)
{
if (ListChanged != null)
ListChanged(this, e);
}
#endregion
#region Collection events
// *******************************************************************
/// <summary>
/// Ensures that the OnListChanged event is raised when a
/// new child is inserted.
/// </summary>
override protected void OnInsertComplete(int index, object value)
{
OnListChanged(new ListChangedEventArgs(ListChangedType.ItemAdded, index));
}
/// <summary>
/// Ensures that the OnListChanged event is raised when the
/// list is cleared.
/// </summary>
override protected void OnClearComplete()
{
OnListChanged(new ListChangedEventArgs(ListChangedType.Reset, 0));
}
/// <summary>
/// Ensures that the OnListChanged event is raised when an
/// item is removed.
/// </summary>
override protected void OnRemoveComplete(int index, object value)
{
OnListChanged(new ListChangedEventArgs(ListChangedType.ItemDeleted, index));
}
/// <summary>
/// Ensures that the OnListChanged event is raised when an
/// item is changed.
/// </summary>
override protected void OnSetComplete(int index, object oldValue, object newValue)
{
OnListChanged(new ListChangedEventArgs(ListChangedType.ItemChanged, index));
}
#endregion
#region IBindingList interface
// *******************************************************************
// This is most of the IBindingList interface.
// Notice that each of these implementations merely
// calls a virtual method, so subclasses can override those
// methods and provide the actual implementation of the interface
object IBindingList.AddNew() { return OnAddNew(); }
bool IBindingList.AllowEdit { get { return AllowEdit; } }
bool IBindingList.AllowNew { get { return AllowNew; } }
bool IBindingList.AllowRemove { get { return AllowRemove; } }
bool IBindingList.SupportsSearching { get { return AllowFind; } }
bool IBindingList.SupportsSorting { get { return AllowSort; } }
bool IBindingList.SupportsChangeNotification { get { return true; } }
int IBindingList.Find(System.ComponentModel.PropertyDescriptor property, object key)
{
return IBindingList_Find(property, key);
}
void IBindingList.AddIndex(System.ComponentModel.PropertyDescriptor property) {}
void IBindingList.RemoveIndex(System.ComponentModel.PropertyDescriptor property) {}
void IBindingList.ApplySort(System.ComponentModel.PropertyDescriptor property, System.ComponentModel.ListSortDirection direction)
{
IBindingList_ApplySort(property, direction);
}
void IBindingList.RemoveSort()
{
IBindingList_RemoveSort();
}
bool IBindingList.IsSorted { get { return IBindingList_IsSorted; } }
System.ComponentModel.ListSortDirection IBindingList.SortDirection { get { return IBindingList_SortDirection; } }
System.ComponentModel.PropertyDescriptor IBindingList.SortProperty { get { return IBindingList_SortProperty; } }
#endregion
#region OnAddNew
// *******************************************************************
// The following methods allow a subclass to actually provide
// the implementation of adding a new child object
/// <summary>
/// Override this method to allow data binding to automatically
/// add new child objects to a collection.
/// </summary>
/// <returns></returns>
virtual protected object OnAddNew() { return null; }
#endregion
#region Search/Find
// *******************************************************************
// The following methods allow a subclass to actually provide
// the implementation of IBindingList searching
/// <summary>
/// Override this method to implement search/find functionality
/// for the collection.
/// </summary>
/// <param name="property">The property to search.</param>
/// <param name="key">The value to searched for.</param>
/// <returns></returns>
protected virtual int IBindingList_Find(PropertyDescriptor property, object key)
{
return -1;
}
#endregion
#region Sorting
// *******************************************************************
// The following methods allow a subclass to actually provide
// the implementation of IBindingList sorting
/// <summary>
/// Override this method to indicate whether your collection
/// is currently sorted. This returns False by default.
/// </summary>
protected virtual bool IBindingList_IsSorted
{ get{ return false;}}
/// <summary>
/// Override this method to return the property by which
/// the collection is sorted (if you implement sorting).
/// </summary>
protected virtual System.ComponentModel.PropertyDescriptor IBindingList_SortProperty
{ get{ return null;}}
/// <summary>
/// Override this method to return the current sort direction
/// (if you implement sorting).
/// </summary>
protected virtual ListSortDirection IBindingList_SortDirection
{ get{ return ListSortDirection.Ascending;}}
/// <summary>
/// Override this method to provide sorting functionality
/// (if you implement sorting).
/// </summary>
/// <param name="property">The property on which to sort.</param>
/// <param name="direction">The sort direction.</param>
protected virtual void IBindingList_ApplySort(PropertyDescriptor property, ListSortDirection direction) {}
/// <summary>
/// Override this method to remove any existing sort
/// (if you implement sorting).
/// </summary>
protected virtual void IBindingList_RemoveSort() {}
#endregion
}
}

124
source/csla10/CSLA.Core.Bindablebase/CSLA.Core.Bindablebase.csproj Normal file
View File

@@ -0,0 +1,124 @@
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003" ToolsVersion="4.0">
<PropertyGroup>
<ProjectType>Local</ProjectType>
<ProductVersion>9.0.30729</ProductVersion>
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>{C2392355-12A9-4197-A1D3-603C390B1E62}</ProjectGuid>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ApplicationIcon>
</ApplicationIcon>
<AssemblyKeyContainerName>
</AssemblyKeyContainerName>
<AssemblyName>CSLA.Core.Bindablebase</AssemblyName>
<AssemblyOriginatorKeyFile>..\..\..\keys\AyaNova.snk</AssemblyOriginatorKeyFile>
<DefaultClientScript>JScript</DefaultClientScript>
<DefaultHTMLPageLayout>Grid</DefaultHTMLPageLayout>
<DefaultTargetSchema>IE50</DefaultTargetSchema>
<DelaySign>false</DelaySign>
<OutputType>Library</OutputType>
<RootNamespace>CSLA.Core.Bindablebase</RootNamespace>
<RunPostBuildEvent>OnBuildSuccess</RunPostBuildEvent>
<StartupObject>
</StartupObject>
<FileUpgradeFlags>
</FileUpgradeFlags>
<UpgradeBackupLocation>
</UpgradeBackupLocation>
<SignAssembly>true</SignAssembly>
<OldToolsVersion>3.5</OldToolsVersion>
<TargetFrameworkVersion>v4.0</TargetFrameworkVersion>
<TargetFrameworkProfile>
</TargetFrameworkProfile>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<OutputPath>bin\Debug\</OutputPath>
<AllowUnsafeBlocks>false</AllowUnsafeBlocks>
<BaseAddress>285212672</BaseAddress>
<CheckForOverflowUnderflow>false</CheckForOverflowUnderflow>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>DEBUG;TRACE</DefineConstants>
<DocumentationFile>CSLA.Core.BindableBase.xml</DocumentationFile>
<DebugSymbols>true</DebugSymbols>
<FileAlignment>4096</FileAlignment>
<NoStdLib>false</NoStdLib>
<NoWarn>
</NoWarn>
<Optimize>false</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>4</WarningLevel>
<DebugType>full</DebugType>
<ErrorReport>prompt</ErrorReport>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<OutputPath>bin\Release\</OutputPath>
<AllowUnsafeBlocks>false</AllowUnsafeBlocks>
<BaseAddress>285212672</BaseAddress>
<CheckForOverflowUnderflow>false</CheckForOverflowUnderflow>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>TRACE</DefineConstants>
<DocumentationFile>
</DocumentationFile>
<DebugSymbols>false</DebugSymbols>
<FileAlignment>4096</FileAlignment>
<NoStdLib>false</NoStdLib>
<NoWarn>
</NoWarn>
<Optimize>true</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>4</WarningLevel>
<DebugType>none</DebugType>
<ErrorReport>prompt</ErrorReport>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'RELEASE AND DEPLOY BUILD|AnyCPU' ">
<OutputPath>bin\RELEASE AND DEPLOY BUILD\</OutputPath>
<DefineConstants>TRACE</DefineConstants>
<BaseAddress>285212672</BaseAddress>
<Optimize>true</Optimize>
<DebugType>
</DebugType>
<PlatformTarget>AnyCPU</PlatformTarget>
<ErrorReport>prompt</ErrorReport>
</PropertyGroup>
<ItemGroup>
<Reference Include="System">
<Name>System</Name>
</Reference>
<Reference Include="System.Data">
<Name>System.Data</Name>
</Reference>
<Reference Include="System.Xml">
<Name>System.XML</Name>
</Reference>
</ItemGroup>
<ItemGroup>
<Compile Include="AssemblyInfo.cs">
<SubType>Code</SubType>
</Compile>
<Compile Include="BindableBase.cs">
<SubType>Code</SubType>
</Compile>
<Compile Include="BindableCollectionBase.cs">
<SubType>Code</SubType>
</Compile>
</ItemGroup>
<ItemGroup>
<None Include="..\..\..\keys\AyaNova.snk">
<Link>AyaNova.snk</Link>
</None>
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Microsoft.CSharp.targets" />
<PropertyGroup>
<PreBuildEvent>
</PreBuildEvent>
<PostBuildEvent>
</PostBuildEvent>
</PropertyGroup>
</Project>

59
source/csla10/CSLA.Core.Bindablebase/CSLA.Core.Bindablebase.csproj.user Normal file
View File

@@ -0,0 +1,59 @@
<?xml version="1.0" encoding="utf-8"?>
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<LastOpenVersion>7.10.3077</LastOpenVersion>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ReferencePath>
</ReferencePath>
<CopyProjectDestinationFolder>
</CopyProjectDestinationFolder>
<CopyProjectUncPath>
</CopyProjectUncPath>
<CopyProjectOption>0</CopyProjectOption>
<ProjectView>ProjectFiles</ProjectView>
<ProjectTrust>0</ProjectTrust>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
</Project>

1
source/csla10/CSLA.Server.DataPortal/.cvsignore Normal file
View File

@@ -0,0 +1 @@
CSLA.Server.DataPortal.xml

38
source/csla10/CSLA.Server.DataPortal/AssemblyInfo.vb Normal file
View File

@@ -0,0 +1,38 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("CSLA.Server.DataPortal")>
<Assembly: AssemblyDescription("CSLA .NET framework MODIFIED FROM ORIGINAL SIGNIFICANTLY")>
<Assembly: AssemblyCompany("Rockford Lhotka MODIFIED FROM ORIGINAL SIGNIFICANTLY")>
<Assembly: AssemblyProduct("")>
<Assembly: AssemblyCopyright("Copyright 2003 Rockford Lhotka. All rights reserved.")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("1E5537B9-A381-4E20-8869-47FBAC978A2D")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
<Assembly: AssemblyVersion("7.5.0.0")>
' strong name
'<Assembly: AssemblyKeyFile("..\..\..\..\..\keys\AyaNova.snk")>
<Assembly: AssemblyFileVersionAttribute("7.5.0.0")>

181
source/csla10/CSLA.Server.DataPortal/CSLA.Server.DataPortal.vbproj Normal file
View File

@@ -0,0 +1,181 @@
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003" ToolsVersion="4.0">
<PropertyGroup>
<ProjectType>Local</ProjectType>
<ProductVersion>9.0.21022</ProductVersion>
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>{80828E2C-E9FB-4E73-A27C-7F9CDB96FCDE}</ProjectGuid>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ApplicationIcon>
</ApplicationIcon>
<AssemblyKeyContainerName>
</AssemblyKeyContainerName>
<AssemblyName>CSLA.Server.DataPortal</AssemblyName>
<AssemblyOriginatorKeyFile>..\..\..\keys\AyaNova.snk</AssemblyOriginatorKeyFile>
<AssemblyOriginatorKeyMode>None</AssemblyOriginatorKeyMode>
<DefaultClientScript>JScript</DefaultClientScript>
<DefaultHTMLPageLayout>Grid</DefaultHTMLPageLayout>
<DefaultTargetSchema>IE50</DefaultTargetSchema>
<DelaySign>false</DelaySign>
<OutputType>Library</OutputType>
<OptionCompare>Binary</OptionCompare>
<OptionExplicit>On</OptionExplicit>
<OptionStrict>Off</OptionStrict>
<RootNamespace>CSLA</RootNamespace>
<StartupObject>CSLA.%28None%29</StartupObject>
<FileUpgradeFlags>
</FileUpgradeFlags>
<MyType>Windows</MyType>
<UpgradeBackupLocation>
</UpgradeBackupLocation>
<OldToolsVersion>3.5</OldToolsVersion>
<SignAssembly>true</SignAssembly>
<PublishUrl>publish\</PublishUrl>
<Install>true</Install>
<InstallFrom>Disk</InstallFrom>
<UpdateEnabled>false</UpdateEnabled>
<UpdateMode>Foreground</UpdateMode>
<UpdateInterval>7</UpdateInterval>
<UpdateIntervalUnits>Days</UpdateIntervalUnits>
<UpdatePeriodically>false</UpdatePeriodically>
<UpdateRequired>false</UpdateRequired>
<MapFileExtensions>true</MapFileExtensions>
<ApplicationRevision>0</ApplicationRevision>
<ApplicationVersion>1.0.0.%2a</ApplicationVersion>
<IsWebBootstrapper>false</IsWebBootstrapper>
<UseApplicationTrust>false</UseApplicationTrust>
<BootstrapperEnabled>true</BootstrapperEnabled>
<TargetFrameworkVersion>v4.0</TargetFrameworkVersion>
<TargetFrameworkProfile>
</TargetFrameworkProfile>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>CSLA.Server.DataPortal.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>true</DebugSymbols>
<Optimize>false</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032,42353,42354,42355</NoWarn>
<DebugType>full</DebugType>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>CSLA.Server.DataPortal.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>false</DebugSymbols>
<Optimize>true</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032,42353,42354,42355</NoWarn>
<DebugType>none</DebugType>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'RELEASE AND DEPLOY BUILD|AnyCPU' ">
<DefineTrace>true</DefineTrace>
<OutputPath>bin\RELEASE AND DEPLOY BUILD\</OutputPath>
<BaseAddress>285212672</BaseAddress>
<DocumentationFile>CSLA.Server.DataPortal.xml</DocumentationFile>
<Optimize>true</Optimize>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032,42353,42354,42355</NoWarn>
<DebugType>
</DebugType>
<PlatformTarget>AnyCPU</PlatformTarget>
</PropertyGroup>
<ItemGroup>
<Reference Include="System">
<Name>System</Name>
</Reference>
<Reference Include="System.configuration" />
<Reference Include="System.Data">
<Name>System.Data</Name>
</Reference>
<Reference Include="System.Xml">
<Name>System.XML</Name>
</Reference>
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
</ItemGroup>
<ItemGroup>
<Compile Include="AssemblyInfo.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="CriteriaBase.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="DataPortal.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="DataPortalContext.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="ISerializationNotification.vb">
<SubType>Code</SubType>
</Compile>
</ItemGroup>
<ItemGroup>
<BootstrapperPackage Include="Microsoft.Net.Client.3.5">
<Visible>False</Visible>
<ProductName>.NET Framework Client Profile</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.2.0">
<Visible>False</Visible>
<ProductName>.NET Framework 2.0 %28x86%29</ProductName>
<Install>true</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.3.0">
<Visible>False</Visible>
<ProductName>.NET Framework 3.0 %28x86%29</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.3.5">
<Visible>False</Visible>
<ProductName>.NET Framework 3.5</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.3.5.SP1">
<Visible>False</Visible>
<ProductName>.NET Framework 3.5 SP1</ProductName>
<Install>false</Install>
</BootstrapperPackage>
</ItemGroup>
<ItemGroup>
<None Include="..\..\..\keys\AyaNova.snk">
<Link>AyaNova.snk</Link>
</None>
</ItemGroup>
<ItemGroup>
<Folder Include="My Project\" />
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Microsoft.VisualBasic.targets" />
<PropertyGroup>
<PreBuildEvent>
</PreBuildEvent>
<PostBuildEvent>
</PostBuildEvent>
</PropertyGroup>
</Project>

73
source/csla10/CSLA.Server.DataPortal/CSLA.Server.DataPortal.vbproj.user Normal file
View File

@@ -0,0 +1,73 @@
<?xml version="1.0" encoding="utf-8"?>
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<LastOpenVersion>7.10.3077</LastOpenVersion>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ReferencePath>
</ReferencePath>
<CopyProjectDestinationFolder>
</CopyProjectDestinationFolder>
<CopyProjectUncPath>
</CopyProjectUncPath>
<CopyProjectOption>0</CopyProjectOption>
<ProjectView>ShowAllFiles</ProjectView>
<ProjectTrust>0</ProjectTrust>
<PublishUrlHistory>
</PublishUrlHistory>
<InstallUrlHistory>
</InstallUrlHistory>
<SupportUrlHistory>
</SupportUrlHistory>
<UpdateUrlHistory>
</UpdateUrlHistory>
<BootstrapperUrlHistory>
</BootstrapperUrlHistory>
<ErrorReportUrlHistory>
</ErrorReportUrlHistory>
<FallbackCulture>en-US</FallbackCulture>
<VerifyUploadedFiles>false</VerifyUploadedFiles>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
</Project>

21
source/csla10/CSLA.Server.DataPortal/CriteriaBase.vb Normal file
View File

@@ -0,0 +1,21 @@
''' <summary>
''' Base type from which Criteria classes can be
''' derived in a business class.
''' </summary>
<Serializable()> _
Public MustInherit Class CriteriaBase
''' <summary>
''' Type of the business object to be instantiated by
''' the server-side DataPortal.
''' </summary>
Public ObjectType As Type
''' <summary>
''' Initializes CriteriaBase with the type of
''' business object to be created by the DataPortal.
''' </summary>
Public Sub New(ByVal Type As Type)
ObjectType = Type
End Sub
End Class

274
source/csla10/CSLA.Server.DataPortal/DataPortal.vb Normal file
View File

@@ -0,0 +1,274 @@
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
''' <summary>
''' Implements the server-side DataPortal as discussed
''' in Chapter 5.
''' </summary>
Public Class DataPortal
Inherits MarshalByRefObject
#Region " Data Access "
''' <summary>
''' Called by the client-side DataPortal to create a new object.
''' </summary>
''' <param name="Criteria">Object-specific criteria.</param>
''' <param name="context">The user's principal object (if using CSLA .NET security).</param>
''' <returns>A populated business object.</returns>
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
''' <summary>
''' Called by the client-side DataProtal to retrieve an object.
''' </summary>
''' <param name="Criteria">Object-specific criteria.</param>
''' <param name="context">The user's principal object (if using CSLA .NET security).</param>
''' <returns>A populated business object.</returns>
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
''' <summary>
''' Called by the client-side DataPortal to update an object.
''' </summary>
''' <param name="obj">A reference to the object being updated.</param>
''' <param name="context">The user's principal object (if using CSLA .NET security).</param>
''' <returns>A reference to the newly updated object.</returns>
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
''' <summary>
''' Called by the client-side DataPortal to delete an object.
''' </summary>
''' <param name="Criteria">Object-specific criteria.</param>
''' <param name="context">The user's principal object (if using CSLA .NET security).</param>
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

64
source/csla10/CSLA.Server.DataPortal/DataPortalContext.vb Normal file
View File

@@ -0,0 +1,64 @@
Imports System.Security.Principal
Namespace Server
''' <summary>
''' Provides consistent context information between the client
''' and server DataPortal objects.
''' </summary>
''' <remarks>
''' The context includes the current
''' <see cref="T:CSLA.Security.BusinessPrincipal" />
''' object if CSLA security is being used. It also includes a
''' flag indicating whether the server-side DataPortal is running
''' locally or remotely.
''' </remarks>
<Serializable()> _
Public Class DataPortalContext
Private mPrincipal As IPrincipal
Private mRemotePortal As Boolean
''' <summary>
''' The current <see cref="T:CSLA.Security.BusinessPrincipal" />
''' if CSLA security is being used.
''' </summary>
Public ReadOnly Property Principal() As IPrincipal
Get
Return mPrincipal
End Get
End Property
''' <summary>
''' Returns True if the server-side DataPortal is running
''' on a remote server via remoting.
''' </summary>
Public ReadOnly Property IsRemotePortal() As Boolean
Get
Return mRemotePortal
End Get
End Property
''' <summary>
''' Creates a new DataPortalContext object.
''' </summary>
''' <param name="isRemotePortal">Indicates whether the DataPortal is remote.</param>
Public Sub New(ByVal isRemotePortal As Boolean)
mPrincipal = Nothing
mRemotePortal = isRemotePortal
End Sub
''' <summary>
''' Creates a new DataPortalContext object.
''' </summary>
''' <param name="principal">The current Principal object.</param>
''' <param name="isRemotePortal">Indicates whether the DataPortal is remote.</param>
Public Sub New(ByVal principal As IPrincipal, ByVal isRemotePortal As Boolean)
mPrincipal = principal
mRemotePortal = isRemotePortal
End Sub
End Class
End Namespace

83
source/csla10/CSLA.Server.DataPortal/ISerializationNotification.vb Normal file
View File

@@ -0,0 +1,83 @@
Namespace Serialization
''' <summary>
''' Objects can implement this interface if they wish to be
''' notified of serialization events.
''' </summary>
''' <remarks>
''' <para>
''' Note that .NET serialization does NOT call these methods. Only
''' code that checks for the ISerializationNotification interface
''' when serializating and deserializing objects will invoke these
''' methods.
''' </para><para>
''' The CSLA .NET framework's DataPortal processing and the Clone
''' method in BusinessBase automatically make these calls.
''' </para>
''' </remarks>
Public Interface ISerializationNotification
''' <summary>
''' This method is called before an object is serialized.
''' </summary>
Sub Serializing()
''' <summary>
''' This method is called on the original instance of the
''' object after it has been serialized.
''' </summary>
Sub Serialized()
''' <summary>
''' This method is called on a newly deserialized object
''' after deserialization is complete.
''' </summary>
Sub Deserialized()
End Interface
''' <summary>
''' Helper methods for invoking the ISerializatoinNotification
''' methods.
''' </summary>
Public Class SerializationNotification
''' <summary>
''' Invokes the Serializing method on the target object
''' if it has implemented ISerializationNotification.
''' </summary>
''' <param name="target">Object on which the method should be invoked.</param>
Public Shared Sub OnSerializing(ByVal target As Object)
If TypeOf target Is ISerializationNotification Then
DirectCast(target, ISerializationNotification).Serializing()
End If
End Sub
''' <summary>
''' Invokes the Serialized method on the target object
''' if it has implemented ISerializationNotification.
''' </summary>
''' <param name="target">Object on which the method should be invoked.</param>
Public Shared Sub OnSerialized(ByVal target As Object)
If TypeOf target Is ISerializationNotification Then
DirectCast(target, ISerializationNotification).Serialized()
End If
End Sub
''' <summary>
''' Invokes the Deserialized method on the target object
''' if it has implemented ISerializationNotification.
''' </summary>
''' <param name="target">Object on which the method should be invoked.</param>
Public Shared Sub OnDeserialized(ByVal target As Object)
If TypeOf target Is ISerializationNotification Then
DirectCast(target, ISerializationNotification).Deserialized()
End If
End Sub
End Class
End Namespace

1
source/csla10/CSLA.Server.ServicedDataPortal/.cvsignore Normal file
View File

@@ -0,0 +1 @@
CSLA.Server.ServicedDataPortal.xml

43
source/csla10/CSLA.Server.ServicedDataPortal/AssemblyInfo.vb Normal file
View File

@@ -0,0 +1,43 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.EnterpriseServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("CSLA.Server.ServicedDataPortal")>
<Assembly: AssemblyDescription("CSLA .NET framework")>
<Assembly: AssemblyCompany("Rockford Lhotka")>
<Assembly: AssemblyProduct("Expert One-on-One VB.NET Business Objects")>
<Assembly: AssemblyCopyright("Copyright 2003 Rockford Lhotka. All rights reserved.")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("A0547DE0-0EA3-4B98-AD4C-AD3759C14A96")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
<Assembly: AssemblyVersion("1.3.0")>
' update this to point to your key
' strong name
<Assembly: AssemblyKeyFile("..\..\..\..\..\keys\AyaNova.snk")>
' EnterpriseServices settings
<Assembly: ApplicationActivation(ActivationOption.Library)>
<Assembly: ApplicationName("CSLA DataPortal")>
<Assembly: Description("CSLA .NET data portal")>
<Assembly: ApplicationAccessControl(True)>

177
source/csla10/CSLA.Server.ServicedDataPortal/CSLA.Server.ServicedDataPortal.vbproj Normal file
View File

@@ -0,0 +1,177 @@
<Project DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003" ToolsVersion="3.5">
<PropertyGroup>
<ProjectType>Local</ProjectType>
<ProductVersion>9.0.30729</ProductVersion>
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>{AD60DF60-2D14-4403-B5A8-41D4E06AB7AD}</ProjectGuid>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ApplicationIcon>
</ApplicationIcon>
<AssemblyKeyContainerName>
</AssemblyKeyContainerName>
<AssemblyName>CSLA.Server.ServicedDataPortal</AssemblyName>
<AssemblyOriginatorKeyFile>..\..\..\keys\AyaNova.snk</AssemblyOriginatorKeyFile>
<AssemblyOriginatorKeyMode>None</AssemblyOriginatorKeyMode>
<DefaultClientScript>JScript</DefaultClientScript>
<DefaultHTMLPageLayout>Grid</DefaultHTMLPageLayout>
<DefaultTargetSchema>IE50</DefaultTargetSchema>
<DelaySign>false</DelaySign>
<OutputType>Library</OutputType>
<OptionCompare>Binary</OptionCompare>
<OptionExplicit>On</OptionExplicit>
<OptionStrict>Off</OptionStrict>
<RootNamespace>CSLA.Server.ServicedDataPortal</RootNamespace>
<StartupObject>
</StartupObject>
<FileUpgradeFlags>
</FileUpgradeFlags>
<MyType>Windows</MyType>
<UpgradeBackupLocation>
</UpgradeBackupLocation>
<OldToolsVersion>2.0</OldToolsVersion>
<SignAssembly>true</SignAssembly>
<PublishUrl>publish\</PublishUrl>
<Install>true</Install>
<InstallFrom>Disk</InstallFrom>
<UpdateEnabled>false</UpdateEnabled>
<UpdateMode>Foreground</UpdateMode>
<UpdateInterval>7</UpdateInterval>
<UpdateIntervalUnits>Days</UpdateIntervalUnits>
<UpdatePeriodically>false</UpdatePeriodically>
<UpdateRequired>false</UpdateRequired>
<MapFileExtensions>true</MapFileExtensions>
<ApplicationRevision>0</ApplicationRevision>
<ApplicationVersion>1.0.0.%2a</ApplicationVersion>
<IsWebBootstrapper>false</IsWebBootstrapper>
<UseApplicationTrust>false</UseApplicationTrust>
<BootstrapperEnabled>true</BootstrapperEnabled>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>CSLA.Server.ServicedDataPortal.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>true</DebugSymbols>
<Optimize>false</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032</NoWarn>
<DebugType>full</DebugType>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>CSLA.Server.ServicedDataPortal.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>false</DebugSymbols>
<Optimize>true</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032</NoWarn>
<DebugType>none</DebugType>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'RELEASE AND DEPLOY BUILD|AnyCPU' ">
<DefineTrace>true</DefineTrace>
<OutputPath>bin\RELEASE AND DEPLOY BUILD\</OutputPath>
<BaseAddress>285212672</BaseAddress>
<DocumentationFile>CSLA.Server.ServicedDataPortal.xml</DocumentationFile>
<Optimize>true</Optimize>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032</NoWarn>
<DebugType>
</DebugType>
<PlatformTarget>AnyCPU</PlatformTarget>
</PropertyGroup>
<ItemGroup>
<Reference Include="System">
<Name>System</Name>
</Reference>
<Reference Include="System.Data">
<Name>System.Data</Name>
</Reference>
<Reference Include="System.EnterpriseServices">
<Name>System.EnterpriseServices</Name>
</Reference>
<Reference Include="System.Xml">
<Name>System.XML</Name>
</Reference>
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
</ItemGroup>
<ItemGroup>
<Compile Include="AssemblyInfo.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="DataPortal.vb">
<SubType>Code</SubType>
</Compile>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\CSLA.Server.DataPortal\CSLA.Server.DataPortal.vbproj">
<Project>{80828E2C-E9FB-4E73-A27C-7F9CDB96FCDE}</Project>
<Name>CSLA.Server.DataPortal</Name>
</ProjectReference>
</ItemGroup>
<ItemGroup>
<BootstrapperPackage Include="Microsoft.Net.Client.3.5">
<Visible>False</Visible>
<ProductName>.NET Framework Client Profile</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.2.0">
<Visible>False</Visible>
<ProductName>.NET Framework 2.0 %28x86%29</ProductName>
<Install>true</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.3.0">
<Visible>False</Visible>
<ProductName>.NET Framework 3.0 %28x86%29</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.3.5">
<Visible>False</Visible>
<ProductName>.NET Framework 3.5</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.3.5.SP1">
<Visible>False</Visible>
<ProductName>.NET Framework 3.5 SP1</ProductName>
<Install>false</Install>
</BootstrapperPackage>
</ItemGroup>
<ItemGroup>
<None Include="..\..\..\keys\AyaNova.snk">
<Link>AyaNova.snk</Link>
</None>
</ItemGroup>
<ItemGroup>
<Folder Include="My Project\" />
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Microsoft.VisualBasic.targets" />
<PropertyGroup>
<PreBuildEvent>
</PreBuildEvent>
<PostBuildEvent>
</PostBuildEvent>
</PropertyGroup>
</Project>

72
source/csla10/CSLA.Server.ServicedDataPortal/CSLA.Server.ServicedDataPortal.vbproj.user Normal file
View File

@@ -0,0 +1,72 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<LastOpenVersion>7.10.3077</LastOpenVersion>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ReferencePath>
</ReferencePath>
<CopyProjectDestinationFolder>
</CopyProjectDestinationFolder>
<CopyProjectUncPath>
</CopyProjectUncPath>
<CopyProjectOption>0</CopyProjectOption>
<ProjectView>ShowAllFiles</ProjectView>
<ProjectTrust>0</ProjectTrust>
<PublishUrlHistory>
</PublishUrlHistory>
<InstallUrlHistory>
</InstallUrlHistory>
<SupportUrlHistory>
</SupportUrlHistory>
<UpdateUrlHistory>
</UpdateUrlHistory>
<BootstrapperUrlHistory>
</BootstrapperUrlHistory>
<ErrorReportUrlHistory>
</ErrorReportUrlHistory>
<FallbackCulture>en-US</FallbackCulture>
<VerifyUploadedFiles>false</VerifyUploadedFiles>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<EnableASPDebugging>false</EnableASPDebugging>
<EnableASPXDebugging>false</EnableASPXDebugging>
<EnableUnmanagedDebugging>false</EnableUnmanagedDebugging>
<EnableSQLServerDebugging>false</EnableSQLServerDebugging>
<RemoteDebugEnabled>false</RemoteDebugEnabled>
<RemoteDebugMachine>
</RemoteDebugMachine>
<StartAction>Project</StartAction>
<StartArguments>
</StartArguments>
<StartPage>
</StartPage>
<StartProgram>
</StartProgram>
<StartURL>
</StartURL>
<StartWorkingDirectory>
</StartWorkingDirectory>
<StartWithIE>false</StartWithIE>
</PropertyGroup>
</Project>

51
source/csla10/CSLA.Server.ServicedDataPortal/DataPortal.vb Normal file
View File

@@ -0,0 +1,51 @@
Imports System.EnterpriseServices
''' <summary>
''' Implements the transactional server-side DataPortal object as
''' discussed in Chapter 5.
''' </summary>
<Transaction(TransactionOption.Required), EventTrackingEnabled(True)> _
Public Class DataPortal
Inherits ServicedComponent
''' <summary>
''' Invokes the server-side DataPortal Create method within
''' a COM+ transaction.
''' </summary>
<AutoComplete(True)> _
Public Function Create(ByVal Criteria As Object, ByVal Principal As Object) As Object
Dim portal As New CSLA.Server.DataPortal()
Return portal.Create(Criteria, Principal)
End Function
''' <summary>
''' Invokes the server-side DataPortal Fetch method within
''' a COM+ transaction.
''' </summary>
<AutoComplete(True)> _
Public Function Fetch(ByVal Criteria As Object, ByVal Principal As Object) As Object
Dim portal As New CSLA.Server.DataPortal()
Return portal.Fetch(Criteria, Principal)
End Function
''' <summary>
''' Invokes the server-side DataPortal Update method within
''' a COM+ transaction.
''' </summary>
<AutoComplete(True)> _
Public Function Update(ByVal obj As Object, ByVal Principal As Object) As Object
Dim portal As New CSLA.Server.DataPortal()
Return portal.Update(obj, Principal)
End Function
''' <summary>
''' Invokes the server-side DataPortal Delete method within
''' a COM+ transaction.
''' </summary>
<AutoComplete(True)> _
Public Sub Delete(ByVal Criteria As Object, ByVal Principal As Object)
Dim portal As New CSLA.Server.DataPortal()
portal.Delete(Criteria, Principal)
End Sub
End Class

1
source/csla10/CSLA.Test/.cvsignore Normal file
View File

@@ -0,0 +1 @@
CSLA.Test.xml

31
source/csla10/CSLA.Test/AssemblyInfo.vb Normal file
View File

@@ -0,0 +1,31 @@
Imports System.Reflection
Imports System.Runtime.InteropServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("")>
<Assembly: AssemblyCopyright("")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("52CD186E-74AC-4213-8D3A-D3DF25033CC0")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
<Assembly: AssemblyVersion("1.3.*")>

95
source/csla10/CSLA.Test/Basics.vb Normal file
View File

@@ -0,0 +1,95 @@
<TestFixture()> _
Public Class Basics
<Test()> _
Public Sub CreateGetRoot()
Session.Clear()
Dim root As GenRoot
root = GenRoot.NewRoot
Assert.IsNotNull(root)
Assert.AreEqual("<new>", root.Data)
Assert.AreEqual("Created", Session("GenRoot"))
Assert.AreEqual(True, root.IsNew)
Assert.AreEqual(False, root.IsDeleted)
Assert.AreEqual(True, root.IsDirty)
End Sub
<Test()> _
Public Sub CreateRoot()
Session.Clear()
Dim root As root
root = root.NewRoot
Assert.IsNotNull(root)
Assert.AreEqual("<new>", root.Data)
Assert.AreEqual("Created", Session("Root"))
Assert.AreEqual(True, root.IsNew)
Assert.AreEqual(False, root.IsDeleted)
Assert.AreEqual(True, root.IsDirty)
End Sub
<Test()> _
Public Sub AddChild()
Session.Clear()
Dim root As root = root.NewRoot
root.Children.Add("1")
Assert.AreEqual(1, root.Children.Count)
Assert.AreEqual("1", root.Children(0).Data)
End Sub
<Test()> _
Public Sub AddRemoveChild()
Session.Clear()
Dim root As root = root.NewRoot
root.Children.Add("1")
root.Children.Remove(root.Children.Item(0))
Assert.AreEqual(0, root.Children.Count)
End Sub
<Test()> _
Public Sub AddGrandChild()
Session.Clear()
Dim root As root = root.NewRoot
root.Children.Add("1")
Dim child As child = root.Children(0)
child.GrandChildren.Add("1")
Assert.AreEqual(1, child.GrandChildren.Count)
Assert.AreEqual("1", child.GrandChildren(0).Data)
End Sub
<Test()> _
Public Sub AddRemoveGrandChild()
Session.Clear()
Dim root As root = root.NewRoot
root.Children.Add("1")
Dim child As child = root.Children(0)
child.GrandChildren.Add("1")
child.GrandChildren.Remove(child.GrandChildren.Item(0))
Assert.AreEqual(0, child.GrandChildren.Count)
End Sub
<Test()> _
Public Sub CloneGraph()
Session.Clear()
Dim root As root = root.NewRoot
root.Children.Add("1")
Dim child As child = root.Children(0)
child.GrandChildren.Add("1")
Assert.AreEqual(1, child.GrandChildren.Count)
Assert.AreEqual("1", child.GrandChildren(0).Data)
Dim clone As root = DirectCast(root.Clone, root)
child = clone.Children(0)
Assert.AreEqual(1, child.GrandChildren.Count)
Assert.AreEqual("1", child.GrandChildren(0).Data)
Assert.AreEqual("root Deserialized", CStr(Session("Deserialized")))
Assert.AreEqual("root Serialized", CStr(Session("Serialized")))
Assert.AreEqual("root Serializing", CStr(Session("Serializing")))
Assert.AreEqual("GC Deserialized", CStr(Session("GCDeserialized")))
Assert.AreEqual("GC Serialized", CStr(Session("GCSerialized")))
Assert.AreEqual("GC Serializing", CStr(Session("GCSerializing")))
End Sub
End Class

12
source/csla10/CSLA.Test/BrokenRules.vb Normal file
View File

@@ -0,0 +1,12 @@
<TestFixture()> _
Public Class BrokenRules
<Test()> _
Public Sub BreakARule()
Session.Clear()
Dim root As HasRules = HasRules.NewHasRules
Assert.AreEqual(root.IsValid, False)
Assert.AreEqual(root.GetBrokenRulesCollection.Count, 1)
End Sub
End Class

6
source/csla10/CSLA.Test/CSLA.Test.config Normal file
View File

@@ -0,0 +1,6 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<appSettings>
<add key="Authentication" value="Windows" />
</appSettings>
</configuration>

BIN
source/csla10/CSLA.Test/CSLA.Test.nunit Normal file
View File

Binary file not shown.

Some files were not shown because too many files have changed in this diff Show More