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