SISBusiness/SISBusiness.Win.CX/Program.vb

Imports System
Imports System.Configuration
Imports System.Windows.Forms

Imports DevExpress.Persistent.Base
Imports DevExpress.ExpressApp
Imports DevExpress.ExpressApp.Security
Imports DevExpress.ExpressApp.Win

Imports SISBusiness.Win
Imports DevExpress.ExpressApp.Model.Core
Imports DevExpress.ExpressApp.Model
Imports DevExpress.Xpo
Imports SISBusiness.Module
Imports DevExpress.Data.Filtering
Imports DevExpress.Persistent.BaseImpl
Public Class Program

    <STAThread()> _
    Public Shared Sub Main(ByVal arguments() As String)
#If EASYTEST Then
              DevExpress.ExpressApp.Win.EasyTest.EasyTestRemotingRegistration.Register()
#End If

        Application.EnableVisualStyles()
        Application.SetCompatibleTextRenderingDefault(False)
        EditModelPermission.AlwaysGranted = System.Diagnostics.Debugger.IsAttached
        Dim _application As SISBusinessWindowsFormsApplication = New SISBusinessWindowsFormsApplication()
#If EASYTEST Then
        If (Not ConfigurationManager.ConnectionStrings.Item("EasyTestConnectionString") Is Nothing) Then
            _application.ConnectionString = ConfigurationManager.ConnectionStrings.Item("EasyTestConnectionString").ConnectionString
        End If
#End If
        If (Not ConfigurationManager.ConnectionStrings.Item("ConnectionString") Is Nothing) Then
            _application.ConnectionString = ConfigurationManager.ConnectionStrings.Item("ConnectionString").ConnectionString
        End If
        If System.Diagnostics.Debugger.IsAttached Then
            _application.DatabaseUpdateMode = DatabaseUpdateMode.UpdateDatabaseAlways
        End If
        Try
            'Uncomment this line when using the Middle Tier application server:
            'Dim _middleTierClientApplicationConfigurator As DevExpress.ExpressApp.MiddleTier.MiddleTierClientApplicationConfigurator = New DevExpress.ExpressApp.MiddleTier.MiddleTierClientApplicationConfigurator(winApplication)
            AddHandler _application.CreateCustomUserModelDifferenceStore, AddressOf _application_CreateCustomUserModelDifferenceStore
            _application.DelayedViewItemsInitialization = True
            _application.Setup()
            _application.Start()
        Catch e As Exception
            _application.HandleException(e)
        End Try

    End Sub

    Private Shared Sub _application_CreateCustomUserModelDifferenceStore(sender As Object, e As CreateCustomModelDifferenceStoreEventArgs)
        Dim userDiffs As New UserStore(CType(sender, WinApplication))
        e.Store = userDiffs
        e.Handled = True
    End Sub
    Public Class UserStore
        Inherits ModelDifferenceStore
        Private Shared ReadOnly xmlHeader As String = "<?xml version=""1.0"" encoding=""utf-8""?>" & System.Environment.NewLine
        Private application As WinApplication

        Public Overrides ReadOnly Property Name() As String
            Get
                Return "UserStore"
            End Get
        End Property

        Public Sub New(ByVal winApplication As WinApplication)
            application = winApplication
        End Sub

        Private Function FindStoreByAspect(ByVal stores As XPCollection(Of XmlStore), ByVal aspect As String) As XmlStore
            For Each store As XmlStore In stores
                If store.Aspect = aspect Then
                    Return store
                End If
            Next store
            Return Nothing
        End Function

        Private Function FindXmlUserByCurrentUser() As XmlUser
            Dim objectSpace As IObjectSpace = application.CreateObjectSpace()
            Dim currentUser As DevExpress.Persistent.BaseImpl.User = objectSpace.FindObject(Of User)(CriteriaOperator.Parse("UserName=?", SecuritySystem.CurrentUserName))
            Dim user As XmlUser = Nothing
            Try
                user = objectSpace.FindObject(Of XmlUser)(CriteriaOperator.Parse("User=?", currentUser), True)
            Catch
            End Try
            Return user
        End Function

        Public Overrides Sub Load(ByVal model As ModelApplicationBase)
            Dim xmlReader As New ModelXmlReader()
            Dim user As XmlUser = FindXmlUserByCurrentUser()
            If user IsNot Nothing Then
                For Each store As XmlStore In user.Aspects
                    xmlReader.ReadFromString(model, store.Aspect, store.XmlData)
                Next store
            End If
        End Sub

        Public Overrides Sub SaveDifference(ByVal model As ModelApplicationBase)
            Dim objectSpace As IObjectSpace = application.CreateObjectSpace()
            Dim user As XmlUser = objectSpace.GetObject(FindXmlUserByCurrentUser())
            If user Is Nothing Then
                user = New XmlUser(TryCast(objectSpace, Xpo.XPObjectSpace).Session)
                user.User = objectSpace.GetObject(CType(SecuritySystem.CurrentUser, DevExpress.Persistent.BaseImpl.User))
            End If
            For i As Integer = 0 To model.AspectCount - 1
                Dim xmlWriter As New ModelXmlWriter()
                Dim aspect As String = model.GetAspect(i)
                Dim xmlContent As String = xmlWriter.WriteToString(model, i)
                If (Not String.IsNullOrEmpty(xmlContent)) Then
                    Dim store As XmlStore = FindStoreByAspect(user.Aspects, aspect)
                    If store Is Nothing Then
                        store = New XmlStore(TryCast(objectSpace, Xpo.XPObjectSpace).Session)
                    End If
                    store.User = user
                    store.Aspect = aspect
                    store.XmlData = xmlHeader & xmlContent
                End If
            Next i
            objectSpace.CommitChanges()
        End Sub
    End Class

End Class