Reconfigure for GIT
This commit is contained in:
@@ -0,0 +1,179 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user