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 _ 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 Public Class UserStore Inherits ModelDifferenceStore Private Shared ReadOnly xmlHeader As String = "" & 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 Private Shared Sub Instance_SaveAuditTrailData(sender As Object, e As SaveAuditTrailDataEventArgs) If GLOBAL_HAS_Audit = False Then e.Handled = True End If End Sub 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