DominoArea.org [Archive]

[syntax="ls"]Private Const APIModule = "NNOTES"

' Writes out a field to a file in CD format.
Declare Function MailGetMessageBodyComposite Lib APIModule Alias "MailGetMessageBodyComposite" ( Byval hNT As Long, Byval N As String, Byval D As String, nD As Long) As Integer
Declare Function ExportRTF Lib "nxrtf" Alias "ExportRTF" (Byval sTempFile As String, Byval flags As Long, hmod As Long, Byval altlibrary As String, Byval sRTFFile As String) As Integer

' Gets the directory used for temporary files.
Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(Byval nBufferLength As Long, Byval lpBuffer As String) As Long

' Creates a temporary file name.
Declare Function GetTempFileName Lib "kernel32" Alias _
"GetTempFileNameA" (Byval lpszPath As String, Byval lpPrefixString As _
String, Byval wUnique As Long, Byval lpTempFileName As String) As Long

Private Const TMP_PREFIX = "~"
Private Const TMP_FIELD = "tmp"

' Error thrown if you try to export a Notes object other than
' NotesItem or NotesDocument.
Public Const INVALID_TYPE_ERR = 1001

' Class for exporting fields or documents to file. For instance, you can use
' it to export a Notes document to an RTF file.
'
' Example:
' Dim session As New NotesSession
' Dim db As NotesDatabase
' Dim dc As NotesDocumentCollection
' Set db = session.Currentdatabase
' Set dc = db.Unprocesseddocuments
' Dim doc As notesdocument
' Set doc = dc.GetFirstDocument
'
' Dim item_exporter As New Exporter(doc.GetFirstItem("Body"))
' item_exporter.RTF "c:\tmp\export_item_test.rtf"
'
' Dim doc_exporter As New Exporter(doc)
' doc_exporter.RTF "c:\tmp\export_doc_test.rtf"
'
Public Class Exporter
Private Document As NotesDocument
Private FieldName As String

' The constructor takes a NotesItem or a NotesDocument object.
Public Sub New(item As Variant)
If item Isa "NotesItem" Then
Set Me.Document = item.Parent
Me.FieldName = item.Name
Else
If item Isa "NotesDocument" Then

Dim tmp_doc As NotesDocument
Set tmp_doc = item.ParentDatabase.CreateDocument
Set Me.Document = tmp_doc

Dim tmp_fld As New NotesRichTextItem(tmp_doc, TMP_FIELD)
Dim success As Integer
success = item.RenderToRTItem(tmp_fld)

Me.FieldName = TMP_FIELD
Else
Error INVALID_TYPE_ERR, "Not a valid object type"
End If
End If
End Sub

' Exports to common data format.
Private Sub CD(FileName As String)
Dim file_size As Long

Dim contents_file As String
contents_file = TempFile(TMP_PREFIX)
Call MailGetMessageBodyComposite(Document.handle , FieldName, contents_file, file_size)

Dim fonts_file As String
fonts_file = TempFile(TMP_PREFIX)
Call MailGetMessageBodyComposite(Document.handle , "$Fonts", fonts_file, file_size)

Call Concatenate (contents_file, fonts_file, FileName)

Kill contents_file
Kill fonts_file
End Sub

' Exports to Rich text format.
Public Sub RTF(FileName As String)
Dim cd_file As String
cd_file = TempFile(TMP_PREFIX)

CD cd_file
Call ExportRTF(cd_file, 0, 0, "", FileName)

Kill cd_file
End Sub

' Takes two CD record format files and adds them into one file using binary file access
' First two bytes (one word) of file is control character so this is stripped from second file
' there is always an even number of bytes in CD-records so we can use Integer to transfer
' the data. (Function copied from notes.net.)
Private Sub Concatenate(fileIn1 As String, fileIn2 As String, fileOut1 As String)

Dim twobytes As Integer
Dim filein As Integer
Dim fileout As Integer

fileout = Freefile
Open fileOut1 For Binary As #fileout

filein = Freefile
Open fileIn1 For Binary As #filein
Do Until Eof (filein)
Get #filein,,twobytes
Put #fileout,, twobytes
Loop
Close #filein

Open fileIn2 For Binary As #filein
Seek #filein, 3
Do Until Eof (filein)
Get #filein,,twobytes
Put #fileout,, twobytes
Loop
Close
End Sub

' Returns a random file name that is not already in use.
Private Function TempFile(prefix As String)
Dim temp_dir As String
Dim path_len As Long
temp_dir = Space(255)
path_len = GetTempPath(255, temp_dir)
temp_dir = Left$(temp_dir, path_len)

Dim temp_file As String
temp_file = Space(255)
Dim file_len As Long
file_len = GetTempFileName(temp_dir, prefix, 0&, temp_file)
file_len = Instr(temp_file, Chr$(0))
If file_len > 1 Then
temp_file = Left$(temp_file, file_len - 1)
End If

TempFile = temp_file
End Function
End Class[/syntax]