Решено Проверка при сохранении

k85

Well-known member
11.10.2011
158
0
#1
в базе есть проверка на вложение, проверяется на Querysave
Код:
 Forall item In Doc.Items
If Ucase(item.Name) = "$FILE" Then
If  Right$( Lcase(item.Values(0) ),4) = ".pdf"  Then
Else
Messagebox "неверный фармат!"
Continue=False
Exit Sub
End If
 
End If
 
End Forall
при создании нового проверяет, потом если открыть на редактирование - проверяет, но если открыть на редактирование вложить файл с неверным расширением, появится сообщение и после этого удалить неверное вложение и вновь его добавить - дает сохранить и не ругается
Что не так ?
 

lmike

нет, пердело совершенство
Премиум
27.08.2008
6 567
263
#2
обновление РТ полей и вложений происходит сложным образом
ваш код это не учитывает
можно попробовать Update(True), для uidoc, и Update для rtitem (точно действует для текста)
есть еще хак с подменой инмемори дока
Для просмотра контента необходимо: Войти или зарегистрироваться
 

k85

Well-known member
11.10.2011
158
0
#3
уже как только не пробую - не выходит

может можно как-то по другому решить, необходимо во вложениях в Body проверять файлы и разрешать вносить (соответственно сохранять) только в определенных форматах документы, например .doc, .jpeg
 

erdi

Well-known member
20.08.2008
265
17
#4
1) RT поле скрыть, создать свою кнопку "вложить" и там проверять что пользователь выбрал
2) попробуй так
Код:
 Continue=False
Dim doc As NotesDocument
Set doc=Source.Document
 
Dim dname As Variant
dname=Evaluate({@AttachmentNames}, doc)
 
If dname(0)<>"" Then
Forall n In dname
If Right( Lcase(n),4) = ".pdf" Then
Continue=True
Exit Sub
End If
End Forall
End If
Messagebox "неверный фармат!"
 

lmike

нет, пердело совершенство
Премиум
27.08.2008
6 567
263
#5
вот набросал:
Код:
%REM
*--------------------------------------------
Function UpdateUIdoc
Description: Comments for Function
%END REM
Function UpdateUIdoc(uidoc As NotesUIDocument, rtName As String) As NotesUIDocument
Dim routineName As String
routineName="UpdateUIdoc"
On Error GoTo ErrH
'your code here
	Dim wksp As New NotesUIWorkspace
	Dim ses As New NotesSession
	Dim uidocNew As NotesUIDocument
	Dim doc As NotesDocument
	Dim rti As NotesRichTextItem
	Dim strFieldname As String
 
	uidoc.Refresh True ' do this if the rich text field is editable, to get the current contents in case user has modified them.
	Set doc = uidoc.Document  ' get the back-end document for the document open on screen.
	strFieldname = uidoc.CurrentField ' remember the current field if any
	Set rti = doc.GetFirstItem(rtName)
	rti.Update
	Dim newdoc As NotesDocument, unid As String
	unid=doc.Universalid
	Set newdoc=ses.Currentdatabase.Createdocument()
	Call doc.Copyallitems(newdoc, True) 
	doc.SaveOptions = "0" ' In order to close the document without a "do you want to save" prompt. If this is a mail-in doc you may need to set MailOptions="0" also to avoid being prompted.
	Call uidoc.Close(True)
	Delete uidoc
	Set doc=GetDocumentByUNIDSilent(ses.Currentdatabase,unid)
	ForAll itm In doc.Items
		Dim tmp As NotesItem
		Set tmp=itm
		Call tmp.Remove()
	End ForAll
	Call newdoc.Copyallitems(doc,True)
	Set uidocNew = wksp.EditDocument(True, doc, , , , True)
	If Len(strFieldname) > 0 Then uidocNew.GotoField(strFieldname) 
Set UpdateUIdoc=uidocNew
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
использование
Код:
Sub Querysave(Source As Notesuidocument, Continue As Variant)
Continue=True
Set Source=UpdateUIdoc(Source, {body})
If HasAttachmentName(Source.Document, {*.docx}) Then Msgbox {Attach is not valid}:Continue=False:Exit Sub
Source.Document.Save True, False
End Sub
ф-ции для аттачей
Код:
Function AttachmentsName(objdoc As NotesDocument) As Variant
AttachmentsName=Evaluate("@AttachmentNames(0)", objdoc)
End Function
Function HasAttachmentName(objdoc As NotesDocument, wildcard As String) As Boolean
	Dim arr As Variant
	arr=AttachmentsName(objdoc)
	If Not IsEmpty(arr) Then
		If IsArray(arr) Then
			ForAll a In arr
				If CStr(a) Like wildcard Then
					HasAttachmentName=True
					Exit Function
				End If
			End ForAll
		Else
			If CStr(arr) Like wildcard Then
				HasAttachmentName=True
			End If
		End If
	End If
End Function
[DOUBLEPOST=1436793735,1436793612][/DOUBLEPOST]получение дока из дб оформлена так
Код:
Function GetDocumentByUNIDSilent(db As NotesDatabase, UNID As String) As NotesDocument
	On Error GoTo ErrH
	Dim doc As NotesDocument
	Set doc = db.GetDocumentByUNID(UNID)
	If doc.IsValid And Not doc.IsDeleted Then
		'проверка - если, например, недоступен по readers
		If doc.Size > 0 Then
			Set GetDocumentByUNIDSilent = doc
		End If
	End If	
Quit:
	Exit Function
ErrH:
'   RaiseError
	Resume Quit
End Function
 

k85

Well-known member
11.10.2011
158
0
#7
извиняюсь, не могу разобраться немного
все работает классно, если документ уже был и его просто редактировать, а если новый, то пишет что ошибка в этой строке
Set Source=UpdateUIdoc(Source, {body})
 

lmike

нет, пердело совершенство
Премиум
27.08.2008
6 567
263
#9
после uidoc.Close(True) д.б.
Код:
	Dim isnew As Boolean
	isnew=doc.Isnewnote
	Delete uidoc
	If Not isnew Then
		Set doc=GetDocumentByUNIDSilent(ses.Currentdatabase,unid)
		ForAll itm In doc.Items
			Dim tmp As NotesItem
			Set tmp=itm
			Call tmp.Remove()
		End ForAll
		Call newdoc.Copyallitems(doc,True)
	Else
		Set doc=newdoc
	End If
сами сопоставьте код
[DOUBLEPOST=1436809183,1436809067][/DOUBLEPOST]удаление всех айтемов из дока (OnDisk) - м.б. что-то более оптимальное есть, но я заленился
 
Симпатии: Понравилось k85

k85

Well-known member
11.10.2011
158
0
#10
при использовать newdoc (при получении uidocNew) , ошибка
если использовать дебагер , то видно, что в новом документе все поля копируются, а файлы не в само поле Body помещаются, а ниже (вне полей)
 

k85

Well-known member
11.10.2011
158
0
#12
сейчас все удалю и заново попробую, так как не вышло, и уже не могу найти всех своих изменений. лучше все с нуля буду пробовать, просто для новых появилась опять проблема в этом месте Set Source=UpdateUIdoc(Source, {body})
 

k85

Well-known member
11.10.2011
158
0
#13
@lmike, спасибо огромнейшее, все заработало, после создания с нуля, все работает отлично
 

k85

Well-known member
11.10.2011
158
0
#14
появилась небольшая проблема, ранее после проверки переходило на Queryclose, где запускается заполение протокола изменений документа, а теперь после querysave далее не проходит по остальным и получается не заполняется протокол
 

k85

Well-known member
11.10.2011
158
0
#16
просто если проверять на соответствие определенных полей и записывать в протокол, а потом проверять вложение, то если вложение неверно, то человек может не захотеть сохранять ,а история должна уже будет сохраниться.

если в конце, то уже объекта нет (
 
Последнее редактирование модератором:

lmike

нет, пердело совершенство
Премиум
27.08.2008
6 567
263
#17
а история должна уже будет сохраниться.
если не захочет сохраняться док - до квери-сэйв не дойдет
а если не захочет после запроса - дык записать протокол уже можно было (на QS)
[DOUBLEPOST=1437398788,1437398630][/DOUBLEPOST]короче - всё можно определить на QS и обновление, вернее код по проверкам перенести в обновление, а на QS вызывать ViewRefresh
 

lmike

нет, пердело совершенство
Премиум
27.08.2008
6 567
263
#18
еще вариант - вызывать самому
Код:
Sub Querysave(Source As Notesuidocument, Continue As Variant)
Continue=True
Set Source=UpdateUIdoc(Source, {body})
If HasAttachmentName(Source.Document, {*.docx}) Then Msgbox {Attach is not valid}:Continue=False:Exit Sub
Source.Document.Save True, False
Call PostSave(Source)
End Sub
при условии что знаем что делаем ;)
[DOUBLEPOST=1437411929,1437411909][/DOUBLEPOST]и кстати - QueryClose отрабатывается и так
[DOUBLEPOST=1437412067][/DOUBLEPOST]
,а история должна уже будет сохраниться
а вот с этого места поподробнее - где история, что это?
 

k85

Well-known member
11.10.2011
158
0
#19
в базе на queryclose выполняется проверка соотвествия полей и вносится в поле информация, если изменили определенные поля, т.е. функция находится там
но у меня на querysave (если смотреть дебагером) все выполняется , ошибок нет,
проходит
If HasAttachmentName...
Source.Document.Save True, False
Call PostSave(Source) - переходит и возвращает назад на querysave
End If

End Sub
и выходит