1

Тема: Парсим из 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

Поделиться

2

Re: Парсим из htm файла с логом все теги <tr> в массив, Заносим лог в файл

Пример записей, которые распарсивает данный скрипт, "-------" для наглядности.

<tr xmlns="" Type="Giving" File="18201832894141.xml" ID="1134018" Number="01--112233" Name="Тестовый 2 ведомства, оба в МЭД." Addressee="7">
-------
<td>2018-03-28 09:51:47</td>
<td>Ваш файл 18201832894141.xml; с заголовком: &lt;&lt;Тестовый 2 ведомства, оба в МЭД.; и регистрационным номером 01--112233 направленный на  был зарегестрирован в МВС под номером &lt;&lt;1134018;</td></tr>
-------
<td>2018-03-28 09:51:47</td>
<td>Файл с регистрационным номером ;1134018t; был доставлен до адресата</td></tr>
-----
<td>2018-03-28 09:51:49</td>
<td>Ваш файл &lt;&lt;18201832894141.xml&gt;&gt; с заголовком: &lt;&lt;Тестовый 2 ведомства, оба в МЭД.&gt;&gt; и регистрационным номером &lt;&lt;01--112233&gt;&gt; направленный на
&lt;&lt;&gt;&gt; был зарегестрирован в МВС под номером &lt;&lt;1135018&gt;&gt;</td>-
------
<td>2018-03-28 09:51:49</td>
<td>Файл с регистрационным номером &lt;&lt;1135018&gt;&gt; был доставлен до адресата</td></tr>

Поделиться