%REM
Library documentManagerLib
Created Dec 14, 2016 by Administrator/Gandliar
Description: Comments for Library
%END REM
Option Public
Option Declare
Dim dm As DocumentManager
%REM
Class DocumentManager
Description: Класс сохранения измененных полей документа
Необходимо в базу данных добавить вид "(all~unid)" с отсортированным первым столбцом с формулой @Text(@DocumentUniqueID)
Необходимо для формы установить "Merge\NoConflict"
Необходимо добавить на форму cfd поле saveOptions со значением ""
Необходимо добавить в событие queryOpen:
Set dm = New DocumentManager(Source)
Call dm.addField("a")
Call dm.addField("b")
Call dm.addField("c")
где а,b,c имена проверяемых и сохраняемых полей.
Необходимо добавить в событие querySave:
Continue = False
Call dm.save()
Необходимо добавить в событие queryClose:
Continue = dm.queryClose()
%END REM
Class DocumentManager
Private uidoc As NotesUIDocument
Private doc As NotesDocument
%REM
Содержит список проверяемых полей
%END REM
Private fieldNameList List As String
%REM
Содержит список изменившихся полей
%END REM
Private changeFieldNameList List As String
%REM
Sub New
Description: Создание менеджера документа
%END REM
Sub New (source As NotesUIDocument)
Set me.uidoc = source
End Sub
%REM
Sub addField
Description: Добавление полей для проверки и сохранения
%END REM
Sub addField(fieldName As String)
me.fieldNameList(fieldName) = fieldName
End Sub
%REM
Function checkField
Description: Проверяет, изменилось ли конкретное поле
%END REM
Private Function checkField(fieldName As String, currentDocString As String, sourceDocString As String) As Boolean
Dim currentValue As String
currentValue = StrRight$(currentDocString, {<item name='} + fieldName + {'>})
currentValue = StrLeft$(currentValue,{</item>})
currentValue = {<item name='} + fieldName + {'>}+currentValue + {</item>}
If InStr(sourceDocString,currentValue)>1 Then checkField = True
End Function
%REM
Function checkFields
Description: Проверяет, изменились ли поля
%END REM
Private Function checkFields(docSource As NotesDocument) As Boolean
Dim session As New NotesSession
Dim exporter As NotesDXLExporter
Set exporter = session.CreateDXLExporter
Dim currentDocString As String
currentDocString = exporter.Export(me.doc)
Dim sourceDocString As String
sourceDocString = exporter.Export(docSource)
Delete exporter
ForAll f In me.fieldNameList
If Not me.checkField(f, currentDocString, sourceDocString) Then
me.changeFieldNameList(f) = f
checkFields = true
End If
End ForAll
End Function
%REM
Function save
Description: Сохраняет документ
%END REM
Function save() As Boolean
'Проверим на формулы полей и обновим значение ричтекстовых полей
On Error 4412 GoTo errHandler
Call me.uidoc.Refresh(true)
Set me.doc = me.uidoc.Document
'Проверка прошла успешно
If me.doc.Isnewnote Then
Call doc.save(True, True)
Else
'Найдем исходный документ на диске
Dim view As NotesView
Set view = me.doc.Parentdatabase.Getview("all~unid")
Dim i As Integer
For i = 0 To 10
Call view.Refresh()
Dim docSource As NotesDocument
Set docSource = view.Getdocumentbykey(me.doc.Universalid, True)
If me.checkFields(docSource) Then
'Запишем в него содержание изменившихся полей
ForAll f In me.changeFieldNameList
Dim item As NotesItem
Set item = me.doc.Getfirstitem(f)
If docSource.Hasitem(f) Then Call docSource.Removeitem(f)
Call item.Copyitemtodocument(docSource, f)
End ForAll
If docSource.save(false, false) Then
Dim flag As Boolean
flag = true
Exit For
Else
Delete docSource
End If
Else
flag = True
Exit For
End If
Next i
If Not flag Then
MessageBox "Не удалось сохранить документ. Попробуйте еще раз позже.", 16, "Операция прервана!"
Exit Function
End If
End If
'Очистим список изменившихся полей
Erase me.changeFieldNameList
save = True
ex:
Exit function
errHandler:
Resume ex
End Function
%REM
Function queryClose
Description: Обработка события queryClose
%END REM
Function queryClose() As Boolean
If me.uidoc.Modifiedsincesaved Then
Dim result As Integer
result = MessageBox("Документ был изменен. Сохранить изменения?", 32+3, "Внимание!")
Select Case result
Case 6 'да
queryClose = me.save()
Case 7 'нет
queryClose = true
Case 2 'отмена
queryClose = false
End Select
Else
queryClose = True
End If
End Function
End Class
