SISBusiness/SISBusiness.Win.PH/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.Module.Win
Imports DevExpress.Persistent.AuditTrail
Imports Microsoft.VisualBasic

Imports DevExpress.Xpo
Imports DevExpress.Data.Filtering
Imports DevExpress.Persistent.BaseImpl

Imports DevExpress.ExpressApp.Model.Core
Imports DevExpress.ExpressApp.Model
Imports SISBusiness.Module
Friend NotInheritable Class Program
    Private Sub New()
    End Sub
    <STAThread()> _
    Public Shared Sub Main(ByVal arguments() As String)
#If EASYTEST Then
        DevExpress.ExpressApp.EasyTest.WinAdapter.RemotingRegistration.Register(4100)
#End If

        Application.EnableVisualStyles()
        Application.SetCompatibleTextRenderingDefault(False)
        EditModelPermission.AlwaysGranted = System.Diagnostics.Debugger.IsAttached

        '-- Eredeti kód
        'Dim _application As SISBusinessWindowsFormsApplication_DB = New SISBusinessWindowsFormsApplication_DB()

        '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
        '    Dim timeStampStrategy As IAuditTimestampStrategy = New SISBusiness.Module.TimeStamp
        '    AuditTrailService.Instance.TimestampStrategy = timeStampStrategy

        '    _application.Setup()
        '    _application.Start()
        'Catch e As Exception
        '    _application.HandleException(e)
        'End Try

        '-- Új kód
        Do
            Dim winApplication As SISBusinessWindowsFormsApplication
            If LogOnDB.NewApplication Is Nothing Then
                winApplication = SISBusinessWindowsFormsApplication.CreateApplication()
            Else
                winApplication = CType(LogOnDB.NewApplication, SISBusinessWindowsFormsApplication)
                LogOnDB.NewApplication = Nothing
            End If
            Try
                AddHandler AuditTrailService.Instance.SaveAuditTrailData, AddressOf Instance_SaveAuditTrailData
                AddHandler winApplication.CreateCustomUserModelDifferenceStore, AddressOf winApplication_CreateCustomUserModelDifferenceStore
                AddHandler winApplication.LastLogonParametersWriting, AddressOf winApplication_LastLogonParametersWriting
                winApplication.DelayedViewItemsInitialization = True
                winApplication.Setup()
                winApplication.Start()
                If WinChangeDatabaseHelper.AuthenticatedUserLogonFailed Then
                    WinChangeDatabaseHelper.SkipLogonDialog = False
                    winApplication.Start()
                End If
            Catch e As Exception
                winApplication.HandleException(e)
            End Try
            winApplication.Dispose()
        Loop While LogOnDB.NewApplication IsNot Nothing
        '-- Új kód vége
    End Sub
    Shared Sub winApplication_CreateCustomUserModelDifferenceStore(ByVal sender As Object, ByVal e As CreateCustomModelDifferenceStoreEventArgs)
        Dim userDiffs As New UserStore(CType(sender, WinApplication))
        e.Store = userDiffs
        e.Handled = True
    End Sub
    Private Shared Sub Instance_SaveAuditTrailData(sender As Object, e As SaveAuditTrailDataEventArgs)
        If GLOBAL_HAS_Audit = False Then
            e.Handled = True
        End If
    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.GetObject(CType(SecuritySystem.CurrentUser, DevExpress.Persistent.BaseImpl.User))
            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
    Shared Sub winApplication_LastLogonParametersWriting(ByVal sender As Object, ByVal e As LastLogonParametersWritingEventArgs)
        'If (CType(e.LogonObject, AuthenticationStandardLogonParameters)).UserName <> "SysAdmin" Then
        e.SettingsStorage.SaveOption("", "UserName", (CType(e.LogonObject, AuthenticationStandardLogonParameters)).UserName)
        e.SettingsStorage.SaveOption("", "DBConnection", GLOBAL_SQLDatabase)
        e.SettingsStorage.SaveOption("", "SQLServer", GLOBAL_SQLServer)
        Select Case GLOBAL_SQLType
            Case eSQLType.MSSQL
                e.SettingsStorage.SaveOption("", "SQLType", "MSSQL")
            Case eSQLType.MySQL
                e.SettingsStorage.SaveOption("", "SQLType", "MySQL")
            Case eSQLType.PostgreSQL
                e.SettingsStorage.SaveOption("", "SQLType", "PostgreSQL")
        End Select

        e.Handled = True
    End Sub
End Class