Лотус скрипты для работы с XML (Страница 2) — Lotus/Domino

26 Ответ от admin 2022-10-14 13:00:30

admin
Administrator
Неактивен

Зарегистрирован: 2010-04-07
Сообщений: 1,270
Репутация : 0

Re: Лотус скрипты для работы с XML

Function Textword (myRange) As string
' сохраняем word в html файл
'добавлен кусок кода на случай если контент в ворд вставляют вместе с таблицей - в v.1.1изменен на универсальный код
'подправлен кусок кода где контент мог начинаться как с абзаца, так и с таблицы, так и с заголовка (<h1>)
'т.е. сделан универсальный код для избавления от внешней таблицы текста сопроводиловки
On Error GoTo ErrH
Dim str1 As String, str2 As String
Dim sText As String, mytext As String, str0 As String, str3 As String
Dim htmlStream As NotesStream, session As NotesSession, idx As Long
Dim mypar As Variant, myRangeTmp As Variant, WrdAppTmp As Variant, WrdDocTmp As Variant ' временый док

Print "ФУНКЦИЯ Textword"

myRange.Copy

' Во временный Word документ вставляем текст письма (myRange), cохраняем как doctmp.html

Set WrdAppTmp = CreateObject("Word.Application") 'Создание объекта Word'a
WrdAppTmp.Visible= False 'True
Print "создали временный ворд WrdAppTmp"
If WrdAppTmp Is Nothing Then MessageBox "Не установлен Word!!!", 0 + 16 , "ошибка" : Exit Function

WrdAppTmp.Documents.Add ("Normal") '("C:\XML\tempdoc.docx")
Set WrdDocTmp = WrdAppTmp.ActiveDocument
WrdDocTmp.Select

Set mypar = WrdDocTmp.Paragraphs(1)
mypar.range.Find.ClearFormatting
mypar.range.Paste

WrdAppTmp.ChangeFileOpenDirectory datpatch
Call WrdDocTmp.SaveAs ("doctmp.html", 10,False, "",False,"",,,,,,,,,, )
WrdDocTmp.Close
WrdAppTmp.Quit
Set WrdAppTmp = Nothing
Print "сохранили в html"

' Вырезаем с doctmp.html текст письма
Set session = New NotesSession
Set htmlStream = session.CreateStream
Call htmlStream.Open(datpatch+"doctmp.html")
mytext$=""
mytext$ = htmlStream.ReadText
Call htmlStream.Close
Print "прочитали и закрыли html"
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'здесь нужно почистить тест дока от внешней таблицы
%REM может быть что текст вставили с таблицей и получилась вложенная таблица
1начало файла
<table class=MsoTableGrid border=0 cellspacing=0 cellpadding=0
style='border-collapse:collapse;border:none'>
   <tr>
   <td width=657 valign=top style='width:492.7pt;padding:0cm 5.4pt 0cm 5.4pt'>
<table class=MsoTableGrid border=0 cellspacing=0 cellpadding=0
   style='border-collapse:collapse;border:none'>
   <tr>
   <td width=657 valign=top style='width:492.7pt;padding:0cm 5.4pt 0cm 5.4pt'>
   <p
2сам текст документа
   </td>
   </tr>
</table>
   </td>
</tr>
</table>
3конец файла
%END REM
str1=StrLeft(mytext$,"<table") 'взяли начало файла до таблицы (начало файла)

'стало в версии 1.1(заменили алгоритм получения str2)
'НАЧАЛО ПОЛУЧЕНИЯ str2
idx=InStr(Len(str1+"<table"),mytext$,"<td")
idx=InStr(idx,mytext$,">")
str0=Mid$(mytext$, idx+1)
str2=StrLeftBack(str0,"</td>") 'взяли все что до последней строки внешней ячейки
'КОНЕЦ ПОЛУЧЕНИЯ str2
str3=StrRightBack(mytext$,"</table>") 'взяли все что после последней строки внешней ячейки (конец файла)
mytext$=str1+str2+str3

Textword=ParsHtmlText(mytext$)
Print "ФУНКЦИЯ - конец Textword."
Exit Function

ErrH:
Print "Библиотека 'MED_XML' ф-ция 'Textword'. Ошибка " & Error(Err) & " в строке " & Erl
End Function

27 Ответ от admin 2022-10-14 13:00:36

admin
Administrator
Неактивен

Зарегистрирован: 2010-04-07
Сообщений: 1,270
Репутация : 0

Re: Лотус скрипты для работы с XML

Function Unique As String
Dim unik
unik = Evaluate("@Unique")
Unique = StrToken(unik(0), "-", -1)
Unique = Right (Unique, 3 )
End Function

28 Ответ от admin 2022-10-14 13:00:40

admin
Administrator
Неактивен

Зарегистрирован: 2010-04-07
Сообщений: 1,270
Репутация : 0

Re: Лотус скрипты для работы с XML

%REM
    Sub ZapolnTypeFiles
    Description: указываем разрешенные типы файлов
    ' [url]https://ru.wikipedia.org/wiki/Список_MIME-типов[/url]      -   подсказка
    ' [url]https://wp-kama.ru/id_8643/spisok-rasshirenij-fajlov-i-ih-mime-tipov.html[/url]    - тут поболее типов
%END REM
Sub ZapolnTypeFiles
    c_files_MIME("docx")    =    {href="data:application/msword;base64,}
    c_files_MIME("doc")        =    {href="data:application/msword;base64,}
    c_files_MIME("docm")    =    {href="data:application/msword;base64,}
    c_files_MIME("rtf")        =    {href="data:application/msword;base64,}
    c_files_MIME("jpeg")    =    {href="data:image/jpeg;base64,}
    c_files_MIME("jpg")        =    {href="data:image/jpeg;base64,}
    c_files_MIME("pdf")        =    {href="data:application/pdf;base64,}
    c_files_MIME("xls")        =    {href="data:application/vnd.ms-excel;base64,}
    c_files_MIME("xlsx")    =    {href="data:application/vnd.ms-excel;base64,}
    c_files_MIME("tif")        =    {href="data:image/tif;base64,}
    c_files_MIME("xml")        =    {href="data:application/xml;base64,}
    c_files_MIME("rar")        =    {href="data:application/x-rar-compressed;base64,}
    c_files_MIME("zip")        =    {href="data:application/zip;base64,}
    c_files_MIME("txt")        =    {href="data:text/plain;base64,}    
    c_files_MIME("ppt")        =    {href="data:application/vnd.ms-powerpoint;base64,}
    c_files_MIME("pptx")    =    {href="data:application/vnd.ms-powerpoint;base64,}
    c_files_MIME("vsd")        =    {href="data:application/vnd.visio;base64,}
    c_files_MIME("vsdx")    =    {href="data:application/vnd.visio2013;base64,}
End Sub

29 Ответ от admin 2022-10-14 13:01:55

admin
Administrator
Неактивен

Зарегистрирован: 2010-04-07
Сообщений: 1,270
Репутация : 0

Re: Лотус скрипты для работы с XML

Библиотека Library VerifySignedXML

%REM
Library VerifySignedXML
Created Aug 18, 2021 by Гроза Вадим Иванович/Home
Description:Библиотека для проверки подписи в документе XML и сравнение подписей с базой подписанты

для работы данной библиотеки необходимо наличие других библиотек
"ConsoleCriptoGSS_2.0"
"ls.snapps.JSONReader"

для проверки - используем класс Verify_Signed_XML
%END REM
Option Public
Option Declare

Use "ConsoleCriptoGSS_2.0"

30 Ответ от admin 2022-10-14 13:02:04

admin
Administrator
Неактивен

Зарегистрирован: 2010-04-07
Сообщений: 1,270
Репутация : 0

Re: Лотус скрипты для работы с XML

Declare Function w32_OSGetSystemTempDirectory Lib "nnotes" Alias "OSGetSystemTempDirectory" ( ByVal S As String) As Integer
Const db_title="Подписанты"

31 Ответ от admin 2022-10-14 13:02:12

admin
Administrator
Неактивен

Зарегистрирован: 2010-04-07
Сообщений: 1,270
Репутация : 0

Re: Лотус скрипты для работы с XML

%REM
Class Lico
Description: используется в классах Podpisant и Verify_Signed_XML
%END REM
Class Lico
Public FIO As String
Public UINFL As String
Public UINUL As String
Public UINOIGV As String
End Class

32 Ответ от admin 2022-10-14 13:02:16

admin
Administrator
Неактивен

Зарегистрирован: 2010-04-07
Сообщений: 1,270
Репутация : 0

Re: Лотус скрипты для работы с XML

%REM
Class Podpisant
Description: дает возможность получить информацию из базы Подписантов об указанной1 организации
используется классом Vefify_Signed_XML
можно использовать и отдельно как самостоятельный класс
%END REM
Public Class Podpisant
Private m_ListSignPodp() As Lico 'список имеющих право подписи в организации
Private m_Ubound_idx_SignPodp As Integer
Private m_kod_org As String
Private m_name_org As String

Private m_serverDB_Signed As String 'сервер где находится БД подписанты
Private m_pathDB_Signed As String 'путь к БД подписанты

Private m_isError As Boolean
Private m_error_Text As String

Public Sub New
Dim session As New NotesSession, cur_db As NotesDatabase
Set cur_db=session.CurrentDatabase

me.m_serverDB_Signed=cur_db.server
me.m_pathDB_Signed="promdoc\SignVerify.nsf"
Me.m_kod_org=""

Call me.RestoreNULL
End Sub

Public Function RunGetPodpisant(server_nameDB As String, pathDB As String, kod_org As String) As Boolean
On Error GoTo errh

Call me.RestoreNULL

RunGetPodpisant=False
Dim session As New NotesSession, db As NotesDatabase, view As NotesView, doc_p As NotesDocument
Dim mes As String, i As Integer, view_name As String, db_title2 As String, record As Variant

If Not Trim(server_nameDB)="" Then Me.m_serverDB_Signed=server_nameDB
If Not Trim(pathDB)="" Then Me.m_pathDB_Signed=pathDB
If Not Trim(kod_org)="" Then Me.m_kod_org=kod_org

view_name="On_OrgKod"

If Trim(Me.m_serverDB_Signed)="" Then mes="Не указан сервер базы '"+db_title+"'": Error 1000
If Trim(Me.m_pathDB_Signed)="" Then mes="Не указан путь к базе '"+db_title+"'": Error 1000
If Trim(Me.m_kod_org)="" Then mes="Не указан код организации": Error 1000

Set db = session.GetDatabase(me.m_serverDB_Signed, me.m_pathDB_Signed)
If Not db.IsOpen Then mes="Нет подключения к базе '"+db_title+"'": Error 1000
db_title2=db.Title
Set view=db.Getview(view_name)
If view Is Nothing Then mes="Не могу найти служебное представление '"+view_name+"' в базе '"+db_title2+"'": Error 1000

Set doc_p=view.Getdocumentbykey(me.m_kod_org, True)
If doc_p Is Nothing Then mes="Не найден документ организации в базе '"+db_title2+"'": Error 1000

If Not doc_p.Hasitem("fam") Or Not doc_p.Hasitem("im") Or Not doc_p.Hasitem("ot") Or Not doc_p.Hasitem("ern") _
Then mes="Не заполнен документ организации в базе '"+db_title2+"'": Error 1000
If Trim(doc_p.fam(0))="" Or Trim(doc_p.im(0))="" Or Trim(doc_p.ot(0))="" Or Trim(doc_p.ern(0))="" _
Then mes="Не заполнен документ организации в базе '"+db_title2+"'": Error 1000

ForAll v In doc_p.NameOrg
If me.m_name_org="" Then me.m_name_org=v Else me.m_name_org=me.m_name_org+Chr(13)+v
End ForAll

For i=0 To UBound(doc_p.fam)
Set record=New Lico
record.FIO=doc_p.fam(i)
record.FIO=record.FIO+" "+doc_p.im(i)
record.FIO=record.FIO+" "+doc_p.ot(i)
record.UINFL=doc_p.ern(i)
record.UINUL=doc_p.ernul(i)
record.UINOIGV=doc_p.ernoigv(i)

ReDim Preserve me.m_ListSignPodp(i)
Set me.m_ListSignPodp(i)=record
me.m_Ubound_idx_SignPodp=i
Next

RunGetPodpisant=True
Exit Function
errh:
If Err=1000 Then mes="Ошибка получения данных!!! "+mes
Call me.SetError(Err, mes)
Exit Function
End Function

'геттеры******************
Public Property Get GetListPodp As Variant
On Error GoTo errh
Dim mes As String
If me.m_Ubound_idx_SignPodp=-1 Then mes="Нет данных по ведомству о подписантах": Error 1000
GetListPodp=me.m_ListSignPodp
Exit Property
errh:
GetListPodp=Null
Call me.SetError(Err, mes)
Exit Property
End Property

Public Property Get GetCountListPodp As Integer
GetCountListPodp=me.m_Ubound_idx_SignPodp+1
End Property
Public Property Get GetNameOrg As String
GetNameOrg=me.m_name_org
End Property
Public Property Get GetErrorText As String
GetErrorText=me.m_error_Text
End Property
'сеттеры******************
Public Property Set SetServerDBSigned As String
me.m_serverDB_Signed=SetServerDBSigned
End Property
Public Property Set SetPathDBSigned As String
me.m_pathDB_Signed=SetPathDBSigned
End Property
Public Property Set SetKodOrg As String
me.m_kod_org=SetKodOrg
End Property
'**********************************************************************************************
Private Sub RestoreNULL
me.m_isError=False
me.m_error_Text=""
Me.m_Ubound_idx_SignPodp=-1

me.m_name_org=""
If IsArray(me.m_ListSignPodp) Then Erase me.m_ListSignPodp
End Sub

Private Sub SetError(Er As Integer, mes As String)'записываем ошибку
Me.m_isError=True
If er>=1000 And er<=1100 Then
Me.m_error_Text=mes
Else
Me.m_error_Text="Ошибка № " & Er & " в строке " & Erl & Chr(13) & Error(Er)
End If
End Sub
End Class

33 Ответ от admin 2022-10-14 13:02:29

admin
Administrator
Неактивен

Зарегистрирован: 2010-04-07
Сообщений: 1,270
Репутация : 0

Re: Лотус скрипты для работы с XML

%REM
класс для получения информации о ФИО из тега XML документа
используется классом Vefify_Signed_XML
можно использовать и отдельно как самостоятельный класс
%END REM
Public Class SAX_Parser
Private axis As String 'служебная для парсера
Private nodetext As String 'служебная для парсера

Private m_path_XML As String 'путь к проверяемому файлу
Private m_isError As Boolean
Private m_error_Text As String
Private m_kod_med As String
Private m_kod_med_sub As String
Private m_Ubound_idx_Signed As Integer

Private m_List_FIO() As String 'список ФИО которые в теге XML
'*******************************************************************************
Public Sub New()
Me.m_path_XML=""
Call RestoreNULL
End Sub

Public Property Get GetListFIO As Variant
On Error GoTo errh
Dim mes As String
If me.m_Ubound_idx_Signed=-1 Then mes="Нет подписей в сопроводе": Error 1000
GetListFIO=me.m_List_FIO
Exit Property
errh:
GetListFIO=Null
Call me.SetError(Err, mes)
Exit Property
End Property

Public Property Get GetKodMed As String
GetKodMed=me.m_kod_med
End Property

Public Property Get GetKodMedSub As String
GetKodMedSub=me.m_kod_med_sub
End Property

Public Property Get GetCountListFIO As Integer
GetCountListFIO=me.m_Ubound_idx_Signed+1
End Property

Public Property Get isError As Boolean
isError=me.m_isError
End Property

Public Property Get GetErrorText As String
GetErrorText=me.m_error_Text
End Property

Public Function Run(pathFile As String) As Boolean
On Error GoTo errh
Call RestoreNULL
Run=False

Dim mes As String, session As New NotesSession, strm As NotesStream, outputStream As NotesStream
Dim saxParser As NotesSAXParser

If Trim(pathFile)="" Then
If Me.m_path_XML="" Then mes="Ошибка!!! Не указан путь к проверяемому файлу.": Error 1000
Else
Me.m_path_XML=pathFile
End If

Set outputStream =session.CreateStream()
Set strm = session.CreateStream()
Call strm.Open(Me.m_path_XML, "UTF-8" )

Set saxParser=session.CreateSAXParser(strm, outputStream)
On Event SAX_StartDocument From saxParser Call SAXStartDocument
On Event SAX_StartElement From saxParser Call SAXStartElement
On Event SAX_Characters From saxParser Call SAXCharacters ' содержимое элемента
On Event SAX_StartElement From saxParser Call SAXStartElement 'старт элемента
On Event SAX_EndElement From saxParser Call SAXEndElement 'конец элемента
On Event SAX_Error From saxParser Call SAXError
On Event SAX_FatalError From saxParser Call SAXFatalError
saxParser.Process
Call outputStream.close
Call strm.Close
Run=True
Exit Function
errh:
Call me.SetError(Err, mes)
Exit Function
End Function
'*******************************************************************************
Private Sub RestoreNULL
Me.m_isError=False
Me.m_error_Text=""
Me.m_kod_med=""
Me.m_kod_med_sub=""
Me.m_Ubound_idx_Signed=-1
If IsArray(me.m_List_FIO) Then Erase me.m_List_FIO
End Sub

Private Sub SAXCharacters (Source As NotesSAXParser, ByVal Characters As String, Count As Long)
On Error GoTo ErrH
Dim ItemName As String, mes As String
Select Case me.axis
' Case "/htmlx/body2/container/signaturestextinfo/post" : ItemName="ДОЛЖНОСТЬ"
Case "/htmlx/body2/container/signaturestextinfo/fio" : ItemName="ФИО"
Case "/htmlx/body2/container/kodorg" : ItemName="Код_МЭД"
Case "/htmlx/body2/container/kodorgsub" : ItemName="Код_МЭД_суб"
End Select

'If ItemName="ФИО" Or ItemName="ДОЛЖНОСТЬ" Then
If ItemName="ФИО" Then
Me.m_Ubound_idx_Signed=Me.m_Ubound_idx_Signed+1
If Not IsArray(me.m_List_FIO) Then
ReDim me.m_List_FIO(0)
Else
ReDim Preserve me.m_List_FIO(Me.m_Ubound_idx_Signed)
End If
me.m_List_FIO(Me.m_Ubound_idx_Signed)=Trim(Characters)
ElseIf ItemName="Код_МЭД" Then
me.m_kod_med=Characters
ElseIf ItemName="Код_МЭД_суб" Then
me.m_kod_med_sub=Characters
End If

Exit Sub
ErrH:
Call me.SetError(Err, mes)
Exit Sub
End Sub

Private Sub SAXStartDocument (Source As NotesSAXParser)
me.axis=""
End Sub

Private Sub SAXStartElement (Source As NotesSAXParser, ByVal elementname As String, Attributes As NotesSAXAttributeList)
If me.nodetext<>elementname Then Me.axis=me.axis+"/"+elementname ' хз несколько раз подрят срабатывает событие
me.nodetext=elementname
End Sub

Private Sub SAXEndElement (Source As NotesSAXParser, ByVal ElementName As String)
me.axis= StrLeftBack(me.axis,"/")
me.nodetext=""
End Sub

Private Sub SAXEndDocument (Source As NotesSAXParser)
me.axis=""
End Sub

Private Sub SAXFatalError (Source As NotesSAXParser, Exception As NotesSAXException)
Source.Output ("FatalError - "+Exception.Message)
End Sub

Sub SAXError (Source As NotesSAXParser, Exception As NotesSAXException )
Source.Output ("Error - "+Exception.Message)
End Sub

Private Sub SetError(Er As Integer, mes As String)'записываем ошибку
Me.m_isError=True
If er>=1000 And er<=1100 Then
Me.m_error_Text=mes
Else
Me.m_error_Text="Ошибка № " & Er & " в строке " & Erl & Chr(13) & Error(Er)
End If
End Sub
End Class

34 Ответ от admin 2022-10-14 13:02:37

admin
Administrator
Неактивен

Зарегистрирован: 2010-04-07
Сообщений: 1,270
Репутация : 0

Re: Лотус скрипты для работы с XML

'Const type_prov=123 '??????планирую сделать проверку настраиваемой(все три проверять или только 2 проверять по ЕРН или нет)
'Const type_prov_ern=0
'Const db_path_default="promdoc\SignVerify.nsf"
%REM
Класс для проверки подписи в документе XML и сравнение подписей с базой подписанты
Вытягиваем ФИО из тега XML
Вытягиваем ФИО и ЕРНы из ЭП XML
Вытягиваем список ФИО и и ЕРНы из базы 'Подписанты'
если будет хоть одно совпадение по всем трем Фамилия И.О. а также по ЕРНФЛ и по одному из ЕРНЮЛ/ЕРНОИГВ- считается документ успешно прошел проверку

==================================ОПИСАНИЕ Public методов и свойств класса Verify_Signed_XML============================================
Public
Property Get GetListFIOTeg As Variant 'получаем массив данных ФИО из тега (если нет ФИО - возвращается NULL)
Property Get GetListFIOEP As Variant 'получаем массив данных ФИО из ЭП (если нет ФИО - возвращается NULL)
Property Get GetListFIOPodp As Variant 'получаем массив данных ФИО из базы подписантов (если нет ФИО - возвращается NULL)
Property Get GetNameOrg As String 'получаем наименование ведомства отославшей документ
Property Get GetKodMedOrg As String 'получаем код организации отославшей документ (если из подведа - то к примеру 7.501)
Property Get GetCountListFIOTeg As Integer 'получаем кол-во ФИО из тега
Property Get GetCountListFIOEP As Integer 'получаем кол-во ФИО из ЭП
Property Get GetCountListFIOPodp As Integer 'получаем кол-во ФИО из базы подписанты по ведомству отославшей документ
Property Get isError As Boolean 'была/не было ошибки True/False
Property Get GetErrorText As String 'получаем текст ошибки

Property Set SetPathCriptoGSS As String 'передаем путь к ConsoleCriptoGSS
Property Set SetPathXML As String 'передаем путь к проверяемому файлу
Property Set SetServerDBSigned As String 'передаем имя сервера где находится БД 'Подписанты'
Property Set SetPathDBSigned As String 'передаем путь к БД 'Подписанты'
Property Set SetNotesDocument As NotesDocument'передаем NotesDocument в котором нужно проверить аттач
Property Set SetItemName As string 'передаем наименование итема в котором нужно проверить аттач

Function VerifySignedXML(pathCriptoGSS As String, server_nameDB As String, pathDB As String, pathFile As String) As Boolean
-ф-ция используется для проверки файла XML находящегося на диске

где: pathCriptoGSS - путь к consolecriptogss, например "c:\consolecriptogss\consolecriptogss.exe"
   server_nameDB - название сервера где находится БД 'Подписанты',если текущий сервер - оставлем пустым
   pathDB - путь к базе 'Подписанты', если база находится по пути "promdoc\SignVerify.nsf" - оставляем пустым
   pathFile - путь к проверяемому файлу
если перед вызовом данной ф-ции использовались нужные сеттеры - все либо нужные аргументы оставляем пустыми

Function VerifySignedXMLFromDoc(pathCriptoGSS As String, server_nameDB As String, pathDB As String, doc As Variant, itemname As String) As Boolean
-ф-ция используется для проверки файла XML находящегося в виде аттача в NotesDocument

где: pathCriptoGSS - путь к consolecriptogss, например "c:\consolecriptogss\consolecriptogss.exe"
   server_nameDB - название сервера где находится БД 'Подписанты',если текущий сервер - оставлем пустым
   pathDB - путь к базе 'Подписанты', если база находится по пути "promdoc\SignVerify.nsf" - оставляем пустым
   doc - NotesDocument в котором находится проверяемый аттач(если документ был определен через сеттер - указываем Nothing)
   itemname - название итема в котором находится проверяемый аттач
если перед вызовом данной ф-ции использовались нужные сеттеры - все либо нужные аргументы оставляем пустыми

==================================1 Пример работы с классом(проверяем файл на диске)============================================

Dim verify_p As New Verify_Signed_XML

verify_p.SetPathXML="c:\XML\podpisant.xml" 'как вариант использую сеттер, а можно передать и прям в ф-ции VerifySignedXML
If Not verify_p.VerifySignedXML("C:\ConsoleCriptoGSS\ConsoleCriptoGSS.exe", "", "", "") Then
Messagebox "Была ошибка во время проверки либо документ не прошел успешно проверку"
Else
Messagebox "Документ успешно проверен"
End If

'далее при необходимости можем использовать методы для получения информации об ошибке, подписантах и т.д.

if verify_p.isError then s="Текст ошибки: "+verify_p.GetErrorText+Chr(13) 'если есть ошибка получаем текст ошибки

s=s+"Код организации: "+verify_p.GetKodMedOrg+Chr(13)
s=s+"Кол-во подписантов XML в теге: "+Cstr(verify_p.GetCountListTeg)+Chr(13)

'I способ получения информации о подписантах (проверяем на NULL)
mas=verify_p.GetListTeg 'получаем массив данных с подписантами в теге
If Not Isnull(mas) Then
Forall v In mas
tmp=tmp+Chr(13)+v.FIO
tmp=tmp+Chr(13)
End Forall
s=s+"Список из тега:"+tmp+Chr(13)
End If

s=s+"Кол-во в ЭП: "+Cstr(verify_p.GetCountListEP)+Chr(13)
'II способ получения информации о подписантах (если кол-во подписантов > 0 - получаем список этих подписантов)
If verify_p.GetCountListFIOEP>0 Then
mas=verify_p.GetListFIOEP 'получаем массив данных с подписантами в эл.подписи
tmp=""
Forall v In mas
tmp=tmp+Chr(13)+v.FIO
tmp=tmp+Chr(13)+v.UINFL
tmp=tmp+Chr(13)+v.UINUL
tmp=tmp+Chr(13)+v.UINOIGV
tmp=tmp+Chr(13)
End Forall
s=s+"Список из ЭП:"+tmp+Chr(13)
End If

s=s+"Кол-во кому разрешено: "+Cstr(verify_p.GetCountListPodp)+Chr(13)
If verify_p.GetCountListFIOPodp>0 Then
mas=verify_p.GetListFIOPodp 'получаем массив данных с подписантами из базы подписанты
tmp=""
Forall v In mas
tmp=tmp+Chr(13)+v.FIO
tmp=tmp+Chr(13)+v.UINFL
tmp=tmp+Chr(13)+v.UINUL
tmp=tmp+Chr(13)+v.UINOIGV
tmp=tmp+Chr(13)
End Forall
s=s+"Список из подписантов:"+tmp
End If
Messagebox s

==================================2 Пример работы с классом(проверяем аттач в нотес доке)============================================

Dim verify_p As New Verify_Signed_XML, doc As notesdocument, ws As New NotesUIWorkspace

Set doc = ws.CurrentDocument.Document

verify_p.SetPathCriptoGSS="C:\ConsoleCriptoGSS\ConsoleCriptoGSS.exe"
Set verify_p.SetNotesDocument=doc
verify_p.SetItemName="text"

If Not verify_p.VerifySignedXMLFromDoc("", "", "", Nothing, "") Then
Messagebox "Была ошибка во время проверки либо документ не прошел успешно проверку"
Else
Messagebox "Документ успешно проверен"
End If
'далее, как и в 1примере, можем получать нужную нам информацию из класса
%END REM

Public Class Verify_Signed_XML
Private m_ListSignSoprovod() As Lico 'список подписавших в теге XML(считается только один, не делаю анализ на ентеры и тому подобное, беру все что есть в теге)
Private m_ListSignEP() As Lico 'список подписавших в ЭП
Private m_ListSignPodp() As Lico 'список имеющих право подписи в организации
Private m_Ubound_idx_SignSoprovod As Integer
Private m_Ubound_idx_SignEP As Integer
Private m_Ubound_idx_SignPodp As Integer
Private m_kod_med As String
Private m_kod_med_sub As String
Private m_name_org As String

Private m_path_criptoGSS As String 'путь к консольной криптоГСС
Private m_path_XML As String 'путь к проверяемому файлу
Private m_name_XML As String 'имя проверяемому вложения
Private m_serverDB_Signed As String 'сервер где находится БД подписанты
Private m_pathDB_Signed As String 'путь к БД подписанты

Private m_isError As Boolean
Private m_error_Text As String

Private m_doc As NotesDocument 'нотес документ в котором проверяемый итем с файлом
Private m_item_Name As String 'название итема с файлом

Public Sub New
me.m_path_criptoGSS=""
me.m_path_XML=""
me.m_serverDB_Signed=""
me.m_pathDB_Signed=""
Set me.m_doc=Nothing
me.m_item_Name=""
me.m_name_XML=""

Call me.RestoreNULL
End Sub

Public Function VerifySignedXML(pathCriptoGSS As String, server_nameDB As String, pathDB As String, pathFile As String) As Boolean
On Error GoTo errh
VerifySignedXML=False
Call me.RestoreNULL

Dim mas1 As Variant, mas2 As Variant, mas3 As Variant, b_tmp As Boolean, mes As String
Dim tmp1 As String, tmp2 As String, tmp3 As String, i As Integer
b_tmp=False

If Not Trim(pathCriptoGSS)="" Then Me.m_path_criptoGSS=pathCriptoGSS
If Not Trim(server_nameDB)="" Then Me.m_serverDB_Signed=server_nameDB
If Not Trim(pathDB)="" Then Me.m_pathDB_Signed=pathDB
If Not Trim(pathFile)="" Then Me.m_path_XML=pathFile

If Not Proverka Then mes=me.m_error_Text: Error 1000

If Not me.GetSoprovod Then mes="Ошибка получения списка подписей из тега. "+ me.m_error_Text: Error 1000
If Not me.GetSignFile Then mes="Ошибка получения списка ЭП. "+ me.m_error_Text: Error 1000
If Not me.GetPodpisant Then mes="Ошибка получения списка людей имеющих право подписывать. "+ me.m_error_Text: Error 1000

Dim mas_tmp As Variant
ForAll v1 In me.m_ListSignSoprovod'(v1.FIO=Иванов И.И. или И.И. Иванов или Иванов И. И. или И. И. Иванов)
mas_tmp=Split(UCase(Trim(v1.FIO)), " ")
If UBound(mas_tmp)=1 Or UBound(mas_tmp)=2 Then
i=0
ReDim mas1(1)
ForAll v In mas_tmp
If InStr(v,".")=0 Then'если фамилия (нет точки)
mas1(0)=Trim(v)
Else
If i=0 Then mas1(1)=Trim(v) Else mas1(1)=mas1(1)+Trim(v)
i=1
End If
End ForAll
mas1(1)=Replace(mas1(1),". ",".")
tmp1=mas1(0)+" "+mas1(1)
tmp1=me.TrimForNoRus(tmp1) 'оставим только кирилические символы, точки и пробел
If Mid$(tmp1,Len(tmp1),1)<>"." Then tmp1=tmp1+"." 'иногда может встречаться И.О без точки после О
Print "ФИО из сопровода из тега - //" +tmp1+"//"
ForAll v2 In me.m_ListSignEP'(v2.FIO=Иванов Иван Иванович) - из ЭП
mas2=Split(Trim(UCase(v2.FIO)), " ")'mas1(0)=ИВАНОВ mas1(1)=ИВАН mas1(2)=ИВАНОВИЧ
tmp2=Trim(mas2(0))+" "+ Trim(Left$(mas2(1), 1)+"."+Left$(mas2(2), 1)+".")
tmp2=me.TrimForNoRus(tmp2) 'оставим только кирилические символы, точки и пробел
Print "ФИО из ЭП - //" +tmp2+"//"
If tmp1=tmp2 Then
ForAll v3 In me.m_ListSignPodp'(v3.FIO=Иванов Иван Иванович)
mas3=Split(Trim(UCase(v3.FIO)), " ")
tmp3=Trim(mas3(0))+" "+Trim(Left$(mas3(1), 1)+"."+Left$(mas3(2), 1)+".")
tmp3=me.TrimForNoRus(tmp3)'оставим только кирилические символы, точки и пробел
Print "ФИО из БД 'Подписанты' - //" +tmp3+"//"
If tmp3=tmp2 Then
If v2.UINFL=v3.UINFL And ((v2.UINUL<>"" And v2.UINUL=v3.UINUL) Or (v2.UINOIGV<>"" And v2.UINOIGV=v3.UINOIGV)) Then
b_tmp=True : GoTo end_func
End If
End If
End ForAll
End If
End ForAll
End If
End ForAll

end_func:
If Not b_tmp Then mes="Нет совпадения подписантов.": Error 1000
Print "Совпадение подписантов найдено. Проверка пройдена успешно."
VerifySignedXML=True
Exit Function
errh:
If Not me.m_isError Then mes="Не удалось проверить подписантов. "+mes
Call me.SetError(Err, mes)
Exit Function
End Function

Public Function VerifySignedXMLFromDoc(pathCriptoGSS As String, server_nameDB As String, pathDB As String, doc As Variant, itemname As String) As Boolean
On Error GoTo errh
VerifySignedXMLFromDoc=False
me.m_name_XML=""
Call me.RestoreNULL
Dim db As NotesDatabase, rtitem As NotesRichTextItem, mes As String, obj As Variant

If Not Trim(pathCriptoGSS)="" Then Me.m_path_criptoGSS=pathCriptoGSS
If Not Trim(server_nameDB)="" Then Me.m_serverDB_Signed=server_nameDB
If Not Trim(pathDB)="" Then Me.m_pathDB_Signed=pathDB
If Not doc Is Nothing Then Set me.m_doc=doc
If Not Trim(itemname)="" Then me.m_item_name=itemname

If me.m_doc Is Nothing Then mes="Ошибка!!! Не передан NotesDocument": Error 1000
If Trim(Me.m_item_name)="" Then mes="Ошибка!!! Не указано название итема содержащего аттач": Error 1000

If Not me.m_doc.HasEmbedded Then mes="Ошибка!!! В NotesDocument нет аттача": Error 1000
If Not me.m_doc.HasItem(me.m_item_Name) Then mes="Ошибка!!! В NotesDocument нет указанного итема": Error 1000

Set rtitem = me.m_doc.GetFirstItem(me.m_item_Name)
If rtitem Is Nothing Then mes="Ошибка!!! Не могу получить объект итема": Error 1000
If IsEmpty(rtitem.EmbeddedObjects) Then mes="Ошибка!!! В указанном итеме нет аттача": Error 1000

Set obj=rtitem.EmbeddedObjects(0)
If Not (obj.Type = EMBED_ATTACHMENT) Then mes="Ошибка!!! В указанном итеме объект не является аттачем": Error 1000
If Not LCase(StrRightBack(obj.Source , ".")) = "xml" Then mes="Ошибка!!! Аттач не является XML файлом": Error 1000

me.m_name_XML=obj.Source
Me.m_path_XML=me.GetNotesTempDirectory+obj.Source

If Not Proverka Then mes=me.m_error_Text: Error 1000

Call obj.ExtractFile(Me.m_path_XML)

If Not VerifySignedXML(Me.m_path_criptoGSS, Me.m_serverDB_Signed, Me.m_pathDB_Signed, Me.m_path_XML)Then
mes=Me.m_error_Text
Kill me.m_path_XML
Error 1001
End If

Kill me.m_path_XML
VerifySignedXMLFromDoc=True
Exit Function
errh:
If Not Err=1001 Then mes="Не удалось проверить подписантов. "+mes
Call me.SetError(Err, mes)
Exit Function
End Function

'геттеры
Public Property Get GetListTeg As Variant
On Error GoTo errh
Dim mes As String
If me.m_Ubound_idx_SignSoprovod=-1 Then mes="Нет подписей в сопроводе": Error 1000
GetListTeg=me.m_ListSignSoprovod
Exit Property
errh:
GetListTeg=Null
Call me.SetError(Err, mes)
Exit Property
End Property

Public Property Get GetListEP As Variant
On Error GoTo errh
Dim mes As String
If me.m_Ubound_idx_SignEP=-1 Then mes="Нет подписей ЭП": Error 1000
GetListEP=me.m_ListSignEP
Exit Property
errh:
GetListEP=Null
Call me.SetError(Err, mes)
Exit Property
End Property

Public Property Get GetListPodp As Variant
On Error GoTo errh
Dim mes As String
If me.m_Ubound_idx_SignPodp=-1 Then mes="Нет данных ведомству о подписантах": Error 1000
GetListPodp=me.m_ListSignPodp
Exit Property
errh:
GetListPodp=Null
Call me.SetError(Err, mes)
Exit Property
End Property

Public Property Get GetNameXML As String
GetNameXML=me.m_name_XML
End Property

Public Property Get GetNameOrg As String
GetNameOrg=me.m_name_org
End Property
Public Property Get GetKodMedOrg As String
GetKodMedOrg=me.m_kod_med
If Not me.m_kod_med_sub="" Then GetKodMedOrg=GetKodMedOrg+"."+me.m_kod_med_sub
End Property
Public Property Get GetCountListTeg As Integer
GetCountListTeg=me.m_Ubound_idx_SignSoprovod+1
End Property
Public Property Get GetCountListEP As Integer
GetCountListEP=me.m_Ubound_idx_SignEP+1
End Property
Public Property Get GetCountListPodp As Integer
GetCountListPodp=me.m_Ubound_idx_SignPodp+1
End Property
Public Property Get isError As Boolean
isError=me.m_isError
End Property
Public Property Get GetErrorText As String
GetErrorText=me.m_error_Text
End Property
'сеттеры******************
Public Property Set SetPathCriptoGSS As String
me.m_path_criptoGSS=SetPathCriptoGSS
End Property

Public Property Set SetPathXML As String
me.m_path_XML=SetPathXML
End Property
Public Property Set SetServerDBSigned As String
me.m_serverDB_Signed=SetServerDBSigned
End Property
Public Property Set SetPathDBSigned As String
me.m_pathDB_Signed=SetPathDBSigned
End Property
Public Property Set SetNotesDocument As NotesDocument
Set me.m_doc=SetNotesDocument
End Property
Public Property Set SetItemName As String
me.m_item_name=SetItemName
End Property

'**********************************************************************************************
Private Function GetSoprovod As Boolean'подписанты тег XML
On Error GoTo errh
Dim sax As New SAX_Parser, mes As String, i As Integer, mas As Variant, record As Variant
GetSoprovod=False
If Not sax.run(Me.m_path_XML) Then Error 1000

me.m_kod_med=sax.GetKodMed
me.m_kod_med_sub=sax.GetKodMedSub

If sax.GetCountListFIO>0 Then
mas=sax.GetListFIO 'получаем тестовый массив
For i=0 To sax.GetCountListFIO-1
Set record=New Lico
record.FIO=mas(i)
record.UINFL =""
record.UINUL =""
record.UINOIGV =""
ReDim Preserve me.m_ListSignSoprovod(i)
Set me.m_ListSignSoprovod(i)=record
Next
Me.m_Ubound_idx_SignSoprovod=sax.GetCountListFIO-1
Else
mes="Ошибка!!! В документе нет подписантов в теге"
Error 1000
End If
GetSoprovod=True
Exit Function
errh:
If Not sax Is Nothing Then mes=sax.GetErrorText()
Call me.SetError(Err, mes)
Exit Function
End Function

Private Function GetSignFile As Boolean'подписанты ЭП
On Error GoTo errh
Dim verify_class As New Verify_CriptoGSS
Dim i As Integer, mes As String, record As Variant
GetSignFile=False
If Not verify_class.SetAllArg(Me.m_path_criptoGSS, "All", Me.m_path_XML) Then mes=verify_class.GetTextError: Error 1000
If Not verify_class.verify Then mes=verify_class.GetTextError: : Error 1000

If verify_class.CountListSertInDoc>0 Then
For i=0 To verify_class.CountListSertInDoc-1
Set record=New Lico
With verify_class.GetListSertInDoc(i).Certificate
record.FIO =.FIO
record.UINFL =.UINFL
record.UINUL =.UINUL
record.UINOIGV =.UINOIGV
End With

ReDim Preserve me.m_ListSignEP(i)
Set me.m_ListSignEP(i)=record
Next
Me.m_Ubound_idx_SignEP=verify_class.CountListSertInDoc-1
Else
mes="Ошибка!!! В документе нет подписантов ЭП"
Error 1000
End If
GetSignFile=True
Exit Function
errh:
Call me.SetError(Err, mes)
Exit Function
End Function

Private Function GetPodpisant As Boolean
On Error GoTo errh

GetPodpisant=False

Dim mas As Variant, mes As String, key As String, i As Integer

If me.m_kod_med="" Then mes="Ошибка!!! Не получен код ведомства": Error 1000

Dim p_class As New Podpisant

key=me.m_kod_med
If Not me.m_kod_med_sub="" Then key=key+"."+me.m_kod_med_sub

If Not p_class.RunGetPodpisant(me.m_serverDB_Signed, me.m_pathDB_Signed, key) Then mes=p_class.GetErrorText : Error 1000

me.m_name_org=p_class.GetNameOrg

If p_class.GetCountListPodp>0 Then
mas=p_class.GetListPodp 'получаем уже массив объектов класса Lico
For i=0 To p_class.GetCountListPodp-1
ReDim Preserve me.m_ListSignPodp(i)
Set me.m_ListSignPodp(i)=mas(i)
Next
Me.m_Ubound_idx_SignPodp=p_class.GetCountListPodp-1
Else
mes="Ошибка!!! В документе нет подписантов в теге"
Error 1000
End If
%REM ' можно и так получить список
mas=p_class.GetListFIOPodp
If Not IsNull(mas) Then
For i=0 To UBound(mas)
ReDim Preserve me.m_ListSignPodp(i)
Set me.m_ListSignPodp(i)=mas(i)
Next
me.m_Ubound_idx_SignPodp=p_class.GetCountListFIOPodp-1
Else
mes="Не указаны подписанты по данному ведомству"
Error 1000
End If
%END REM

GetPodpisant=True
Exit Function
errh:
Call me.SetError(Err, mes)
Exit Function
End Function

Private Function Proverka As Boolean
On Error GoTo errh
Proverka=False
Dim mes As String
If Trim(Me.m_path_criptoGSS)="" Then mes="Ошибка!!! Не указан путь к ConsoleCriptoGSS": Error 1000
'If Trim(Me.m_serverDB_Signed)="" Then mes="Ошибка!!! Не указан сервер базы '"+db_title+"'": Error 1000
'If Trim(Me.m_pathDB_Signed)="" Then mes="Ошибка!!! Не указан путь к базе '"+db_title+"'": Error 1000
If Trim(Me.m_path_XML)="" Then mes="Ошибка!!! Не указан путь к проверяемому файлу": Error 1000
Proverka=True
Exit Function
errh:
Call me.SetError(Err, mes)
Exit Function
End Function

Private Function TrimForNoRus(value As String) As String 'оставляем только кирилицу,пробел и точки
On Error GoTo errh
Dim i As Integer, s As String, ch As String, tmp_str As String
TrimForNoRus=""
s=""
For i=1 To Len(value)
ch=Mid$(value,i,1)
If Asc(ch)=32 Or Asc(ch)=46 Or Asc(ch)=168 Or Asc(ch)=184 Or (Asc(ch)>=192 And Asc(ch)<=255) Then
TrimForNoRus=TrimForNoRus+ch
Else
s=s+"//Символ '"+ch+"', код ASCII="+CStr(Asc(ch))
End If
Next
If s<>"" Then Print "в значении '"+value+"' встретились не кирилличесике символы: "+s
Exit Function
errh:
Print "в ф-ции TrimForNoRus произошла ошибка № " & Err & " в строке " & Erl
TrimForNoRus=value
Exit Function
End Function

Private Sub RestoreNULL
me.m_isError=False
me.m_error_Text=""
Me.m_Ubound_idx_SignSoprovod=-1
Me.m_Ubound_idx_SignEP =-1
Me.m_Ubound_idx_SignPodp =-1

Me.m_kod_med=""
Me.m_kod_med_sub=""

If IsArray(me.m_ListSignSoprovod) Then Erase me.m_ListSignSoprovod
If IsArray(me.m_ListSignEP) Then Erase me.m_ListSignEP
If IsArray(me.m_ListSignPodp) Then Erase me.m_ListSignPodp
End Sub

Private Sub SetError(Er As Integer, mes As String)'записываем ошибку
Me.m_isError=True
If er>=1000 And er<=1100 Then
Me.m_error_Text=mes
Else
Me.m_error_Text="Ошибка № " & Er & " в строке " & Erl & Chr(13) & Error(Er)
End If
End Sub

Private Function GetNotesTempDirectory() As String'Путь для временных файлов
Dim d As String * 256
Dim s%
s% = w32_OSGetSystemTempDirectory(d)
GetNotesTempDirectory = Left$(d, s%) +"\"
End Function
End Class

35 Ответ от admin 2024-09-03 15:29:30

admin
Administrator
Неактивен

Зарегистрирован: 2010-04-07
Сообщений: 1,270
Репутация : 0

Re: Лотус скрипты для работы с XML

Запись текста в Rich Text поле.

Вариант с УИ.

mes2=sdate(0)+" документ отправил для подписи "&Chr(10)+user+" на " + mes3+" "&Chr(10)+" с комментарием: " + curdoc.komment(0)&Chr(10)+" "&Chr(10)
'+++++++++++++++++++++++++++++++
Call uidoc.FieldSetText("tmpadmh",uidoc.FieldGetText("adminhistory"))
Call uidoc.FieldClear("adminhistory")
Call uidoc.FieldSetText("adminhistory",mes2)
Call uidoc.FieldAppendText("adminhistory",uidoc.FieldGetText("tmpadmh"))
Call uidoc.FieldClear("tmpadmh")
Call uidoc.Refresh(True)
'+++++++++++++++++++++++++++++++
mes=curdoc.dohistory(0)
curdoc.dohistory=mes2+mes

вариант 2
formul$= "В " + Cstr(Now) + " документ XML сформирован (" + session.CommonUserName + ")." &Chr(13)+" "&Chr(13)
'Msgbox formul$
doc.ИСТОРИЯ = formul$ + doc.ИСТОРИЯ

36 Ответ от admin 2024-09-05 09:40:28

admin
Administrator
Неактивен

Зарегистрирован: 2010-04-07
Сообщений: 1,270
Репутация : 0

Re: Лотус скрипты для работы с XML

Получить имя файла во вложении.

Strleftback(rtitemA.EmbeddedObjects(0).Source , ".")

Лотус скрипты для работы с XML (Страница 2 из 2)

Сообщений с 26 по 36 из 36

26 Ответ от admin 2022-10-14 13:00:30

Re: Лотус скрипты для работы с XML

27 Ответ от admin 2022-10-14 13:00:36

Re: Лотус скрипты для работы с XML

28 Ответ от admin 2022-10-14 13:00:40

Re: Лотус скрипты для работы с XML

29 Ответ от admin 2022-10-14 13:01:55

Re: Лотус скрипты для работы с XML

30 Ответ от admin 2022-10-14 13:02:04

Re: Лотус скрипты для работы с XML

31 Ответ от admin 2022-10-14 13:02:12

Re: Лотус скрипты для работы с XML

32 Ответ от admin 2022-10-14 13:02:16

Re: Лотус скрипты для работы с XML

33 Ответ от admin 2022-10-14 13:02:29

Re: Лотус скрипты для работы с XML

34 Ответ от admin 2022-10-14 13:02:37

Re: Лотус скрипты для работы с XML

35 Ответ от admin 2024-09-03 15:29:30

Re: Лотус скрипты для работы с XML

36 Ответ от admin 2024-09-05 09:40:28

Re: Лотус скрипты для работы с XML

Сообщений с 26 по 36 из 36