• Познакомьтесь с пентестом веб-приложений на практике в нашем новом бесплатном курсе

    «Анализ защищенности веб-приложений»

    🔥 Записаться бесплатно!

  • CTF с учебными материалами Codeby Games

    Обучение кибербезопасности в игровой форме. Более 200 заданий по Active Directory, OSINT, PWN, Веб, Стеганографии, Реверс-инжинирингу, Форензике и Криптографии. Школа CTF с бесплатными курсами по всем категориям.

Singleton На Ls

  • Автор темы Darker
  • Дата начала
Статус
Закрыто для дальнейших ответов.
D

Darker

Доброе время суток, уважаемые форумчане!
Решил выложить скрипт библиотеки, используемую в нашей СЭД. Класс представляет из себя утилиту для использования готовых конструкций.
Объект класса создается единожды в рамках элемента дизайна (Агента, формы, вида,....)
Объект класса, созданный при инициализации формы доступен всем событиям формы, полям, а также кнопкам, общим действиям

Предложения и критика приветствуется

Код:
Option Declare 
Private mainUtil As Utils 

Public Const DB_CURRENT={CURRENT}
Public Const DB_NAMES={NAMES}
Public Const DB_DICTIONARY={DictionaryDB}

Private Const GET_MAIN_DOC_FORMULA={r:=@text($REF); result:=r; @While(r!=""; result:=r; r:=@Text(@GetDocField(r;"$REF"))); result}

'############################################################################
########################################
'=============== ЗАГОЛОВКИ ДИАЛОГОВ И MSGBOX ========================================================================
'############################################################################
########################################
Private Const TITLE_CHOISE_RU="Выбор"

'############################################################################
########################################
'=============== ТЕКСТЫ ДИАЛОГОВ И MSGBOX ===========================================================================
'############################################################################
Private Const PROMPT_CHOISE_RU="Выберите необходимый элемент"

'############################################################################
'=============== ТЕКСТЫ ОШИБОК ================================================================================
======
'############################################################################
########################################
Private Const ERROR_DATABASE_ACCESS="Не удается открыть БД "
Private Const ERROR_VIEW_ACCESS="Не удается открыть представление!"
Private Const ERROR_DOCUMENT_ACCESS_BY_URL="Не удается открыть документ по URL!"
Public Class Utils
Private session_ As NotesSession							
Private workspace_ As NotesUIWorkspace
Private profile_ As NotesDocument
Private currentDocument_ As NotesDocument
Private currentUIDocument_ As NotesUIDocument
Private db_ List As NotesDatabase	
Private userDir_ As String
Private className As String
Private views List As NotesView ' Так надо, для поиска документов по ключу

%REM
Sub New
Description: Comments for Sub
%END REM
Public Sub New()
Me.className="Utils"
End Sub

%REM
Sub Delete
Description: Деструктор
%END REM
Public Sub Delete()
Call eraseViews()
Set Me.profile_=Nothing
Set Me.currentDocument_=Nothing
Set Me.currentUIDocument_=Nothing
Erase me.db_
Set Me.session_=Nothing
Set Me.workspace_=Nothing
End Sub

%REM
Sub eraseViews
Description: Comments for Sub
%END REM
Public Sub eraseViews()
Erase Me.views
End Sub
%REM
Property Get session
Description: Возвращает сессию	
%END REM
Public Property Get session As NotesSession
On Error GoTo eh
If Me.session_ Is Nothing Then Set Me.session_=New NotesSession
Set session=Me.session_
GoTo ex
eh:
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+_
Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)
Resume ex 
ex:		
End Property

%REM
Property Get workspace
Description: Возвращает рабочее пространство	
%END REM
Public Property Get workspace As NotesUIWorkspace
On Error GoTo eh
If session.IsOnServer Then Exit Property
If Me.workspace_ Is Nothing Then Set Me.workspace_=New NotesUIWorkspace
Set workspace=Me.workspace_
GoTo ex
eh:		
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)
Resume ex
ex:		 
End Property

%REM
Property Get currentDatabase
Description: Comments for Property Get
%END REM
Public Property Get currentDatabase As NotesDatabase 
Set currentDatabase = getDatabase(DB_CURRENT)
End Property


%REM
Property Get profile
Description: Возвращает настройки системы
%END REM
Public Property Get profile As NotesDocument
On Error GoTo eh
If Me.profile_ Is Nothing Then Set Me.profile_ = currentDatabase.GetProfileDocument("Profile")
Set profile=Me.profile_
GoTo ex
eh:		
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)
Resume ex
ex: 
End Property

%REM
Property Get getDatabase
Description: Comments for Property Get
%END REM
Public Property Get getDatabase(index As String) As NotesDatabase
On Error GoTo eh

If Not IsElement(me.db_(index)) Then
Select Case index
Case DB_CURRENT:
Set me.db_(index) = session.currentDatabase
Case DB_NAMES:
Set me.db_(index) = getDatabase_(serverName, "names.nsf")
Case Else:
Set me.db_(index) = getDatabase_(serverName, profile.getitemvalue(index)(0))
End Select
End If

Set getDatabase = me.db_(index)
GoTo ex
eh:
MsgBox Error + Chr(10) + "№: "+CStr(Err)+Chr(10)+"Class: "+me.className+ Chr(10)+"Method: "+CStr(LSI_Info(2))+Chr(10)+"Caller: "+CStr(LSI_Info(12))+Chr(10)+"Line: "+CStr(Erl)
Resume ex
ex:
End Property

%REM
Function getDatabase_
Description: Comments for Function
%END REM
Private Function getDatabase_(serverName As String, dbPath As String) As NotesDatabase
On Error GoTo eh
Dim db As NotesDatabase

Set db = session.getDatabase(serverName, dbPath)
If Not isDatabaseEnabled(db) Then
MsgBox "Невозможно открыть БД на сервере: " + serverName + ", путь: " + dbPath
Set db = Nothing
End if

Set getDatabase_=db
GoTo ex
eh:
MsgBox Error + Chr(10) + "№: "+CStr(Err)+Chr(10)+"Class: "+me.className+ Chr(10)+"Method: "+CStr(LSI_Info(2))+Chr(10)+"Caller: "+CStr(LSI_Info(12))+Chr(10)+"Line: "+CStr(Erl)
Resume ex
ex:
End Function


%REM
Function isDatabaseEnabled
Description: Проверка БД на существование
%END REM
Private Function isDatabaseEnabled(db As NotesDatabase) As Boolean
On Error GoTo eh

Call db.GetOption(DBOPT_LZCOMPRESSION)
isDatabaseEnabled=True

GoTo ex
eh:
isDatabaseEnabled=False
Resume ex
ex:
End Function

%REM
Property Get serverName
Description: Возвращает имя текущего сервера
%END REM
Public Property Get serverName() As String
serverName=getDatabase(DB_CURRENT).server
End Property

%REM
Property Get userName
Description: Возвращает LN адрес текущего пользователя
%END REM
Public Property Get userName() As String
userName=session.Username
End Property

%REM
Property Get serverNow
Description: Возвращает текущую дату/время сервера
%END REM
Public Property Get serverNow() As Variant
serverNow=CDat(RunEvaluate({@Now([ServerTime]:[LocalTimeOnError]; @ServerName)}, Nothing))
End Property

%REM
Property Get currentDocument
Description: Возвращает текущий документ backend
%END REM
Public Property Get currentDocument As NotesDocument
On Error GoTo eh
If session.IsOnServer Then Exit Property
If Me.currentDocument_ Is Nothing Then Set Me.currentDocument_=workspace.CurrentDocument.Document
Set currentDocument=Me.currentDocument_
GoTo ex
eh:		
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)
Resume ex
ex: 
End Property

%REM
Property Get currentUIDocument
Description: Возвращает текущий документ frontend
%END REM
Public Property Get currentUIDocument As NotesUIDocument
On Error GoTo eh
If session.IsOnServer Then Exit Property
If Me.currentUIDocument_ Is Nothing Then Set Me.currentUIDocument_=workspace.CurrentDocument
Set currentUIDocument=Me.currentUIDocument_
GoTo ex
eh:		
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)
Resume ex
ex: 
End Property

%REM
Property Get userDir
Description: Путь к папке временных файлов пользователя
%END REM
Public Property Get userDir As String
If Me.userDir_="" Then Me.userDir_=Environ("TEMP")+"/"
userDir=Me.userDir_
End Property

%REM
Property Get lotusDir
Description: Comments for Property Get
%END REM
Public Property Get lotusDir As String
lotusDir=RunEvaluate({@LeftBack(@ReplaceSubString(@ConfigFile; "\\"; "/"); "/")}, Nothing)
End Property

%REM
Function decode
Description: Comments for Function
%END REM
Public Function encode(s As String) As String
On Error GoTo eh

encode = Me.RunEvaluate(|@URLEncode("Domino";{|+s+|})|, Nothing)

GoTo ex
eh:
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)+_
Chr(10)+s
Resume ex
ex:
End Function

%REM
Function encode
Description: Comments for Function
%END REM
Public Function decode(s As String) As String
On Error GoTo eh

decode = Me.RunEvaluate(|@URLDecode("Domino";{|+s+|})|, Nothing)

GoTo ex
eh:
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)+_
Chr(10)+s
Resume ex
ex:
End Function

%REM
Function getPassword
Description: Comments for Function
%END REM
Public Function getPassword(value As string) As String
getPassword=runEvaluate(|@middle(@password({|+value+|}); "("; ")")|, Nothing)
End Function

'############################################################################
####################################
'------------------------------------------------------- ВСПОМОГАТЕЛЬНЫЕ ФУНКЦИИ -------------------------------------------------------------------------------------------------------------------------------------------------	
'############################################################################
####################################

%REM
Function RunEvaluate 
Description: Выполнение Evaluate, возвращает строку (только первый элемент)
%END REM 
Public Function RunEvaluate(formula As String, doc As NotesDocument) As String
Dim returnValue As Variant
RunEvaluate=""
On Error GoTo eh

If doc Is Nothing Then returnValue=Evaluate(formula) Else returnValue=Evaluate(formula, doc)
If IsArray(returnValue) Then RunEvaluate=CStr(returnValue(0))
GoTo ex
eh:		
Print Error+" №"+Cstr(Err)+" ("+Me.className+" class) in "+Cstr(GetThreadInfo(1))+" on line "+Cstr(Erl)+Chr(10)+formula
Resume ex
ex: 
End Function	

%REM
Function GetDocumentByUNID
Description: Получение документа по UNID в БД <db> (обработка события, когда документа с UNID в db нет)
%END REM	
Public Function GetDocumentByUNID(db As NotesDatabase, UNID As String) As NotesDocument
On Error GoTo eh
Dim tempDoc As NotesDocument
If db Is Nothing then Goto ex
Set tempDoc=db.GetDocumentByUNID(UNID)
If tempDoc.Universalid="" Then Set tempDoc=Nothing
Set GetDocumentByUNID=tempDoc

GoTo ex 
eh:		
Set GetDocumentByUNID=Nothing 
Resume ex
ex: 
End Function

%REM
Function GetDocumentByID
Description: Получение документа по ID в БД <db> (обработка события, когда документа с ID в db нет)
%END REM	
Public Function GetDocumentByID(db As NotesDatabase, ID As String) As NotesDocument
On Error Goto eh

Dim tempDoc As NotesDocument
If db Is Nothing Then Goto ex
Set tempDoc=db.GetDocumentByID(ID)
If tempDoc.Universalid="" Then Set tempDoc=Nothing
Set GetDocumentByID=tempDoc

Goto ex 
eh:		
Set GetDocumentByID=Nothing 
Resume ex
ex: 
End Function

%REM
Function GetDocumentByURL
Description: Получение документа <doc> по <URL>, возвращает TRUE если удалось получить
%END REM
Public Function GetDocumentByURL(url As String, doc As NotesDocument) As Boolean
On Error GoTo eh
Set doc=session.Resolve(url) 
If doc Is Nothing Then Print ERROR_DOCUMENT_ACCESS_BY_URL : GoTo ex
GetDocumentByURL=True
GoTo ex
eh:
Print ERROR_DOCUMENT_ACCESS_BY_URL
Resume ex
ex:
End Function

%REM
Function GetEmpyCollection
Description: Получение пустой коллекции в БД <db>
%END REM
Public Function GetEmpyCollection(db As NotesDatabase) As NotesDocumentCollection
Set GetEmpyCollection=db.GetProfileDocCollection("EMPTY_COLLECTION")
End Function

%REM
Function GetSearchDocCollection
Description: Получение коллекции документов в БД <db>, в представлении <ViewName> по ключу <srchKeysArray>
%END REM
Public Function GetSearchDocCollection (db As NotesDatabase, ViewName As String, srchKeysArray As Variant, saveView As Boolean) As NotesDocumentCollection
On Error GoTo eh
If db Is Nothing Then GoTo emptyCollection
Dim view As NotesView, index As String
index =db.Replicaid+"^"+ViewName
If IsElement(Me.views(index)) Then
Set view=Me.views(index)
If view Is Nothing Then GoTo reGetView
Else
reGetView:	
Set view = db.GetView(ViewName)
If view Is Nothing Then GoTo emptyCollection
If saveView Then Set Me.views(index)=view
End If
Set GetSearchDocCollection = view.GetAllDocumentsByKey(srchKeysArray, True)
Exit Function
GoTo ex
eh:		
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)
Resume emptyCollection 
emptyCollection:	
Set GetSearchDocCollection = GetEmpyCollection(currentDatabase)
ex:
End Function

%REM
Function GetSearchDoc
Description: Получение документa в БД <db>, в представлении <ViewName> по ключу <srchKeysArray>
%END REM
Public Function GetSearchDoc(db As NotesDatabase, ViewName As String, srchKeysArray As Variant, saveView As Boolean) As NotesDocument
Dim col As NotesDocumentCollection
Set col=GetSearchDocCollection(db, ViewName, srchKeysArray, saveView)
If col.Count>0 Then Set GetSearchDoc=col.Getfirstdocument()
End Function

%REM
Function GetDocumentTreeByFormula
Description: Получение дерева дочерних документов документа <doc> по формуле <formula>
%END REM
Public Function GetDocumentTreeByFormula(doc As NotesDocument, formula As String, exitOnFalse As Boolean) As NotesDocumentCollection
On Error GoTo eh

Dim resultCol As NotesDocumentCollection
Set resultCol = GetEmpyCollection(doc.ParentDatabase)
Call GetFamily(doc, resultCol, formula, exitOnFalse)
Set GetDocumentTreeByFormula=resultCol
GoTo ex
eh:		
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)
Resume ex
ex: 
End Function

Private Sub GetFamily(d As NotesDocument, mcol As NotesDocumentCollection, formula As String, exitOnFalse As Boolean) 
On Error GoTo eh

If formula<>"" Then	
If RunEvaluate(formula, d)="1" Then 
If mcol.GetDocument(d) Is Nothing Then mcol.AddDocument d
Else
If exitOnFalse Then GoTo ex
End If
Else
If mcol.GetDocument(d) Is Nothing Then mcol.AddDocument d	
End If

Dim c As NotesDocumentCollection, rd As NotesDocument, i As Integer
If d.ParentDocumentUNID=d.UniversalID Then Exit Sub

Set c=d.Responses
If c Is Nothing Then GoTo ex Else If c.Count=0 Then GoTo ex
Set rd=c.GetFirstDocument
For i=1 To c.Count
Call GetFamily(rd, mcol, formula, exitOnFalse)
Set rd=c.GetNextDocument(rd)
Next
GoTo ex
eh:		
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)
Resume ex
ex: 
End Sub

%REM
Function GetResponses
Description: Получение коллекции дочерних документов - <respColl> документа <doc>, возвращает True если коллекция не пустая
%END REM
Function GetResponses(doc As NotesDocument, respColl As NotesDocumentCollection) As Boolean
On Error GoTo eh

Set respColl=doc.Responses
If respColl Is Nothing Then GoTo emptyCollection Else If respColl.Count=0 Then GoTo ex
GetResponses=True
GoTo ex
eh:		
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)
Resume ex 
emptyCollection:	
Set respColl = GetEmpyCollection(doc.ParentDatabase)
ex:
End Function

%REM
Function GetMainDocument
Description: Получение самого основного документа от документа <doc>
%END REM
Public Function GetMainDocument(doc As NotesDocument) As NotesDocument
Set GetMainDocument = getDocumentByUNID(doc.ParentDatabase, runEvaluate(GET_MAIN_DOC_FORMULA, doc))
End Function

%REM
Function GetParentDocument
Description: Получение родительского документа от документа <doc>
%END REM
Public Function GetParentDocument(doc As NotesDocument) As NotesDocument
Set GetParentDocument=GetDocumentByUNID(doc.Parentdatabase, doc.Parentdocumentunid)
End Function

%REM
Function GetUnprocessedDocument
Description: Выбор выделенного документа
%END REM
Public Function GetUnprocessedDocument As NotesDocument
On Error GoTo eh

Dim col As NotesDocumentCollection
Set col=currentDatabase.UnprocessedDocuments
If col.Count=0 Then Exit Function
Set GetUnprocessedDocument=col.GetFirstDocument
GoTo ex
eh:		
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)
Resume ex
ex: 
End Function

%REM
Function GetPickListCollection
Description: Выбор коллекции из справочника
%END REM
Public Function GetPickListCollection(db As NotesDatabase, viewName As String, singleCategory As String) As NotesDocumentCollection
On Error GoTo eh

If db Is Nothing Then MsgBox ERROR_DATABASE_ACCESS:GoTo emptyCollection
If viewName = "" Then MsgBox ERROR_VIEW_ACCESS:GoTo emptyCollection

If singleCategory="" Then
Set GetPickListCollection = workspace.Picklistcollection(PICKLIST_CUSTOM, True, db.Server, db.Filepath, viewName, TITLE_CHOISE_RU, PROMPT_CHOISE_RU)
Else
Set GetPickListCollection = workspace.Picklistcollection(PICKLIST_CUSTOM, True, db.Server, db.Filepath, viewName, TITLE_CHOISE_RU, PROMPT_CHOISE_RU, singleCategory)
End If

GoTo ex
eh:		
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)
Resume ex
emptyCollection:		
Set GetPickListCollection = GetEmpyCollection(db)
ex:
End Function

%REM 
Function GetPickListDocument
Description: Выбор документа из справочника
%END REM
Public Function GetPickListDocument(db As NotesDatabase, viewName As String, singleCategory As String) As NotesDocument
On Error GoTo eh

Dim col As NotesDocumentCollection
Set col = GetPickListCollection(db, viewName, singleCategory)
If col.Count=0 Then Exit Function
Set GetPickListDocument = col.Getfirstdocument()
GoTo ex
eh:		
MsgBox Error+" №"+Cstr(Err)+Chr(10)+"Class: "+Me.className+Chr(10)+"Method: "+Cstr(LSI_Info(2))+Chr(10)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)
Resume ex
ex:
End Function
End Class

Sub Terminate
Call recycleUtil()
End Sub

Public Function Util As Utils 
If mainUtil Is Nothing Then Set mainUtil=New Utils()	
Set util=mainUtil
End Function


%REM
Sub recycleUtil
Description: Comments for Sub
%END REM
Public Sub recycleUtil()
If Not mainUtil Is Nothing Then Delete mainUtil
End Sub

Пример использования:

Код:
	Dim doc As NotesDocument
Dim pCol As NotesDocumentCollection
Dim dicDB As NotesDatabase

Set doc=Util().GetUnprocessedDocument()
Set pCol=Util().GetPickListCollection(Util().currentDatabase, "ViewName", doc.TempField(0))

Set dicDB=Util().getDatabase(DB_DICTIONARY)
Call recycleUtil()
 
T

turumbay

А где сабж?
Синглетона не увидел. Что помешает клиенту создать еще один экземпляр класса, вызвав Dim myUtils As New Utils()?
https://codeby.net/threads/30935
 
D

Darker

Ничто мне не мешает превратить класс в Private. Просто тогда, на новом дизайнере не всплывают методы класса
 
T

turumbay

по мелочи :
Код:
Public Function GetDocumentByID(db As NotesDatabase, ID As String) As NotesDocument
On Error GoTo eh

Set GetDocumentByID=Nothing
On Error Resume Next
Set GetDocumentByID=db.GetDocumentByID(ID)
GoTo ex
eh:		
MsgBox Error+" №"+Cstr(Err)+Chr(13)+"Class: "+Me.className+Chr(13)+"Method: "+Cstr(LSI_Info(2))+Chr(13)+"Called by: "+CStr(LSI_Info(12))+" on line "+Cstr(Erl)
Resume ex
ex: 
End Function
Либо убрать обработчик ошибок, либо заменить On Error Resume Next на On Error 4091 Resume Next
А вообще - ничетак. Кэширование вьюшек - респект.

Добавлено:
Ничто мне не мешает превратить класс в Private. Просто тогда, на новом дизайнере не всплывают методы класса
Если превратите в приватный - придется поменять сигнатуру Public Function Util As Utils на Public Function Util As Variant
Неработающий автокомлит - фигня по сравнению с тем, что у вас пропадает проверка времени компиляции, т.е. начнет нормально компилироваться следующее:
Код:
	' Кладем NotesDocument в NotesDatabase :-)
Dim db As NotesDatabase
Set db=Util().GetUnprocessedDocument()
Об ошибке узнаете только в рантайме...
 
H

hosm

On Error 4091 Resume Next - это же только для UNID (емнип), не к той ф-ции придрались
 
N

nvyush

Код:
	Public Function GetEmpyCollection(db As NotesDatabase) As NotesDocumentCollection
Set GetEmpyCollection=db.GetProfileDocCollection("EMPTY_COLLECTION")
End Function
Начиная с 8-ки вроде как есть NotesDatabase.CreateDocumentCollection
 

lmike

нет, пердело совершенство
Lotus Team
27.08.2008
7 933
609
BIT
177
по "правильному" - Chr(13) (аки <CR>) - возврат каретки, переводом строки не является!
<LF> - Chr(10)
 
T

turumbay

On Error 4091 Resume Next - это же только для UNID (емнип), не к той ф-ции придрались
да я не к юнид придрался, а к не работающему обработчику: он там либо вообще лишний(вставленный копипастом), либо планировалось ловить что-нить конкретное.
А кстати, что там вообще может вылететь? Если отлупит по правам - то наверно можно вернуть пустоту? Если конекшен отвалился, вроде как криминально и нужно кидать исключение?
А 4091 - точно, не к месту.
 

Darkhan

Green Team
14.12.2012
99
2
BIT
0
В свете недавнего упоминания про метод DisgestSearch, добавлено:
Код:
 %REM
Function getDocumentByDigestKey
Description: Возвращает документ из БД <sourceDB> по ключу <key>
createOnNothing - если True, то при не нахождении документа создает новый документ по ключу key
%END REM
Public Function getDocumentByDigestKey(sourceDB As NotesDatabase, key As String, createOnNothing As Boolean) As NotesDocument
Dim returnDoc As NotesDocument, unid As String

'Если посылаемая БД недоступна или пустой ключ, то выход
If sourceDB Is Nothing Or Trim(key)="" Then GoTo ex

'Формирования зашифрованного ключа для поиска
unid=RunEvaluate("@Middle(@Password({"+key+"}); {(}; {)})", Nothing)
If unid="" Then GoTo ex

Set returnDoc=getDocumentByUNID(sourceDB, unid)

'Если по ключу не нашел и есть необходимость создания
If (returnDoc Is Nothing) And createOnNothing Then
Set returnDoc=New NotesDocument(sourceDB)
returnDoc.Universalid=unid
End If

Set getDocumentByDigestKey=returnDoc
ex:
End Function
 
D

divankin

Очень хорошо и интересно. Но есть что пообсуждать

Обработка ошибок
1. Почему используется LSI_Info, а не GetThreadInfo? Второе считается потокобезопасным.
2. Ошибки хорошо бы складывать в специальную базу. Так намного быстрее узнаешь о проблемах, можно начать исправлять до того как пользователь не сообщил об ошибке. Кроме того, в документ можно записывать кучу служебной информации о месте вызова, пользователе, его правах, сервере и т.п.
3. Часто не достаточно знать название вызвавшей функции. Лучше выводить весь стек вызовов, а для этого лучше непредусмотренные ошибки не гасить, а передавать вверх. А там пусть сами разбираются, гасить ошибку или откатывать транзакцию и заканчивать работу (при массовой обработке переходить к следующему документу).

Методы
4. Зачем делать session, currentDocument и др. приватными? Кого вы боитесь, что их переопределят? Тем более что в некоторых случаях лучше устанавливать эти значения извне. Например, с currentUIDocument желательно использовать не WS.CurrentDocument, а из Source в событии открытия документа.
5. Очень много функций на одну-две строчки. Зачем лишний вызов функции?
6. Также есть функции, которые зачем-то вызывают другие функции класса чисто ради переиспользования кода, хотя лучше было бы написать свой код для этого случая. Например, зачем из GetPickListDocument вызывать GetPickListCollection и предлагать пользователю выбрать несколько документов, если по логике нужен один?
7. RunEvaluate: на мой взгляд, если формула возвращает дату, то и функция должна возвращать дату. Зачем лишние преобразования туда-обратно?
Я вообще намучился с этими датами, когда дата на одном сервере перегоняется в строку, а потом на другом сервере с другими локальными настройками преобразуется обратно, то не всегда получаю ту же самую дату :mellow: Поэтому предпочитаю даты хранить, как даты.
8. GetMainDocument: я бы переделал на чистый скрипт, а не использование формулы. Случается, что родитель сам является респонзом одного из потомков. Эту ситуацию хорошо бы отлавливать и извещать о ней саппорт.
Кроме того, считаю хорошим тоном в потомках в отдельных полях хранить UNID корневого документа и UNID родителя.
9. GetUnprocessedDocument: если агент может запускаться из вьюхи, а может из формы, то лучше сначала проверять а не открыт ли документ в UI, и только потом брать UnprocessedDocuments.
10. GetDocumentByUNID: а не валидные и удаленные документы вам тоже нужны? А документы, к которым нет доступа?
11. Не понимаю recycleUtils, тем более в таком виде, что он почти ничего не делает. При штатном удалении при выгрузке библиотеки и так все это произойдет.
12. isDatabaseEnabled: а если у пользователя нет доступа к базе, или база в данный момент компактится или еще какая-нибудь бяка, то что произойдет? В чем разница GetOption и штатного isOpen?
13. getDatabase: то есть у вас нельзя таким образом получить базу с другого сервера?
14. getDatabase: если profile.getitemvalue(index)(0) указывает текущую базу, то у вас откроется второй объект текущей базы данных, чего лучше избегать. Я бы добавил проверку, что profile.getitemvalue(index)(0) указывает на текущую базу.

Профиль
15. Объясните как вы используете профиль. По мне так профили из-за своего кэширования довольно нестабильная штука, если использовать один профиль для всех пользователей. Часто можно столкнуться с тем, что изменения сделанные в профиле были перезаписаны пользователем, у которого закэшировалась старая версия профиля. Как вы с этим боретесь?

Мелочи по стилю
16. Зачем нужен className, если есть Typename(me)?
17. Где-то используется Goto ex, а где-то Exit Function (Sub, Property). На мой взгляд лучше везде Goto ex. Здесь это неважно, но лучше выработать в себе привычку всегда переходить к блоку, где может быть finally.
 
D

divankin

18. По кэшированию вьюшек: а если мне нужно отрефрешить закэшированную вьюшку, то что делать?
 

Darkhan

Green Team
14.12.2012
99
2
BIT
0
1. Почему используется LSI_Info, а не GetThreadInfo? Второе считается потокобезопасным.
не знал, спасибо
2. Ошибки хорошо бы складывать в специальную базу. Так намного быстрее узнаешь о проблемах, можно начать исправлять до того как пользователь не сообщил об ошибке. Кроме того, в документ можно записывать кучу служебной информации о месте вызова, пользователе, его правах, сервере и т.п.
Класс можно расширять исходя из потребностей
3. Часто не достаточно знать название вызвавшей функции. Лучше выводить весь стек вызовов, а для этого лучше непредусмотренные ошибки не гасить, а передавать вверх. А там пусть сами разбираются, гасить ошибку или откатывать транзакцию и заканчивать работу (при массовой обработке переходить к следующему документу).
На момент публикации кода, не было такой задумки, теперь ясно, что это актуально
Методы
4. Зачем делать session, currentDocument и др. приватными? Кого вы боитесь, что их переопределят? Тем более что в некоторых случаях лучше устанавливать эти значения извне. Например, с currentUIDocument желательно использовать не WS.CurrentDocument, а из Source в событии открытия документа.
пытался замутить pojo в лотусе)))) Относительно Source, ИМХО, разработчику виднее: надо использовать Source - пущая использует
6. Также есть функции, которые зачем-то вызывают другие функции класса чисто ради переиспользования кода, хотя лучше было бы написать свой код для этого случая. Например, зачем из GetPickListDocument вызывать GetPickListCollection и предлагать пользователю выбрать несколько документов, если по логике нужен один?
все, понял, переиспользование - зло))
7. RunEvaluate: на мой взгляд, если формула возвращает дату, то и функция должна возвращать дату. Зачем лишние преобразования туда-обратно?
Я вообще намучился с этими датами, когда дата на одном сервере перегоняется в строку, а потом на другом сервере с другими локальными настройками преобразуется обратно, то не всегда получаю ту же самую дату :mellow: Поэтому предпочитаю даты хранить, как даты.
учел, появилась расширенная функция RunEvaluateObject
8. GetMainDocument: я бы переделал на чистый скрипт, а не использование формулы. Случается, что родитель сам является респонзом одного из потомков. Эту ситуацию хорошо бы отлавливать и извещать о ней саппорт.
Ситуацию с конфликтом можно обработать и на "собаках", а на счет извещения согласен
10. GetDocumentByUNID: а не валидные и удаленные документы вам тоже нужны? А документы, к которым нет доступа?
Все зависет от ситуации, можно загнать параметры типа: нужен норм, не конфликт, с формой, с доступом, и.т.д.
11. Не понимаю recycleUtils, тем более в таком виде, что он почти ничего не делает. При штатном удалении при выгрузке библиотеки и так все это произойдет.
Старожилы форума другого мнения...
12. isDatabaseEnabled: а если у пользователя нет доступа к базе, или база в данный момент компактится или еще какая-нибудь бяка, то что произойдет? В чем разница GetOption и штатного isOpen?
не спорю, можно...
13. getDatabase: то есть у вас нельзя таким образом получить базу с другого сервера?
учел
Профиль
15. Объясните как вы используете профиль. По мне так профили из-за своего кэширования довольно нестабильная штука, если использовать один профиль для всех пользователей. Часто можно столкнуться с тем, что изменения сделанные в профиле были перезаписаны пользователем, у которого закэшировалась старая версия профиля. Как вы с этим боретесь?
от профилей отказались, создаем/получаем системный документ по DigestSearch, (в т.ч. чтение полей настроек на собаках)
18. По кэшированию вьюшек: а если мне нужно отрефрешить закэшированную вьюшку, то что делать?
изначально не кэшить эту вьюху
 

Darkhan

Green Team
14.12.2012
99
2
BIT
0
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">"Последняя редакция:"</div></div><div class="sp-body"><div class="sp-content">
Код:
Option Declare 
Private mainUtil As Utils 

Private Const nLine = {
}

Public Const DB_CURRENT={CURRENT}
Public Const DB_NAMES={NAMES}
Public Const DB_DICTIONARY={DictionaryDB}

Private Const GET_MAIN_DOC_FORMULA={
r:=@text($REF); result:=r; @While(r!=""; result:=r; r:=@Text(@GetDocField(r;"$REF"))); result
}

Private Const TITLE_CHOISE_RU="Выбор"
'=============== ТЕКСТЫ ДИАЛОГОВ И MSGBOX ===========================================================================
'############################################################################
Private Const PROMPT_CHOISE_RU="Выберите необходимый элемент"
Private Const ERROR_DATABASE_ACCESS="Не удается открыть БД "
Private Const ERROR_VIEW_ACCESS="Не удается открыть представление!"
Private Const ERROR_DOCUMENT_ACCESS_BY_URL="Не удается открыть документ по URL!"


Private Class Utils
Private session_ As NotesSession							
Private workspace_ As NotesUIWorkspace
Private profile_ As NotesDocument
Private currentDocument_ As NotesDocument
Private currentUIDocument_ As NotesUIDocument
Private db_ List As NotesDatabase	
Private userDir_ As String
Private className As String
Private views List As NotesView ' Так надо, для поиска документов по ключу

%REM
Sub New
Description: Comments for Sub
%END REM
Public Sub New()
Me.className="Utils"
End Sub

%REM
Sub Delete
Description: Деструктор
%END REM
Public Sub Delete()
Call eraseViews()
Set Me.profile_=Nothing
Set Me.currentDocument_=Nothing
Set Me.currentUIDocument_=Nothing
Erase me.db_
Set Me.session_=Nothing
Set Me.workspace_=Nothing
End Sub

%REM
Sub eraseViews
Description: Comments for Sub
%END REM
Public Sub eraseViews()
Erase Me.views
End Sub
%REM
Property Get session
Description: Возвращает сессию	
%END REM
Public Property Get session As NotesSession
On Error GoTo eh
If Me.session_ Is Nothing Then Set Me.session_=New NotesSession
Set session=Me.session_
GoTo ex
eh:
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl
ex:		
End Property

%REM
Property Get workspace
Description: Возвращает рабочее пространство	
%END REM
Public Property Get workspace As NotesUIWorkspace
On Error GoTo eh
If session.IsOnServer Then Exit Property
If Me.workspace_ Is Nothing Then Set Me.workspace_=New NotesUIWorkspace
Set workspace=Me.workspace_
GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl
ex:		 
End Property

%REM
Property Get currentDatabase
Description: Comments for Property Get
%END REM
Public Property Get currentDatabase As NotesDatabase 
Set currentDatabase = getDatabase(DB_CURRENT)
End Property


%REM
Property Get profile
Description: Возвращает настройки системы
%END REM
Public Property Get profile As NotesDocument
On Error GoTo eh
If Me.profile_ Is Nothing Then Set Me.profile_ = currentDatabase.GetProfileDocument("Profile")
Set profile=Me.profile_
GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl
ex: 
End Property

%REM
Property Get getDatabase
Description: Comments for Property Get
%END REM
Public Property Get getDatabase(index As String) As NotesDatabase
On Error GoTo eh

If Not IsElement(me.db_(index)) Then
Select Case index
Case DB_CURRENT:
Set me.db_(index) = session.currentDatabase
Case DB_NAMES:
Set me.db_(index) = getDatabaseExt(serverName, "names.nsf")
Case Else:
Set me.db_(index) = getDatabaseExt(serverName, profile.getitemvalue(index)(0))
End Select
End If

Set getDatabase = me.db_(index)
GoTo ex
eh:
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl
ex:
End Property

%REM
Function getDatabase_
Description: Comments for Function
%END REM
Public Function getDatabaseExt(serverName As String, dbPath As String) As NotesDatabase
On Error GoTo eh
Dim db As NotesDatabase

Set db = session.getDatabase(serverName, dbPath)
If Not isDatabaseEnabled(db) Then
MsgBox "Невозможно открыть БД на сервере: " + serverName + ", путь: " + dbPath
Set db = Nothing
End If

Set getDatabaseExt=db
GoTo ex
eh:
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl
ex:
End Function


%REM
Function isDatabaseEnabled
Description: Проверка БД на существование
%END REM
Private Function isDatabaseEnabled(db As NotesDatabase) As Boolean
On Error GoTo eh

Call db.GetOption(DBOPT_LZCOMPRESSION)
isDatabaseEnabled=True

GoTo ex
eh:
isDatabaseEnabled=False
Resume ex
ex:
End Function

%REM
Property Get serverName
Description: Возвращает имя текущего сервера
%END REM
Public Property Get serverName() As String
serverName=getDatabase(DB_CURRENT).server
End Property

%REM
Property Get userName
Description: Возвращает LN адрес текущего пользователя
%END REM
Public Property Get userName() As String
userName=session.Username
End Property

%REM
Property Get serverNow
Description: Возвращает текущую дату/время сервера
%END REM
Public Property Get serverNow() As Variant
serverNow=CDat(RunEvaluate({@Now([ServerTime]:[LocalTimeOnError]; @ServerName)}, Nothing))
End Property

%REM
Property Get currentDocument
Description: Возвращает текущий документ backend
%END REM
Public Property Get currentDocument As NotesDocument
On Error GoTo eh
If session.IsOnServer Then Exit Property
If Me.currentDocument_ Is Nothing Then Set Me.currentDocument_=workspace.CurrentDocument.Document
Set currentDocument=Me.currentDocument_
GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl
ex: 
End Property

%REM
Property Get currentUIDocument
Description: Возвращает текущий документ frontend
%END REM
Public Property Get currentUIDocument As NotesUIDocument
On Error GoTo eh
If session.IsOnServer Then Exit Property
If Me.currentUIDocument_ Is Nothing Then Set Me.currentUIDocument_=workspace.CurrentDocument
Set currentUIDocument=Me.currentUIDocument_
GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl
ex: 
End Property

%REM
Property Get userDir
Description: Путь к папке временных файлов пользователя
%END REM
Public Property Get userDir As String
If Me.userDir_="" Then Me.userDir_=Environ("TEMP")+"/"
userDir=Me.userDir_
End Property

%REM
Property Get lotusDir
Description: Comments for Property Get
%END REM
Public Property Get lotusDir As String
lotusDir=RunEvaluate({@LeftBack(@ReplaceSubString(@ConfigFile; "\\"; "/"); "/")}, Nothing)
End Property

'------------------------------------------------------- ВСПОМОГАТЕЛЬНЫЕ ФУНКЦИИ -------------------------------------------------------------------------------------------------------------------------------------------------	

%REM
Function RunEvaluate 
Description: Выполнение Evaluate, возвращает строку (только первый элемент)
%END REM 
Public Function RunEvaluate(formula As String, doc As NotesDocument) As String
On Error GoTo eh
Dim result As Variant

result = RunEvaluateObject(formula, doc)
If IsArray(result) Then RunEvaluate=CStr(result(0))

GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl & nLine & formula 
ex: 
End Function	

%REM
Function RunEvaluateObject 
Description: Выполнение Evaluate, возвращает variant
%END REM 
Public Function RunEvaluateObject(formula As String, doc As NotesDocument) As Variant
Dim returnValue As Variant
On Error GoTo eh

If doc Is Nothing Then 
RunEvaluateObject=Evaluate(formula) 
Else 
RunEvaluateObject=Evaluate(formula, doc)
End If

GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl & nLine & formula 
ex: 
End Function 

%REM
Function GetDocumentByUNID
Description: Получение документа по UNID в БД <db> (обработка события, когда документа с UNID в db нет)
%END REM	
Public Function GetDocumentByUNID(db As NotesDatabase, UNID As String) As NotesDocument
On Error GoTo eh
Dim tempDoc As NotesDocument
If db Is Nothing Then GoTo ex
Set tempDoc=db.GetDocumentByUNID(UNID)
If tempDoc.Universalid="" Then Set tempDoc=Nothing
Set GetDocumentByUNID=tempDoc

GoTo ex 
eh:		
Set GetDocumentByUNID=Nothing 
Resume ex
ex: 
End Function

%REM
Function GetDocumentByID
Description: Получение документа по ID в БД <db> (обработка события, когда документа с ID в db нет)
%END REM	
Public Function GetDocumentByID(db As NotesDatabase, ID As String) As NotesDocument
On Error GoTo eh

Dim tempDoc As NotesDocument
If db Is Nothing Then GoTo ex
Set tempDoc=db.GetDocumentByID(ID)
If tempDoc.Universalid="" Then Set tempDoc=Nothing
Set GetDocumentByID=tempDoc

GoTo ex 
eh:		
Set GetDocumentByID=Nothing 
Resume ex
ex: 
End Function

%REM
Function GetEmpyCollection
Description: Получение пустой коллекции в БД <db>
%END REM
Public Function GetEmpyCollection(db As NotesDatabase) As NotesDocumentCollection
Set GetEmpyCollection=db.GetProfileDocCollection("EMPTY_COLLECTION")
End Function

%REM
Function GetSearchDocCollection
Description: Получение коллекции документов в БД <db>, в представлении <ViewName> по ключу <srchKeysArray>
%END REM
Public Function GetSearchDocCollection (db As NotesDatabase, ViewName As String, srchKeysArray As Variant, saveView As Boolean) As NotesDocumentCollection
On Error GoTo eh
If db Is Nothing Then GoTo emptyCollection
Dim view As NotesView, index As String
index =db.Replicaid+"^"+ViewName
If IsElement(Me.views(index)) Then
Set view=Me.views(index)
If view Is Nothing Then GoTo reGetView
Else
reGetView:	
Set view = db.GetView(ViewName)
If view Is Nothing Then GoTo emptyCollection
If saveView Then Set Me.views(index)=view
End If
Set GetSearchDocCollection = view.GetAllDocumentsByKey(srchKeysArray, True)
Exit Function
GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl 
emptyCollection:	
Set GetSearchDocCollection = GetEmpyCollection(currentDatabase)
ex:
End Function

%REM
Function GetSearchDoc
Description: Получение документa в БД <db>, в представлении <ViewName> по ключу <srchKeysArray>
%END REM
Public Function GetSearchDoc(db As NotesDatabase, ViewName As String, srchKeysArray As Variant, saveView As Boolean) As NotesDocument
On Error GoTo eh

Dim col As NotesDocumentCollection
Set col=GetSearchDocCollection(db, ViewName, srchKeysArray, saveView)
If col.Count>0 Then Set GetSearchDoc=col.Getfirstdocument()
GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl 
ex: 
End Function

%REM
Function GetDocumentTreeByFormula
Description: Получение дерева дочерних документов документа <doc> по формуле <formula>
%END REM
Public Function GetDocumentTreeByFormula(doc As NotesDocument, formula As String, exitOnFalse As Boolean) As NotesDocumentCollection
On Error GoTo eh

Dim resultCol As NotesDocumentCollection
Set resultCol = GetEmpyCollection(doc.ParentDatabase)
Call GetFamily(doc, resultCol, formula, exitOnFalse)
Set GetDocumentTreeByFormula=resultCol
GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl 
ex: 
End Function

Private Sub GetFamily(d As NotesDocument, mcol As NotesDocumentCollection, formula As String, exitOnFalse As Boolean) 
On Error GoTo eh

If formula<>"" Then	
If RunEvaluate(formula, d)="1" Then 
If mcol.GetDocument(d) Is Nothing Then mcol.AddDocument d
Else
If exitOnFalse Then GoTo ex
End If
Else
If mcol.GetDocument(d) Is Nothing Then mcol.AddDocument d	
End If

Dim c As NotesDocumentCollection, rd As NotesDocument, i As Integer
If d.ParentDocumentUNID=d.UniversalID Then Exit Sub

Set c=d.Responses
If c Is Nothing Then GoTo ex Else If c.Count=0 Then GoTo ex
Set rd=c.GetFirstDocument
For i=1 To c.Count
Call GetFamily(rd, mcol, formula, exitOnFalse)
Set rd=c.GetNextDocument(rd)
Next
GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl 
ex: 
End Sub

%REM
Function GetResponses
Description: Получение коллекции дочерних документов - <respColl> документа <doc>, возвращает True если коллекция не пустая
%END REM
Function GetResponses(doc As NotesDocument, respColl As NotesDocumentCollection) As Boolean
On Error GoTo eh

Set respColl=doc.Responses
If respColl Is Nothing Then GoTo emptyCollection Else If respColl.Count=0 Then GoTo ex
GetResponses=True
GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl 
emptyCollection:	
Set respColl = GetEmpyCollection(doc.ParentDatabase)
ex:
End Function

%REM
Function GetMainDocument
Description: Получение самого основного документа от документа <doc>
%END REM
Public Function GetMainDocument(doc As NotesDocument) As NotesDocument
Set GetMainDocument = getDocumentByUNID(doc.ParentDatabase, runEvaluate(GET_MAIN_DOC_FORMULA, doc))
End Function

%REM
Function GetParentDocument
Description: Получение родительского документа от документа <doc>
%END REM
Public Function GetParentDocument(doc As NotesDocument) As NotesDocument
Set GetParentDocument=GetDocumentByUNID(doc.Parentdatabase, doc.Parentdocumentunid)
End Function

%REM
Function GetUnprocessedDocument
Description: Выбор выделенного документа
%END REM
Public Function GetUnprocessedDocument As NotesDocument
On Error GoTo eh

Dim col As NotesDocumentCollection
Set col=currentDatabase.UnprocessedDocuments
If col.Count=0 Then Exit Function
Set GetUnprocessedDocument=col.GetFirstDocument
GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl 
ex: 
End Function

%REM
Function GetPickListCollection
Description: Выбор коллекции из справочника
%END REM
Public Function GetPickListCollection(db As NotesDatabase, viewName As String, singleCategory As String) As NotesDocumentCollection
On Error GoTo eh

If db Is Nothing Then MsgBox ERROR_DATABASE_ACCESS:GoTo emptyCollection
If viewName = "" Then MsgBox ERROR_VIEW_ACCESS:GoTo emptyCollection

If singleCategory="" Then
Set GetPickListCollection = workspace.Picklistcollection(PICKLIST_CUSTOM, True, db.Server, db.Filepath, viewName, TITLE_CHOISE_RU, PROMPT_CHOISE_RU)
Else
Set GetPickListCollection = workspace.Picklistcollection(PICKLIST_CUSTOM, True, db.Server, db.Filepath, viewName, TITLE_CHOISE_RU, PROMPT_CHOISE_RU, singleCategory)
End If

GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl 
emptyCollection:		
Set GetPickListCollection = GetEmpyCollection(db)
ex:
End Function

%REM 
Function GetPickListDocument
Description: Выбор документа из справочника
%END REM
Public Function GetPickListDocument(db As NotesDatabase, viewName As String, singleCategory As String) As NotesDocument
On Error GoTo eh

Dim col As NotesDocumentCollection
Set col = GetPickListCollection(db, viewName, singleCategory)
If col.Count=0 Then GoTo ex
Set GetPickListDocument = col.Getfirstdocument()

GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl 
ex:
End Function

%REM
Function getDocumentByDigestKey
Description: Возвращает документ из БД <sourceDB> по ключу <key>
createOnNothing - если True, то при не нахождении документа создает новый документ по ключу key
%END REM
Public Function getDocumentByDigestKey(sourceDB As NotesDatabase, key As String, createOnNothing As Boolean) As NotesDocument
Dim returnDoc As NotesDocument, unid As String

'Если посылаемая БД недоступна или пустой ключ, то выход
If sourceDB Is Nothing Or Trim(key)="" Then GoTo ex

'Формирования зашифрованного ключа для поиска
unid=RunEvaluate("@Middle(@Password({"+key+"}); {(}; {)})", Nothing)
If unid="" Then GoTo ex

Set returnDoc=getDocumentByUNID(sourceDB, unid)

'Если по ключу не нашел и есть необходимость создания
If (returnDoc Is Nothing) And createOnNothing Then
Set returnDoc=New NotesDocument(sourceDB)
returnDoc.Universalid=unid
End If

Set getDocumentByDigestKey=returnDoc
GoTo ex
eh:		
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl 
ex:
End Function
End Class

Sub Terminate
Call recycleUtil()
End Sub

Public Function Util As Variant 
If mainUtil Is Nothing Then Set mainUtil=New Utils()	
Set util=mainUtil
End Function


%REM
Sub recycleUtil
Description: Comments for Sub
%END REM
Public Sub recycleUtil()
If Not mainUtil Is Nothing Then Delete mainUtil
End Sub
 

savl

Lotus Team
28.10.2011
2 597
310
BIT
159
Не сочтите за придирку, просто хотелось бы внести вклад:
Код:
Private Const nLine = {
}

Private Class Utils
...
End Class

'и вот это еще:
Error Err, Error & " №" & Err & nLine & "Class: " & Me.className & nLine & "Method: " &_
GetThreadInfo(1) & nLine & "Called by: " & GetThreadInfo(12) & " on line " & Erl

Преобразование в строку через & работает быстрее чем через Cstr, со слов Полякова.
 
Статус
Закрыто для дальнейших ответов.
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!