92 lines
3.3 KiB
VB.net
92 lines
3.3 KiB
VB.net
Imports System
|
|
Imports System.Configuration
|
|
|
|
Imports DevExpress.Persistent.Base
|
|
Imports DevExpress.ExpressApp
|
|
Imports DevExpress.ExpressApp.Security
|
|
|
|
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
|
|
Imports DevExpress.ExpressApp.Web
|
|
|
|
Public Class UserStore
|
|
Inherits ModelDifferenceStore
|
|
Private Shared ReadOnly xmlHeader As String = "<?xml version=""1.0"" encoding=""utf-8""?>" & System.Environment.NewLine
|
|
Private application As WebApplication
|
|
|
|
Public Overrides ReadOnly Property Name() As String
|
|
Get
|
|
Return "UserStore"
|
|
End Get
|
|
End Property
|
|
|
|
Public Sub New(ByVal WebApplication As WebApplication)
|
|
application = WebApplication
|
|
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
|
|
|