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

  • Автор темы StarikStarik2705
  • Дата начала
S

StarikStarik2705

#1
в общем написал такой код
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 код, в даном случае табличку с пятью колонками. Если кто сталкивался подскажите будьте добры что делать, и вообще как пользоваться парсом этим
 

dimat

Lotus team
31.07.2008
516
0
#2
Парсер говорит что неправ. Идея такая что я хочу вместо тегов на странице увидеть вырисованый HTML код, в даном случае табличку с пятью колонками. Если кто сталкивался подскажите будьте добры что делать, и вообще как пользоваться парсом этим
А парсер то для чего здесь?
Если просто html таблицу надо отобразить:
в скрытое текстовое поле код html, в Computed text формула - <имя поля> + сделать Computed text pass thru html
 

VladSh

начинающий
Lotus team
11.12.2009
1 276
6
#3
html хоть с помощью pass thru html (на форме), хоть с промощью API (в ричтексте) нормально отображаться не будет, т.к. для отображения его в формах специально оставили движок нетскейп-навигатора 4-й версии.

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

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

StarikStarik2705

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

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

Ну и ещё вариант - забить и переходить на икспагесы.
короче тут родилось вот что...не хочет в рич поле воспринимать HTML и рисовать таблицу. Кто знает что делать? галки типа PassThruHtml стоят, и плюс кодом в стиле указал на то что бы флаг тру был. Не кушает, что делать ? может кто сталкивался
 

dimat

Lotus team
31.07.2008
516
0
#5
короче тут родилось вот что...не хочет в рич поле воспринимать HTML и рисовать таблицу. Кто знает что делать? галки типа PassThruHtml стоят, и плюс кодом в стиле указал на то что бы флаг тру был. Не кушает, что делать ? может кто сталкивался
а почему именно в ричтекст html запихиваете?
 

hosm

* so what *
18.05.2009
2 442
6
#6
dimat чтоб не ограничивать себя 32/64К, там надо логировать и красиво в табличке показывать изменения полей документа
 

VladSh

начинающий
Lotus team
11.12.2009
1 276
6
#7
короче тут родилось вот что...не хочет в рич поле воспринимать HTML и рисовать таблицу. Кто знает что делать? галки типа PassThruHtml стоят, и плюс кодом в стиле указал на то что бы флаг тру был. Не кушает, что делать ? может кто сталкивался
1, 2.

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

VladSh

начинающий
Lotus team
11.12.2009
1 276
6
#9
CтарыйStarik
Хотелось бы немного подробностей. А то народ пытался тут помогать и теперь в недоумении :)
 

Anatoly

Lotus team
30.03.2007
223
0
#10
dimat чтоб не ограничивать себя 32/64К, там надо логировать и красиво в табличке показывать изменения полей документа
Есть NotesLog, упрощенно всю историю изменения разных полей в разных базах можно вести.
Если хочется большего функционала, можно создать свою отдельную базу под это дело, создать класс для логирования, подцеплять его к формам.
B базу писать: дата-время, юзер, база, документ, реквизит, что было, что стало... Помоему, вполне информативно.
Для каждой контролируемой формы - документ настроек с перечнем контролируемых полей и прочим.
Как мне кажетcя, так удобнее, функциональнее и нагляднее. А так-же гибче и не надо засорять основные базы :)
 
S

StarikStarik2705

#11
CтарыйStarik
Хотелось бы немного подробностей. А то народ пытался тут помогать и теперь в недоумении :(
пожалуйста )
Код:
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, хранит его в одном Рич поле, а при открытии документа генерит из него таблицу с тем что мне надо. Писал не я а мой главный програмист со мной поетому все цветы не мне.

пример вызова такой:
Код:
If Not (Isnewdoc) Then
Set GloBalls = New HistoryChange(Source.Document)
Call GloBalls.showDataFromXML()
End If
у нас поля которые нужно сравнивать храняться в другой БД но записываються через точку с запятой
примерно так, если что не понятно пишите я отвечу