Тема: Парсим из htm файла с логом все теги <tr> в массив, Заносим лог в файл
Данный агент закачивает с фтп на винт сервера и потом распарсивает log.htm файл, он выбирает все теги <tr......Type="Giving/Coming/Deletion" .... > в массив myarray,
Потом в базе "роутер" мы находим все документы, у которых нет записи лога, записываем все записи лога для данного документа.
Признак - IDXml(Идентификатор сообщения) содержится в записи лога.
Опции:
Option Public
Use "NotesFTP"
Sub Initialize
' парсим из log.htm все теги <tr......Type="Giving" .... > в массив myarray,
On Error Goto ErrH
Print "СТАРТ UserLog"
Dim session As New NotesSession
Dim db As NotesDatabase
Set db = session.CurrentDatabase
Dim doc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim object As NotesEmbeddedObject
Dim myarray() As String ' массив для отправляемых записей лога. Первая запись в нем, последняя в лог файле.
Dim ind As Integer ' счетчик для myarray(ind) в котором только отправляемые Receive записи лога.
ind = 0
Redim Preserve myarray(ind)
Dim flagid As Integer
Dim itemLog As NotesItem
Dim domParser As NotesDOMParser
Dim docNode As NotesDOMDocumentNode
Dim tmpDocNode As NotesDOMElementNode
Dim tmpDocNode2 As NotesDOMNode
Dim DOMNodeList As NotesDOMNodeList
Dim child As NotesDOMNode
Dim tdDOMNoda As NotesDOMNode
Dim a As NotesDOMAttributeNode
Dim attrs As notesdomnamednodemap
Dim numChildNodes As Integer ' сколько тегов tr
Dim tdNodes As Integer ' td внутри tr
Dim strm As NotesStream
Dim outputStream As NotesStream
Set outputStream =session.CreateStream()
Set strm = session.CreateStream()
Dim viewidxml As NotesView
Dim objFTP As NotesFTPSession
Set objFTP=New NotesFTPSession
Dim ftpIP As String
Dim ftplogin As String
Dim ftpPass As String
'Dim datapatch As String
Dim view_conf As NotesView
Dim doc_conf As NotesDocument
'получить данные для доступа к FTP
Set db = session.CurrentDatabase
Set view_conf=db.GetView("Config")
Set doc_conf=view_conf.GetFirstDocument
If doc_conf.SFTPIP(0) = "" Then Print("Поле ftpIP сервера пустое, проверьте настройки !") : Exit Sub
If doc_conf.SFTPLogin(0) = "" Then Print("Поле ftpLogin пустое, проверьте настройки !") : Exit Sub
If doc_conf.SFTPPassword(0) = "" Then Print("Поле ftpPassword пустое, проверьте настройки !") : Exit Sub
If doc_conf.STmpDataPath(0) = "" Then Print("Поле папка tmp-mejved пустое, проверьте настройки !") : Exit Sub
ftpIP =doc_conf.SFTPIP(0)
ftpLogin=doc_conf.SFTPLogin(0)
ftpPass=doc_conf.SFTPPassword(0)
datapatch$=doc_conf.STmpDataPath(0)
'datapatch$ = "C:\Tmp-mejved\"
With objFTP
.Connect ftpIP, ftpLogin, ftpPass, 0 ' НАДО получить возвращаемое значение - если ошибка!
If objFTP.IsConnected = True Then
'.ChangeDirectory("Finali")
Dim xxx As Variant
xxx = .dir("UserLog")
Forall v In xxx
If Instr(v,"log.htm") Then ' Print "НАШЛИ ФАЙЛ: log.htm"
remoteFile$ = "../UserLog/"& v
localFile$ = datapatch$ & v
.GetFile remoteFile$, localFile$,0 ' НЕ пашет
'Print "скопировали на винт " & localFile$
Call strm.Open(localFile$, "UTF-8" )
Set domParser=session.CreateDOMParser(strm, outputStream)
'Print "Старт domParser.Process"
domParser.Process
Set docNode = domParser.Document ' NotesDOMDocumentNode (вершина дерева)
Set DOMNodeList = docNode.GetElementsByTagName("tbody")
' Print "записей:" & Cstr(DOMNodeList.NumberOfEntries)
Set tmpDocNode = DOMNodeList.GetItem(1) 'tbody
' Print tmpDocNode.TagName ' NotesDOMElementNode - элемент tbody
Set tmpDocNode2 = tmpDocNode ' ЗАЧЕМ???
numChildNodes = tmpDocNode2.NumberOfChildNodes ' все TR - запись истории одного дока
'Print "numChildNodes (tr):" & Cstr(numChildNodes)
' ' 1.ОБРАТНЫЙ ПРОХОД ПО ВСЕМ TR (с конца файла) для заполнения массива myarray
Set child = tmpDocNode2.LastChild ' узел TR - NotesDOMNode
'Print "child.NodeName:" & child.NodeName ' tr
For x = numChildNodes To 1 Step -1 ' TR - проход по всем .
Set attrs = child.Attributes
myarray(ind) =""
For j = 1 To attrs.NumberOfEntries ' TR - атрибуты
Set a = attrs.GetItem( j ) ' NotesDOMAttributeNode - атрибут
' Print "атрибут:" & a.AttributeName & ". значение:" & a.AttributeValue
If a.AttributeName = "Type" And a.AttributeValue="Receive" Then
myarray(ind) = "Receive" ' получение файла, ненужно нам
End If
If a.AttributeName = "ID" And myarray(ind) <> "Receive" Then ' если Type="Giving", то в myarray(ind) берем содержимое ID
myarray(ind) = Cstr(a.AttributeValue) ' номер в МВС
End If
Next
If myarray(ind) <> "Receive" Then ' Заполняю в массив myarray(ind) только отправку xml (Deletion, Coming и Giving)
tdNodes = child.NumberOfChildNodes ' все теги TD внутри TR записываем элемент массива myarray
' Print "найдено TD тегов:" & Cstr(tdNodes)
Set tdDOMNoda = child.FirstChild
While tdNodes > 0
' Print "td:" & tdDOMNoda.NodeName & " -- " &tdDOMNoda.FirstChild.NodeValue
myarray(ind) = myarray(ind) & "// " & tdDOMNoda.FirstChild.NodeValue ' содержимое td. которое внутри tr
Set tdDOMNoda = tdDOMNoda.NextSibling
tdNodes = tdNodes-1
Wend
ind = ind+1
Redim Preserve myarray(ind)
End If
Set child = child.PreviousSibling
Next
End If
End Forall
End If
End With
' Получили массив myarray вида "Файл с рег ном..9 был доставлен.. //Файл с рег ном..8 был доставлен.. // Файл ... 7"
' ---- ищем докмент в базе Роутер с IDXml как в массиве лога myarray(xx) ---------------
Dim dc As NotesDocumentCollection
searchFormula$ = {(log_flag="") & @Contains(ТИП_ДОКУМЕНТА; "Исходящий") & @Contains(fxml; "2")} 'fxml 2 - arhiv
Set dc=db.Search(searchFormula$,Nothing,0) ' все архивные исходящие доки в роутере
If dc.count <>0 Then
Print "Исходящих доков без лога в архиве роутера: " Cstr(dc.count)
End If
For i=1 To dc.count
Set doc = dc.GetNthDocument(i)
oname$ = doc.IDXml(0) ' Идентификатор эл. сообщения из документа в Роутере
Server_id = Split(doc.Server_id(0))
Serv_id = (Ubound(Server_id )+1)*2
Print "Serv_id " Serv_id
log_flag = 0
logindoc=""
If (oname$<>"") And (doc.log_flag(0) <> "2") Then ' в доке в роутере есть IDXml и лог не получен
Print "Записать лог в :" & doc.ЗАГОЛОВОК(0)
Print "IDXml в доке роутера: " & oname$
' массив myarray состоит из записей <td> в формате: межведомственный номер//время//текст типа "Ваш файл 123123/xml с заголовком ..."
' у записей "не был принят в МВС" запись - //время//текст
For xx = 0 To ind ' Проход по массиву лога и поиск совпадения IDXml
' Print "xx =" & Cstr(xx) & " - " & myarray(xx)
If Instr(myarray(xx),oname$) Then ' запись в логе совпала с IDXml.
Print "Совпадение ID:" & oname$
logindoc = Chr(13) + logindoc & Chr(13) + Replace(Strright (myarray(xx),"//"),"//"," ") + Chr(13) ' 1. Первая запись в лог документа роутера
' пример содержимого doc.doclog: - 2017-10-16 .. файл с рег номерром "был зарегестрирован в МВС" или "не был принят в МВС"
log_flag = log_flag + 1
Print "1-log_flag =" & log_flag
Print xx &"."& myarray(xx)
mejvedid$ = Strleft(myarray(xx),"//") ' Межведовский номер
If Instr(myarray(xx),"не был принят в МВС") Then
Print "не был принят в МВС"
log_flag = log_flag + 1
Print "2-log_flag =" & log_flag
doc.log_reject="0" ' не принят в МВС
doc.doclog = logindoc
Call doc.Save( False, True)
Else
Print "---принят в МВС"
If xx<>0 Then ' для записи myarray(0) не существует в массиве номер myarray(xx-1)
If (Strleft(myarray(xx-1),"//") = mejvedid$) Then'2.пред. элемент массива, относительно "был зарегестрирован в МВС"
Print "'myarray(xx-1) " & myarray(xx-1)
logindoc = logindoc + Chr(13) + Replace(Strright (myarray(xx-1),"//"),"//"," ") + Chr(13)
'в doc.doclog добавили "Файл с регистрационным номером <<1069018>> был доставлен до адресата".
log_flag = log_flag + 1
Print "3-log_flag =" & log_flag
doc.log_reject="1" ' принят в МВС
doc.doclog = logindoc
Call doc.Save( False, True)
End If
End If
End If
End If
Next
If log_flag = Serv_id Then
Print "4-log_flag =" & log_flag
doc.log_flag = "2" ' 2 - остановка логироания для дока.
Call doc.Save( False, True)
End If
Else
Print "ЗАГОЛОВОК: " & doc.ЗАГОЛОВОК(0) & " лог не нужен"
End If
Next ' конец dc.count
Print "КОНЕЦ UserLog"
Exit Sub
ErrH:
Print "UserLog - Агент - Ошибка: " & Error(Err) & " в строке " & Erl
If Err = 4602 Then ' DOM parser operation failed
Print "Отработали ошибку 4602"
'Resume ForNextXML
End If
'
End Sub