Singleton На Ls

Тема в разделе "Lotus - Программирование", создана пользователем Darker, 16 мар 2012.

Статус темы:
Закрыта.
  1. Darker

    Darker Гость

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

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

    Код (Text):
    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
    Пример использования:

    Код (Text):
        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()
     
  2. turumbay

    Регистрация:
    13 мар 2009
    Сообщения:
    625
    Симпатии:
    2
  3. Darker

    Darker Гость

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

    Регистрация:
    13 мар 2009
    Сообщения:
    625
    Симпатии:
    2
    по мелочи :
    Код (Text):
    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
    А вообще - ничетак. Кэширование вьюшек - респект.

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

    Darker Гость

    это - да, забыл написать
     
  6. hosm

    hosm * so what *

    Регистрация:
    18 май 2009
    Сообщения:
    2.450
    Симпатии:
    7
    On Error 4091 Resume Next - это же только для UNID (емнип), не к той ф-ции придрались
     
  7. nvyush

    nvyush Lotus team
    Lotus team

    Регистрация:
    22 апр 2009
    Сообщения:
    2.317
    Симпатии:
    0
    Код (Text):
        Public Function GetEmpyCollection(db As NotesDatabase) As NotesDocumentCollection
    Set GetEmpyCollection=db.GetProfileDocCollection("EMPTY_COLLECTION")
    End Function
    Начиная с 8-ки вроде как есть NotesDatabase.CreateDocumentCollection
     
  8. lmike

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.081
    Симпатии:
    300
    по "правильному" - Chr(13) (аки <CR>) - возврат каретки, переводом строки не является!
    <LF> - Chr(10)
     
  9. turumbay

    Регистрация:
    13 мар 2009
    Сообщения:
    625
    Симпатии:
    2
    да я не к юнид придрался, а к не работающему обработчику: он там либо вообще лишний(вставленный копипастом), либо планировалось ловить что-нить конкретное.
    А кстати, что там вообще может вылететь? Если отлупит по правам - то наверно можно вернуть пустоту? Если конекшен отвалился, вроде как криминально и нужно кидать исключение?
    А 4091 - точно, не к месту.
     
  10. Darker

    Darker Гость

    Внес изменения, которые порекомендовали turumbay и Imike

    Добавлено:
    Рассчитывалось на разные клиенты
     
  11. Darkhan

    Darkhan Well-Known Member

    Регистрация:
    14 дек 2012
    Сообщения:
    96
    Симпатии:
    4
    В свете недавнего упоминания про метод DisgestSearch, добавлено:
    Код (LotusScript):
     %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
     
  12. divankin

    divankin Senjor developer

    Регистрация:
    13 авг 2009
    Сообщения:
    182
    Симпатии:
    0
    Очень хорошо и интересно. Но есть что пообсуждать

    Обработка ошибок
    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.
     
  13. divankin

    divankin Senjor developer

    Регистрация:
    13 авг 2009
    Сообщения:
    182
    Симпатии:
    0
    18. По кэшированию вьюшек: а если мне нужно отрефрешить закэшированную вьюшку, то что делать?
     
  14. Darkhan

    Darkhan Well-Known Member

    Регистрация:
    14 дек 2012
    Сообщения:
    96
    Симпатии:
    4
    не знал, спасибо
    Класс можно расширять исходя из потребностей
    На момент публикации кода, не было такой задумки, теперь ясно, что это актуально
    Методы
    пытался замутить pojo в лотусе)))) Относительно Source, ИМХО, разработчику виднее: надо использовать Source - пущая использует
    все, понял, переиспользование - зло))
    учел, появилась расширенная функция RunEvaluateObject
    Ситуацию с конфликтом можно обработать и на "собаках", а на счет извещения согласен
    Все зависет от ситуации, можно загнать параметры типа: нужен норм, не конфликт, с формой, с доступом, и.т.д.
    Старожилы форума другого мнения...
    не спорю, можно...
    учел
    от профилей отказались, создаем/получаем системный документ по DigestSearch, (в т.ч. чтение полей настроек на собаках)
    изначально не кэшить эту вьюху
     
  15. Darkhan

    Darkhan Well-Known Member

    Регистрация:
    14 дек 2012
    Сообщения:
    96
    Симпатии:
    4
    <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">
    Код (LotusScript):
    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
     
  16. savl

    savl Lotus team
    Lotus team

    Регистрация:
    28 окт 2011
    Сообщения:
    2.052
    Симпатии:
    146
    Не сочтите за придирку, просто хотелось бы внести вклад:
    Код (LotusScript):
    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, со слов Полякова.
     
  17. Darkhan

    Darkhan Well-Known Member

    Регистрация:
    14 дек 2012
    Сообщения:
    96
    Симпатии:
    4
    savl
    спасибо, подправил
     
  18. VladSh

    VladSh начинающий
    Lotus team

    Регистрация:
    11 дек 2009
    Сообщения:
    1.251
    Симпатии:
    2
    Просьба сделать то же самое в заглавном сообщении темы.
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей