@Min and @Max on LotusScript lists

Ref: Notes/Domino 6 and 7 Forum


 ********** MAX **********
Function Max(numList List As Integer) As Integer

Dim iMax As Integer
iMax = -32768

Forall num In NumList
If(num > iMax) Then iMax = num
End Forall
Max = iMax

End Function

' ********** MIN **********
Function Min(numList List As Integer) As Integer

Dim iMin As Integer
iMin = 32767

Forall num In NumList
If(num > iMin) Then iMin = num
End Forall
Min = iMin

End Function

LotusScript code to embed a picture into a Notes richtext item

Follows a simple LotusScript function that will embed a file system picture (strFilePath As String) into the Body RichText field of a Notes document (doc As NotesDocument). This will not embed as an icon, but as the image itself.
Function EmbedPictureIntoRichText(doc As NotesDocument, strFilePath As String) As Boolean

EmbedPictureIntoRichText = False

Dim session As New NotesSession
Dim db As NotesDatabase
Dim body As NotesMIMEEntity
Dim header As NotesMIMEHeader
Dim child As NotesMIMEEntity
Dim stream As NotesStream
Dim fileFormat As String
Dim rtitemA As NotesRichTextItem
Dim rtitemB As NotesRichTextItem

Set db = doc.Parentdatabase
Set stream = session.CreateStream
Call stream.Open(strFilePath)
Set body = doc.CreateMIMEEntity("DummyRichText")
Set header = body.CreateHeader("Content-Type")
Call header.SetHeaderVal("multipart/mixed")
Set child = body.CreateChildEntity() 'Set childEntity = richTextItemObj.CreateChildEntity()
fileFormat = "image/jpeg" 'Other formats are "image/gif" "image/bmp"
Call child.Setcontentfrombytes(stream, fileFormat, 1730)
Call stream.Close()
Call doc.save(false, false) 'JUST TO REFRESH

Set rtitemA = doc.GetFirstItem("Body")
Set rtitemB = doc.GetFirstItem("DummyRichText")
Call rtitemA.AppendRTItem( rtitemB )
Call rtitemB.Remove()
Call doc.save(False, False)

EmbedPictureIntoRichText = True

End Function

Classe XML

REF http://www.vbweb.com.br/dicas_visual.asp?Codigo=2256

.. classe para trabalhar com XML, espero q ajude. Na verdade, a classe serve mais para criar XML, sem ter q ficar dando um monte de comandos...

Class ClsXML
     Public Root
     Public XML
   
     Private PIs
   
     Sub NewXML(TagPai, versao)
       Set XML = CreateObject ("Msxml2.DOMDocument" & Versao)
       XML.Async = False
       Set Root = XML.CreateElement(TagPai)
       XML.AppendChild(Root)
     
       Set PIs = XML.CreateProcessingInstruction("xml", "version='1.0' encoding='ISO-8859-1'")
       XML.InsertBefore PIs, Root
     End Sub

     Function Open(Path, versao)
          Dim Result
       Set XML = CreateObject ("Msxml2.DOMDocument" & Versao)
       XML.Async = False
         
          Result = XML.Load(Path)
          if Result = true then
               Set Root = XML.DocumentElement
          end if
          Open = Result
     End Function

     Function CriaNodo(TagPai, Nome, Atributos, ValorAtributos,ValorNodo)
       Dim Nodo
       Dim Valor
       Set Nodo = XML.CreateElement(Nome)
       If TagPai Is Nothing Then
         XML.AppendChild(Nodo)
       Else
         TagPai.AppendChild(Nodo)
       End If
     
       If Isarray(Atributos)  And Isarray(ValorAtributos) Then
         NumAtributos = Ubound(Atributos)
         For i = 0 To NumAtributos
           Call Nodo.setAttribute(Atributos(i), ValorAtributos(i))
         Next
       End If
       If ValorNodo <> "" Then
         Set Valor = XML.CreateTextNode(ValorNodo)
         Nodo.AppendChild(Valor)
       End If
       Set CriaNodo = Nodo
       Set Nodo = Nothing
       Set Valor = Nothing
     End Function

     Function RemoveNodo(Expressao)
          Dim Nodo
         
          Set Nodo = Xml.GetElementsByTagName(Expressao)
          if not Nodo is nothing then
               Call Nodo.RemoveAll
               RemoveNodo = true
          else
               RemoveNodo = false
          end if
     End Function

     Sub Save (Caminho)
       Call XML.Save(Caminho)
     End Sub

End Class

Usando a Classe para criar um XML com a seguinte estrutura:


 
     Rodrigo
     Lotus Notes
 


Dim NomeAtributos(), ValorAtributos()
Set objXML = New ClsXML()

'O primeiro parâmetro é a Tag pai de todas, o segundo é a versão do MSXML q você quer usar
Call NewXML("teste", "")
Redim NomeAtributos(0), ValorAtributos(0)
NomeAtributos(0) = "nome"
ValorAtributos(0) = "Teste"
Set Tag1 = objXML.CriaNodo(objXML.root, "tag1", NomeAtributos, ValorAtributos, "")
Call objXML.CriaNodo(Tag1, "nome1", "", "", "Rodrigo")
Call objXML.CriaNodo(Tag1, "ferramenta", "", "", "Lotus Notes")

Call objXML.Save("teste")