Option Public
Option Declare
'Use "libStringTools"
'****************************************************Описание****************
******************************************************
' 03.02.2006 Винцелович Сергей
' 07.02.2007 добавлено: указывается база, где должно производиться логгирование
' 13.02.2007 изменено: Body = RichText + возможность использовать стиль для этого поля
' Класс журнала.
' Для нормальной работы библиотеки нужно:
' 1. Вид "Log~LogDateBegin~Num". Без него все документы журнала будут иметь номер -1 (функция GetNumDocLog).
' Первая колонка = @Date(LogDateBegin), категория, сортировка убывающая; вторая = Num, сортировка убывающая
' View selection = SELECT Form="Log"
' 2. Форма "Log".
' 3. Картинка "SectionDiv.gif" для формы "Log", если будешь использовать форму из этой бд.
' 4. Поле на форме "Log", куда пишется история должно называться "Body", текстовое. Размер этого поля ограничивается 32К
' (функция isBodySize32K). AllowMultipleValues = true, Display separate values with = New Line
' 5. В поле "LogDateBegin" пишется дата начала сессии создания журнала
' 6. В поле "LogDateEnd" пишется дата окончания сессии создания журнала
' 7. В поле "Num" пишется номер документа журнала в "сегодняшнем дне"
' 8. В поле "Type" тип документа лога
'****************************************************************************
**********************************************************
Const BEGIN_LOG = "Создание сессии записи в журнал"
Const END_LOG = "Закрытие сессии записи в журнал"
Const HYPHEN = " "
Class EventsLog
log_session As NotesSession
log_db As NotesDatabase
log_doc As NotesDocument
log_DocNum As Double 'с этого номера буду начинать
log_countDocsInSession As Double 'количество доков в данной сессии
log_type As String 'тип отчета
log_body As NotesRichTextItem
log_rtStyle As NotesRichTextStyle
' конструктор
Sub New(db As NotesDatabase)
Set log_session = New NotesSession
Set log_db = db
log_DocNum = -1
log_countDocsInSession = 0
End Sub
' создаю сессию
Sub OpenSession
Set log_doc = log_db.CreateDocument
log_DocNum = GetNumDocLog(Me.log_db)
log_doc.Form = "Log"
Set log_rtStyle = log_session.CreateRichTextStyle
log_rtStyle.NotesFont = FONT_COURIER
log_rtStyle.FontSize = 8
Set log_body = New NotesRichTextItem( log_doc, "Body" )
Call log_body.AppendStyle(log_rtStyle)
log_doc.LogDateBegin = Now
log_doc.Num = log_DocNum
AddLogEvent BEGIN_LOG
End Sub
' установить тип отчета
Sub SetType(typeLog As String)
If Not (log_doc Is Nothing) Then
log_doc.Type = typeLog
End If
End Sub
' добавить запись в конец документа журнала с сохранением документа
Sub AddLogEvent(strEvent As String)
On Error Goto errorhandler
If Not (log_doc Is Nothing) Then
If Not (isBodySize32K(log_body, StrEvent)) Then
log_body.AppendText Cstr(Now) & HYPHEN & strEvent
log_body.AddNewline 1
log_doc.LogDateEnd = Now
log_doc.Save True, False
Else
errorhandler:
' считаю создаваемые доки на случай зацикливания
log_countDocsInSession = log_countDocsInSession + 1
If log_countDocsInSession < 1000 Then
Dim tLog As String
If Not (log_doc Is Nothing) Then
tLog = log_doc.Type(0)
End If
OpenSession 'создаю новый
SetType tLog
AddLogEvent strEvent
End If
End If
End If
End Sub
' закончили, закрываю сессию
Sub CloseSession
AddLogEvent END_LOG
'log_doc.Save True, False
End Sub
End Class
Function GetNumDocLog(db As NotesDatabase) As Double
'****************************************************Описание****************
**************************************************
' Функция получает следующий номер документа журнала.
' Возвращаемое значение: Double (следующий номер) - если все нормально; -1 - если произошла ошибка.
'****************************************************************************
******************************************************
On Error Goto errorhandler
Dim session As New NotesSession
Dim view As Notesview
Dim docLog As NotesDocument
Dim n As Variant
GetNumDocLog = -1
Set view = db.GetView("Log~LogDateBegin~Num")
If Not (view Is Nothing) Then
view.Refresh
Set docLog = view.GetFirstDocument
If Not (docLog Is Nothing) Then
n = Evaluate ({@if(@Date(LogDateBegin)=@Date(@Now); "1"; "0")}, docLog)
If n(0)="1" Then
GetNumDocLog = docLog.Num(0) + 1
Else
GetNumDocLog = 1
End If
Else
GetNumDocLog = 1
End If
End If
Ex:
Exit Function
errorhandler:
Resume Ex
End Function
Function isBodySize32K(rtitem As NotesRichTextItem, NewStr As String) As Boolean
'****************************************************Описание****************
**************************************************
' Функция проверяет размер поля Body.
' Возвращаемое значение: true - если произошла ошибка или больше; false - если меньше.
'****************************************************************************
******************************************************
On Error Goto errorhandler
isBodySize32K = True
Dim ni As NotesItem
Dim strLen As Double
If Not (rtitem Is Nothing) Then
strLen = rtItem.ValueLength + Lenb(NewStr)
If strLen < 32660 Then
isBodySize32K = False
End If
End If
Ex:
Exit Function
errorhandler:
Resume Ex
End Function
