Converting Rich Text to HTML ( With Images )

I’ve just posted Beta 3 of BlogSphere over on http://www.blogSphere.net. One of the new features that this beta contains is RichText to HTML conversion. This allows posters to post using RichText and when saved the Richtext field is converted into HTML. Converting a simple RichText field is fairly easy however when you have to deal with images it gets a little trickier…

Posted below is the code that I used to do the conversion. It’s not 100% perfect and doesn’t yet account for everything but it works good enough to release…

sub PostSave(source as NotesUIDocument)
dim s as NotesSession
Dim doc as NotesDocument
Dim item As NotesItem
Dim mime As NotesMimeEntity
Dim Permalink As String

set s = NEW NotesSession
s.ConvertMime=False
set doc = source.document
Set item = doc.GetFirstItem("RichTextField")

'Extract The HTML Code From the Rich Text Field

Set mime = item.GetMimeEntity
Set child = mime.GetFirstChildEntity
If child Is Nothing Then
'This is a Single Part Mime Entry
	strHTML = mime.ContentAsText
Else
'This is a Multi Part Mime Entry
	While Not(child Is Nothing)
		If child.ContentSubType="html" Then
			strHTML = strHTML + child.ContentAsText
		End If
		Set child = child.GetNextSibling
	Wend
End If

' replace <img src=CID: with ?OpenElement

count =2   ' Element count starts at 2


permalink = doc.PermaLink(0)

'need a loop to catch all IMG tags
startcheck:
  x = Instr(1,strHTML,"<img src=cid:")
  If x = 0 Then Goto savedoc
  y = Instr(x,strHTML,">")
  NewImg = {<img src="./plinks/}+PermaLink+{/StoryRichText/M}+count+_
{?OpenElement">}
  strHTML = Left(strHTML,x-1) + NewImg + Right(strHTML,Len(strHTML)-(y))
  count = count +1
  Goto startcheck
savedoc:
doc.StoryText = strHTML
Call doc.Save(True,True)

End Sub

Thanks to Julian Robichaux for the LotusScript to HTML converter