Агент получения файлв с FTP и парсинга их NotesSAXParser

Public  pFlag As String
Public  PNod1 As String 
Public  PNod2 As String 
Public  PNod3 As String 
Public doc As NotesDocument

Sub Initialize
    On Error Goto ErrH
    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 domParser As NotesDOMParser
    Dim docNode As NotesDOMDocumentNode
    Dim  docrootnode As NotesDOMDocumentNode
    Dim strm As NotesStream    
    Dim  outputStream As NotesStream
    Set outputStream =session.CreateStream()
    Set strm = session.CreateStream() 
    
    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)
    
    
    Print "Агент FTP IN Стартовл!"
    Dim objFTP As NotesFTPSession
    Set objFTP=New NotesFTPSession
    
    'datapatch$ = "C:\Tmp-mejved\" 
    
    With objFTP
        .Connect ftpIP, ftpLogin, ftpPass, 0  '  НАДО получить возвращаемое значение - если ошибка!
        If objFTP.IsConnected =  True  Then
        '.ChangeDirectory("Finali")
            Dim xxx As Variant
            xxx = .dir("Finali")
            
            If Isempty(xxx) Then        
                Print "Папка Finali пустая!"
                Exit Sub
            Else
                Print "В папке Finali файлы:"
                Forall v In xxx
                    Print v    
                End Forall
                Print   "----старт--------"
                
                Forall v In xxx
                    If Instr(v,"xml") Then             
                        Print "v=" & v
                        remoteFile$ = "Finali/"& v
                        localFile$ = datapatch$ & v
                        .GetFile remoteFile$, localFile$, FTP_TRANSFER_TYPE_BINARY    
                        Print "скопировали на винт"
                        ' проверка файла на винте
                        Sleep (2)
                        FName = Dir$(datapatch$ & {*.*}, 0) 
                        Print "проверка, что файл в папке на винте - старт"
                        While FName <> ""
                            Print "FName=" & FName
                            If FName = v Then
                                Print  "Файл на винте ЕСТЬ - "  & localFile$
                            End If
                            FName = Dir$() 
                        Wend
                        FName =""
                        Sleep (1)
                        Print "проверка создания файла на винте - енд"
                ' создаем новый док в базе и прикрепляем к нему xml файл
                        
                        Set doc = New NotesDocument(db)
                        doc.Form="fmejved"
                        doc.ТИП_ДОКУМЕНТА="Входящий"
                        doc.fxml="1"
                        doc.АДРЕСАТ = ""  ' надо создать поле
                        Set rtitem = New NotesRichTextItem( doc, "ПРИЛОЖЕНИЯ_" )
                        Set object = rtitem.EmbedObject  (EMBED_ATTACHMENT, "", localFile$)
                        Call strm.Open(localFile$, "UTF-8" )
                        
                        ' -------------- SAX
                        pFlag = "0"         ' паблик элемент xml дерева, в котором распарсевыемые теги
                        PNod1 = "0"  ' паблик элемент xml дерева, в котором теги уровня 1.
                        PNod2 = "0"  ' 2-й уровень вложенности
                        PNod3 = "0" 
                        Print "Старт NotesSAXParser"
                        Dim saxParser As NotesSAXParser
                        Set saxParser=session.CreateSAXParser(strm, outputStream)
                        On Event SAX_Characters From saxParser Call SAXCharacters ' содержимое элемента
                        On Event SAX_StartElement  From saxParser Call SAXStartElement 'старт элемента
                        saxParser.Process
                        Print "Конец NotesSAXParser"
                        
                        
                        Call doc.Save(True, True)
                        Print "doc.Save"
ForNextXML:    
                        Call strm.Close
                        'Print localFile$ + " запишем в temp.bat - удалить xml-ку"
                        fileNum% = Freefile()
                        Open datapatch$ + "temp.bat" For Append As fileNum%
                        Print # fileNum%, "del " localFile$
                        Close  fileNum%
                        .DeleteFile  remoteFile$ '  стерли на фтп
                    'Print  "--+++-- Файл на ФТП стерт  " + remoteFile$
                    End If
                End Forall
            End If    
            .Disconnect
        End If    
    End With
    
    Sleep (2) '   запуск temp.bat для удаления всех xml
    deletefile% = Shell (datapatch$ + "temp.bat" ,1)   '  вернуло 33 - всё ок.
    Print  "Файлы xml на винте стерты"
    Sleep (2)
    Kill datapatch$ + "temp.bat"
    
    Delete objFTP    
    Print "Агент FTP IN отработал!"
    Exit Sub
ErrH:
    Print "FTP IN - Агент - Ошибка: " & Err & " - " & Error(Err) & " в строке " & Erl
    If Err = 4602  Then
        Print "Отработали ошибку 4602 - не отработал domParser.Process"
        Resume ForNextXML
    End If
'    
End Sub

Sub SAXCharacters (Source As Notessaxparser, Byval Characters As String, Count As Long)
    
    If pFlag = "nameru" Then
        Print " nameru текст "  Characters
        doc.ОСНОВНОЙ_КОРРЕСПОНДЕНТ = Characters
        pFlag = "0"
    End If
    
    If pFlag = "header" And PNod1 = "container" Then
        Print " header текст " Characters
        doc.ЗАГОЛОВОК     = Characters
        pFlag = "0"
    End If
    
    If pFlag = "post" And PNod3 = "legalentity" Then
        Print " post текст " Characters
        doc.АДРЕСАТ  = Characters
        pFlag = "0"
    End If
    
    If pFlag = "datareg" And PNod2 = "reg" Then
        Print " datareg текст " Characters
        doc.ДАТА_ОСНОВНОГО_КОРРЕСПОНДЕНТА =  Characters
        pFlag = "0"
    End If
    
    If pFlag = "regnumber" And PNod2 = "reg" Then
        Print " regnumber текст " Characters
        doc.РЕГ_НОМ_ОСНОВНОГО_КОРРЕСПОНДЕНТА = Characters
        pFlag = "0"
    End If
    
    If pFlag = "vhodregdate" And PNod2 = "reg" Then
        Print " vhodregdate текст " Characters
        pFlag = "0"
    End If
    
    If pFlag = "vhodregnumber" And PNod2 = "reg" Then
        Print " vhodregnumber текст " Characters
        pFlag = "0"
    End If
    
    If pFlag = "executorname" And PNod2 = "executor" Then
        Print " executorname текст " Characters
        pFlag = "0"
    End If
    
    If pFlag = "idgosuslug" And PNod2 = "servinfo" Then
        Print " idgosuslug текст " Characters
        pFlag = "0"
    End If
End Sub

Sub SAXStartElement (Source As Notessaxparser, Byval elementname As String, Attributes As NotesSaxAttributeList)
    Dim i As Integer
    
    If elementname = "container" Then
        PNod1 = "container"
        Print "<container>"
    End If
    If elementname = "servinfo" Then
        PNod1 = "servinfo"
        Print "<servinfo>"
    End If
    If elementname = "destinations" Then
        PNod2 = "destinations"
        Print "<destinations>"
    End If
    If elementname = "reg" Then
        PNod2 = "reg"
        Print "<reg>"
    End If
    If elementname = "executor" Then
        PNod2 = "executor"
        Print "<executor>"
    End If
    If elementname = "legalentity" Then
        PNod3 = "legalentity"
        Print "<legalentity>"
    End If
    ' -----------------------------------------------------------    
    If elementname="nameru" Then   '  container / nameru
        pFlag = "nameru" 
        Print " <nameru>"
        Print "PNod1 =  "  PNod1
    End If
    If elementname="header" Then   ' container / header
        'And fParentNode = "container" 
        pFlag = "header" 
        Print "<header>"
        Print "PNod1 =  "  PNod1
    End If
    
    If elementname="post" Then '    container/destinations/destination/legalentity/post
        pFlag = "post" 
        Print "<post>"
        Print "PNod3 =  "  PNod3
    End If
    If elementname="datareg" Then 'container / reg / datareg
        pFlag = "datareg" 
        Print "<datareg>"
        Print "PNod2 =  "  PNod2
    End If    
    If elementname="regnumber" Then 'container / reg / regnumber
        pFlag = "regnumber" 
        Print "<regnumber>"
        Print "PNod2 =  "  PNod2
    End If    
    If elementname="vhodregdate" Then ''container / reg / vhodregdate
        pFlag = "vhodregdate" 
        Print "<vhodregdate>"
        Print "PNod2 =  "  PNod2
    End If    
    If elementname="vhodregnumber" Then 'container / reg /  vhodregnumber
        pFlag = "vhodregnumber" 
        Print "<vhodregnumber>"
        Print "PNod2 =  "  PNod2
    End If    
    If elementname="executorname" Then ''container /  executor / executorname
        pFlag = "executorname" 
        Print "<executorname>"
        Print "PNod2 =  "  PNod2
    End If    
    If elementname="idgosuslug" Then 'servinfo / idgosuslug
        pFlag = "idgosuslug" 
        Print "<idgosuslug>"
        Print "PNod1 =  "  PNod1
    End If    
    
End Sub