Создание таблицы в RT-поле с помощью Notes SaxParser'а

Тема в разделе "Lotus - Программирование", создана пользователем StarikStarik2705, 30 окт 2012.

  1. StarikStarik2705

    StarikStarik2705 Well-Known Member

    Регистрация:
    8 фев 2012
    Сообщения:
    103
    Симпатии:
    0
    в общем написал такой код
    Sub NewTableHTML (rtitem As NotesRichTextItem)
    '%rem
    Call rtitem.Appendtext({ <?xml version="1.0"?>
    <table align = "center" Width="700" cellspacing="0" border="1" cols="5" >
    <tr>
    <tbody align = "center">
    <td>Дата и время изменения</td>
    <td>Изменено поле</td>
    <td>Старое значение</td>
    <td>Новое значение</td>
    <td>Автор изменения</td>
    </tbody>
    </tr>
    </table>})
    Dim session As New NotesSession
    Dim saxParser As NotesSAXParser
    Set saxParser = session.Createsaxparser(rtitem)
    saxParser.process

    ' %end rem
    End Sub

    Парсер говорит что неправ. Идея такая что я хочу вместо тегов на странице увидеть вырисованый HTML код, в даном случае табличку с пятью колонками. Если кто сталкивался подскажите будьте добры что делать, и вообще как пользоваться парсом этим
     
  2. dimat

    dimat Lotus team
    Lotus team

    Регистрация:
    31 июл 2008
    Сообщения:
    518
    Симпатии:
    0
    А парсер то для чего здесь?
    Если просто html таблицу надо отобразить:
    в скрытое текстовое поле код html, в Computed text формула - <имя поля> + сделать Computed text pass thru html
     
  3. VladSh

    VladSh начинающий
    Lotus team

    Регистрация:
    11 дек 2009
    Сообщения:
    1.251
    Симпатии:
    2
    html хоть с помощью pass thru html (на форме), хоть с промощью API (в ричтексте) нормально отображаться не будет, т.к. для отображения его в формах специально оставили движок нетскейп-навигатора 4-й версии.

    Идея - нарисовать табличку со всеми красивостями в ричтексте вручную, сохранить док, экспортировать его в xml, взять это ричтекстовое поле и разобраться как оно устроено. Ну а дальше написать код, который будет генерить xml для ричтекста, и впихивать DXLImporter'ом. Думаю, что этот вариант получше будет.

    Ну и ещё вариант - забить и переходить на икспагесы.
     
  4. StarikStarik2705

    StarikStarik2705 Well-Known Member

    Регистрация:
    8 фев 2012
    Сообщения:
    103
    Симпатии:
    0
    короче тут родилось вот что...не хочет в рич поле воспринимать HTML и рисовать таблицу. Кто знает что делать? галки типа PassThruHtml стоят, и плюс кодом в стиле указал на то что бы флаг тру был. Не кушает, что делать ? может кто сталкивался
     
  5. dimat

    dimat Lotus team
    Lotus team

    Регистрация:
    31 июл 2008
    Сообщения:
    518
    Симпатии:
    0
    а почему именно в ричтекст html запихиваете?
     
  6. hosm

    hosm * so what *

    Регистрация:
    18 май 2009
    Сообщения:
    2.450
    Симпатии:
    7
    dimat чтоб не ограничивать себя 32/64К, там надо логировать и красиво в табличке показывать изменения полей документа
     
  7. VladSh

    VladSh начинающий
    Lotus team

    Регистрация:
    11 дек 2009
    Сообщения:
    1.251
    Симпатии:
    2
    1, 2.

    Но я бы всё-таки остановился на процитированном варианте:
     
  8. StarikStarik2705

    StarikStarik2705 Well-Known Member

    Регистрация:
    8 фев 2012
    Сообщения:
    103
    Симпатии:
    0
    ну сначала это XML а потом Html в общем спасибо вам всем, всё получилось усилиями главного програмиста, что говорить опыт это опыт.
     
  9. VladSh

    VladSh начинающий
    Lotus team

    Регистрация:
    11 дек 2009
    Сообщения:
    1.251
    Симпатии:
    2
    CтарыйStarik
    Хотелось бы немного подробностей. А то народ пытался тут помогать и теперь в недоумении :)
     
  10. Anatoly

    Anatoly Well-Known Member

    Регистрация:
    30 мар 2007
    Сообщения:
    204
    Симпатии:
    0
    Есть NotesLog, упрощенно всю историю изменения разных полей в разных базах можно вести.
    Если хочется большего функционала, можно создать свою отдельную базу под это дело, создать класс для логирования, подцеплять его к формам.
    B базу писать: дата-время, юзер, база, документ, реквизит, что было, что стало... Помоему, вполне информативно.
    Для каждой контролируемой формы - документ настроек с перечнем контролируемых полей и прочим.
    Как мне кажетcя, так удобнее, функциональнее и нагляднее. А так-же гибче и не надо засорять основные базы :)
     
  11. StarikStarik2705

    StarikStarik2705 Well-Known Member

    Регистрация:
    8 фев 2012
    Сообщения:
    103
    Симпатии:
    0
    пожалуйста )
    Код (LotusScript):
    Class HistoryChange
    Private fieldsNameList_ As Variant
    Public fieldsListContent List As Variant
    Public fieldsListSaveChange List As Variant
    Private s As NotesSession
    Private db As NotesDatabase
    Private doc_ As NotesDocument

    Sub New(doc As NotesDocument)
    On Error GoTo errorProc
    Dim i As Long
    Dim ListF As Variant

    Set Me.s=New NotesSession()
    Set Me.db=Me.s.Currentdatabase
    Set Me.doc_=doc
    ListF=Join(getChangeFields(),";")
    If Trim(ListF)="" Then
    ReDim ME.fieldsNameList_(0)
    Me.fieldsNameList_(0)=""
    Else
    Me.fieldsNameList_=Split(ListF,";")        
    End If
    If (Me.fieldsNameList_(0))<>"" Then
    For i=LBound(Me.fieldsNameList_) To UBound(Me.fieldsNameList_)
    fieldsListContent(Me.fieldsNameList_(i))=Me.doc_.Getitemvalue(Me.fieldsNameList_(i))
    Next
    End If     
    endofsub:
    Exit Sub
    errorproc:
    MsgBox "Error #" & Err & " on line " & Erl & " in SL HistoryChangeData --> Class HistoryChange --> Sub NEW" & LSI_Info(2) & " : " & Error, 48, "Runtime error"
    Resume endofsub
    End Sub


    Private Function getChangeFields() As Variant
    getChangeFields = getCurrentDBSetup().getItemValue("HistoryChangeDate")'вернёт значение в поля из БД Администрирование, для текущей БД(в данный момент Типовые маршруты)
    End Function

    '-----Формирование данных об изменениях
    function SaveChange(needReOpen As Boolean) As Boolean
    On Error GoTo errorProc1
    Dim RT_HistoryXML As NotesRichTextItem
    Dim DataTime As NotesItem

    Dim stream As NotesStream
    Dim domParser As NotesDOMParser
    Dim xNode As NotesDOMXMLDeclNode
    Dim xNodeNew As NotesDOMXMLDeclNode
    Dim domdoc As NotesDOMDocumentNode
    Dim tableNode As NotesDOMElementNode
    Dim rowNode As NotesDOMElementNode
    Dim cellNode As NotesDOMElementNode
    Dim textNode As NotesDOMTextNode
    Dim cdataNode As NotesDOMCDATASectionNode
    Dim itemList As NotesDOMNodeList   
    Dim b As Boolean

    b=false
    If Not(IsList(Me.fieldsListContent)) Then Exit function
    Set RT_HistoryXML=Me.doc_.Getfirstitem("RT_HistoryXML")    
    If RT_HistoryXML Is Nothing Then
    Set RT_HistoryXML=New NotesRichTextItem(Me.doc_,"RT_HistoryXML")
    End If

    Set stream=Me.s.CreateStream

    If Trim(RT_HistoryXML.Getunformattedtext())="" Then
    Const version="1.0"
    Const standalone="yes"
    Const encoding="windows-1251"
    Set domParser=Me.s.CreateDOMParser(RT_HistoryXML , stream)
    domParser.AddXMLDeclNode = True
    Set domdoc = domparser.Document
    %REM
    If domdoc Is Nothing Then
    MsgBox "Нету"
    Else
    MsgBox "Есть"
    End If
    %endrem
    Set xNodeNew =domdoc.CreateXMLDeclNode( version , encoding , standalone )
    Call domdoc.AppendChild(xNodeNew ) 
    Set tableNode=domdoc.CreateElementNode("table")
    Call domdoc.AppendChild(tableNode)
    Else
    Set domParser=Me.s.CreateDOMParser(RT_HistoryXML , stream)
    domParser.AddXMLDeclNode = True
    domParser.Process
    Set domdoc = domparser.Document
    Set itemList = domdoc.GetElementsByTagName ("table")
    Set tableNode=itemList.Getitem(1)
    End If


    ForAll ls In Me.fieldsListContent
    fieldsListSaveChange(ListTag(ls))=Me.doc_.Getitemvalue(ListTag(ls))
    End ForAll

    ForAll ls In Me.fieldsListContent
    If  Not equal(ls,(fieldsListSaveChange(ListTag(ls)))) Then
    'MsgBox ListTag(ls)            
    Set DataTime = me.doc_.Getfirstitem(ListTag(ls))
    Set rowNode=domdoc.CreateElementNode("row")
    Call tableNode.AppendChild(rowNode)             '
    '----Дата--------
    Set cellNode=domdoc.CreateElementNode("cell")
    Call rowNode.AppendChild(cellNode)
    Set textNode = domdoc.CreateTextNode(DataTime.Lastmodified)
    Call cellNode.AppendChild(textNode)
    '-----Поле пшеничное
    Set cellNode=domdoc.CreateElementNode("cell")
    Call rowNode.AppendChild(cellNode)
    Set textNode = domdoc.CreateTextNode(ListTag(ls))
    Call cellNode.AppendChild(textNode)
    '-----Старое значение
    Set cellNode=domdoc.CreateElementNode("cell")
    Call rowNode.AppendChild(cellNode)
    Set cdataNode = domdoc.CreateCDataSectionNode(Join(ls,"######-$$"))            
    Call cellNode.AppendChild(cdataNode)
    '-----Новое значение
    Set cellNode=domdoc.CreateElementNode("cell")
    Call rowNode.AppendChild(cellNode)
    Set cdataNode = domdoc.CreateCDataSectionNode(Join(fieldsListSaveChange(ListTag(ls)),"######-$$"))             
    Call cellNode.AppendChild(cdataNode)
    '---Автор изменения
    Set cellNode=domdoc.CreateElementNode("cell")
    Call rowNode.AppendChild(cellNode)
    Set cdataNode = domdoc.CreateCDataSectionNode(GetRefName(s.Effectiveusername))
    Call cellNode.AppendChild(cdataNode)
    b=True
    End If
    End ForAll     
    Call domparser.Serialize( )
    'MsgBox stream.ReadText    
    stream.Position=0  
    If b Then
    Call RT_HistoryXML.Remove()
    Set RT_HistoryXML = New NotesRichTextItem(me.doc_, "RT_HistoryXML")
    Call RT_HistoryXML.Appendtext(stream.ReadText)
    Call Me.doc_.Save(True, False)
    SaveChange=true
    End If         
    Call stream.Close
    endofsub:
    Exit function
    errorproc1:
    MsgBox "Error #" & Err & " on line " & Erl & " in SL HistoryChangeData --> Class HistoryChange --> " & LSI_Info(2) & " : " & Error, 48, "Runtime error"
    Resume endofsub
    End function

    '----Вывод истории изменений
    Function showDataFromXML() As Boolean
    On Error GoTo errorProc1
    Dim saxParser As NotesSAXParser
    Dim RT_HistoryXML As NotesRichTextItem
    Dim stream As NotesStream
    Dim RT_History As NotesRichTextItem
    Dim nrts As NotesRichTextStyle

    Dim body As NotesMIMEEntity

    Set RT_HistoryXML=Me.doc_.Getfirstitem("RT_HistoryXML")    
    If RT_HistoryXML Is Nothing Then
    Set RT_HistoryXML=New NotesRichTextItem(Me.doc_,"RT_HistoryXML")
    End If

    If Trim(RT_HistoryXML.Getunformattedtext())="" Then
    Exit function
    End If
    Set stream=Me.s.CreateStream

    Set saxParser=Me.s.CreateSAXParser(RT_HistoryXML,stream)
    On Event SAX_Characters From saxParser Call SAXCharacters
    On Event SAX_EndDocument From saxParser Call SAXEndDocument
    On Event SAX_EndElement From saxParser Call SAXEndElement
    On Event SAX_Error From saxParser Call SAXError
    On Event SAX_FatalError From saxParser Call SAXFatalError
    On Event SAX_IgnorableWhitespace From saxParser     Call SAXIgnorableWhitespace
    On Event SAX_NotationDecl From saxParser Call SAXNotationDecl
    On Event SAX_ProcessingInstruction From saxParser   Call SAXProcessingInstruction
    On Event SAX_StartDocument From saxParser Call SAXStartDocument
    On Event SAX_StartElement From saxParser Call SAXStartElement
    On Event SAX_UnparsedEntityDecl From saxParser Call SAXUnparsedEntityDecl
    On Event SAX_Warning From saxParser Call SAXWarning
    saxParser.Process ' initiate parsing

    'MsgBox stream.ReadText


    stream.Position=0
    Set RT_History=Me.doc_.Getfirstitem("RT_History")      
    If Not(RT_History Is Nothing) Then
    Call RT_History.Remove()
    End If
    Set body = Me.doc_.Createmimeentity("RT_History")


    Call body.SetContentFromText(stream, "text/html; charset=utf-8", 1725)
    Call stream.Truncate
    Call Me.doc_.Closemimeentities(True, "RT_History")

    %rem
    Set nrts = s.Createrichtextstyle()
    nrts.PassThruHTML = True
    Set RT_History=New NotesRichTextItem(Me.doc_,"RT_History")
    Call RT_History.Appendstyle(nrts)        
    'Call RT_History.Appendtext(stream.ReadText)
    Call RT_History.AppendText("<H1>Hello</H1>")
    %endrem
    endofsub:
    Exit Function
    errorproc1:
    MsgBox "Error #" & Err & " on line " & Erl & " in SL HistoryChangeData --> Class HistoryChange --> " & LSI_Info(2) & " : " & Error, 48, "Runtime error"
    Resume endofsub
    End Function

    Public Property Get fieldsNameList As Variant
    Set Me.fieldsNameList = Me.fieldsNameList_
    End Property

    Public Property Set fieldsNameList As Variant
    Set fieldsNameList_ = fieldsNameList
    End Property

    private Function equal (arr1, arr2) As Boolean ' для сравнивания массивов (в даном случае листов)
    equal = False
    If Not IsArray (arr1) Or Not IsArray (arr2) Then Exit Function
    If UBound (arr1) - LBound (arr1) <> UBound (arr2) - LBound (arr2) Then Exit Function
    Dim found As Integer
    ForAll a1 In arr1
    found = False
    ForAll a2 In arr2
    If a1 = a2 Then found = True : Exit ForAll
    End ForAll
    If Not found Then Exit Function
    End ForAll
    ForAll a2 In arr2
    found = False
    ForAll a1 In arr1
    If a2 = a1 Then found = True : Exit ForAll
    End ForAll
    If Not found Then Exit Function
    End ForAll
    equal = True  
    End Function

    Sub SAXStartDocument (Source As NotesSAXParser)

    End Sub

    Sub SAXEndDocument (Source As NotesSAXParser)

    End Sub

    Sub SAXCharacters (Source As NotesSAXParser, ByVal Characters As String, _
    Count As Long)
    Dim tempStr As Variant
    tempStr=Split(Characters,"######-$$")      
    'Source.Output(Join(tempStr,";"))
    Source.Output(Join(tempStr, "<br>"))
    End Sub

    Sub SAXEndElement (Source As NotesSAXParser, ByVal ElementName As String)
    Select Case elementname
    Case "table"
    Source.Output({</tbody>})
    Source.Output("</table>")  
    Case "row"
    Source.Output({</tr>})
    Case "cell"
    Source.Output({</td>})
    End Select
    End Sub

    Sub SAXError (Source As NotesSAXParser, Exception As NotesSAXException )

    End Sub

    Sub SAXFatalError (Source As NotesSAXParser, Exception As NotesSAXException)

    End Sub

    Sub SAXIgnorableWhitespace (Source As NotesSAXParser,_
    ByVal characters As String, Count As Long)

    End Sub

    Sub SAXNotationDecl (Source As NotesSAXParser,_
    ByVal NotationName As String, ByVal publicid As String,_
    ByVal systemid As String)

    End Sub

    Sub SAXProcessingInstruction (Source As NotesSAXParser,_
    ByVal target As String, ByVal PIData As String)

    End Sub

    Sub SAXStartElement (Source As NotesSAXParser,_
    ByVal elementname As String, Attributes As NotesSAXAttributeList)
    select case elementname
    Case "table"
    Source.Output({<table width="100%" style="border:1px solid #C0C0C0;border-spacing:0px;border-collapse: collapse">})
    Source.Output({<thead align="center" bgcolor="#DCDCDC" style = "font-family: Verdana;font-size: 10px;order: 0px">})
    Source.Output({<tr>})
    Source.Output({<td width="100px">Дата и время<br> изменения</td>})
    Source.Output({<td width="100px">Изменено поле</td>})
    Source.Output({<td width="150px">Старое значение</td>})
    Source.Output({<td width="150px">Новое значение</td>})
    Source.Output({<td width="100px">Автор изменения</td>})
    Source.Output({</tr>})
    Source.Output({</thead>})
    Source.Output({<tbody>})
    Case "row"
    Source.Output({<tr>})
    Case "cell"
    Source.Output({<td style = "font-family: Verdana;font-size: 10px">})   
    End Select
    End Sub

    Sub SAXUnParsedEntityDecl (Source As NotesSAXParser,_
    ByVal Entityname As String, ByVal publicid As String,_
    ByVal systemid As String, ByVal notationname As String)

    End Sub

    Sub SAXWarning (Source As NotesSAXParser, Exception As NotesSAXException)

    End Sub
    End Class
    Это весь код который создаёт XML, хранит его в одном Рич поле, а при открытии документа генерит из него таблицу с тем что мне надо. Писал не я а мой главный програмист со мной поетому все цветы не мне.

    пример вызова такой:
    Код (LotusScript):
    If Not (Isnewdoc) Then
    Set GloBalls = New HistoryChange(Source.Document)
    Call GloBalls.showDataFromXML()
    End If
    у нас поля которые нужно сравнивать храняться в другой БД но записываються через точку с запятой
    примерно так, если что не понятно пишите я отвечу
     
Загрузка...
Похожие Темы - Создание таблицы поле
  1. StarikStarik2705
    Ответов:
    8
    Просмотров:
    2.816
  2. bond0608
    Ответов:
    1
    Просмотров:
    1.397
  3. kreiver
    Ответов:
    0
    Просмотров:
    1.269
  4. Kaiser
    Ответов:
    2
    Просмотров:
    1.794
  5. swyatogor
    Ответов:
    9
    Просмотров:
    180

Поделиться этой страницей