Extracting inline images from RTF to disk (as jpg,gif,bmp)

[Domino Deviant]

Hi,

I need to extract inline images from RTF (not attachments but pasted
in inline images) to disk (as jpg,gif,bmp).
The approach I have tried is export via DXL. However there is a
limitation to only export Gifs :(

Have anyone managed to export also other types of images?

Thanks in advace,

Darko Aleksic

[timg]

Thanks for your help earlier, Darko. Here is what I found.

If the image was originally a GIF when it was pasted into the field,
then it was tagged in the XML as a GIF, but if it was originally a
JPEG, then it was tagged as a JPEG. In other words, I was not
converting the file type - just simply extracting it in the format in
which is was put in.

So I ended up with the following code (not elegant, but does the job):

Const EXT_GIF_ = ".gif"
Const EXT_JPEG_ = ".jpg"
Const EXT_TEMP_ = ".tmp"
Const EXT_TEXT_ = ".txt"

Const FIELD1_ = "<item name='Photo'"
Const FIELD2_ = "</item"
Const GIF1_ = "<gif"
Const GIF2_ = "</gif"
Const JPEG1_ = "<jpeg"
Const JPEG2_ = "</jpeg"

Set exporter = session.CreateDXLExporter
exporter.ConvertNotesBitmapsToGIF = True

' get the document containing the photo here...

cRecordData = exporter.Export(doc)
cFieldData = ""
cPictureData = ""

lPos1 = Instr(1, cRecordData, FIELD1_, 5)
If lPos1 > 0 Then ' we've found the field
' move lPos1 to just after tag
lPos2 = Instr(lPos1, cRecordData, ">", 5)
If lPos2 = 0 Then Error 1001, "Close tag not found" ' weird
error
lPos1 = lPos2 + 1

lPos2 = Instr(lPos1, cRecordData, FIELD2_, 5)
cFieldData = Mid$(cRecordData, lPos1, lPos2 - lPos1)

lPos1 = Instr(1, cFieldData, JPEG1_, 5)
If lPos1 = 0 Then ' didn't find jpeg, now try for gif
lPos1 = Instr(1, cFieldData, GIF1_, 5)
If lPos1 > 0 Then ' found gif
' move lPos1 to just after tag
lPos2 = Instr(lPos1, cFieldData, ">", 5)
If lPos2 = 0 Then Error 1001, "Close tag not found" ' weird
error
lPos1 = lPos2 + 1

lPos2 = Instr(lPos1, cFieldData, GIF2_, 5)
cPictureData = Mid$(cFieldData, lPos1, lPos2 - lPos1)
cExt = EXT_GIF_
Else ' dunno... another format?
' error trapping code ...
' I guess other file formats would show up here
End If

Else ' jpeg
' move lPos1 to just after tag
lPos2 = Instr(lPos1, cFieldData, ">", 5)
If lPos2 = 0 Then Error 1001, "Close tag not found" ' weird
error
lPos1 = lPos2 + 1

lPos2 = Instr(lPos1, cFieldData, JPEG2_, 5)
cPictureData = Mid$(cFieldData, lPos1, lPos2 - lPos1)
cExt = EXT_JPEG_
End If

If cPictureData <> "" Then ' if blank then there must have been
an error in the encoding
' write to a temp file
iFileNum = Freefile
Open cPathFile & EXT_TEMP_ For Output As iFileNum
Print #iFileNum, cPictureData
Close iFileNum

' encode
If Not b64.decodeFileToFile (cPathFile & EXT_TEMP_, cPathFile &
cExt) Then
' export the XML field to a txt file for debugging later
lCountError = lCountError + 1
iFileNum = Freefile
Open cPathFile & EXT_TEXT_ For Output As iFileNum
Print #iFileNum, cFieldData
Close iFileNum
End If

Kill cPathFile & EXT_TEMP_ ' remove the temp file

The other thing that you will see that I am using is the libBase64
from Martin Wendt (http://wwWendt.de/tech/base64)

Much, much faster (about 250 times faster by my calculations) than the
other methods floating around on the web for base 64 decoding.

Note - I could have used Notes Streams and avoided the temp file, but
I'm not familiar with them, and I needed a quick solution - didn't
have time to muck around figuring out how to use them. Ah well...

Hope this helps,
Tim