'Export MIME: 

Option Public
Option Explicit

%REM
The "Export MIME" agent will export the contents of a currently selected 
e-mail document to a text file in MIME format. This text file should normally 
be valid EML file format, if you need that sort of thing. 

In Notes version 8.5.1 and later, there is a convertToMIME() method that can 
be used to convert the rich-text contents of a native Notes e-mail to MIME so 
that the export will work for Notes mail messages as well as Internet mail 
messages. If you are using a version of the Notes client prior to 8.5.1, this 
agent will only work with Internet e-mails and you will need to comment out 
the convertToMIME() code in the GetMime() function.

version 1.0
May 29, 2012
Copyright (c) 2012 Julian Robichaux 

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
%END REM


Sub Initialize
	Dim session As New NotesSession
	Dim db As NotesDatabase
	Dim dc As NotesDocumentCollection
	Dim doc As NotesDocument
	
	session.ConvertMime = False
	Set db = session.CurrentDatabase
	Set dc = db.UnprocessedDocuments
	Set doc = dc.GetFirstDocument
	If (doc Is Nothing) Then
		Messagebox "Please select a document first"
		Exit Sub
	End If
	
	Dim workspace As New NotesUIWorkspace
	Dim fileName As Variant
	'** we default to .txt, but this should create a valid .eml file too
	fileName = workspace.SaveFileDialog(False, "Export File Name:", , "", "MimeExport.txt")
	If Isempty(fileName) Then
		Exit Sub
	End If
	
	Dim stream As NotesStream
	Set stream = session.CreateStream()
	'** Notes often gives invalid character set errors if I don't explicitly use UTF-8 here, 
	'** and my client sometimes hangs if I explicitly use UTF-16
	Call stream.Open( fileName(0), "UTF-8" )
	Call stream.Truncate
	Call GetMime(doc, stream)
	Call stream.Close()
	
	Messagebox "Mime Exported to " & fileName(0)
End Sub


Function GetMime (doc As NotesDocument, stream As NotesStream) As Integer
	Dim mime As NotesMimeEntity
	Dim child As NotesMimeEntity
	
	Set mime = doc.GetMIMEEntity
	
	'** 8.5.1 introduced the convertToMIME() function
	'** REMOVE this if/then block if you're on less than 8.5.1
	If (mime Is Nothing) Then
		Call doc.ConvertToMIME(2)
		Set mime = doc.GetMIMEEntity
	End If
	
	If Not (mime Is Nothing) Then
		Call PrintMime(mime, stream)
		GetMime = True
	Else
		Call stream.WriteText( "No MIME Found in " & doc.Subject(0), EOL_PLATFORM )
	End If
End Function


Function PrintMime (mime As NotesMimeEntity, stream As NotesStream) As Integer
	If (mime Is Nothing) Then
		Exit Function
	End If
	
	If (mime.Encoding = ENC_IDENTITY_BINARY) Then
		Call mime.DecodeContent
		Call mime.EncodeContent(ENC_BASE64)
	End If
	Call mime.GetEntityAsText(stream)
	
	Dim child As NotesMimeEntity
	If mime.ContentType = "multipart" Then
		If (mime.Preamble <> "") Then
			Call stream.WriteText( mime.Preamble, EOL_NONE )
		End If
		
		Set child = mime.GetFirstChildEntity
		While Not(child Is Nothing)
			Call WriteAsciiBytes(stream, child.BoundaryStart)
			Call PrintMime( child, stream )
			Call WriteAsciiBytes(stream, child.BoundaryEnd)
			Set child = child.GetNextSibling
		Wend
	End If
	
	PrintMime = True
End Function


Function WriteAsciiBytes (stream As NotesStream, txt As String)
	'** hackish workaround to write the boundary string to a UTF-8 
	'** NotesStream (convert it to an array of ASCII Bytes). It might be 
	'** something about the character set of the boundary string, but I 
	'** really don't know. All I DO know is that using WriteText to 
	'** write the string directly to a UTF-8 stream doesn't work properly 
	'** for me, at least some of the time.
	If (Len(txt) = 0) Then
		Exit Function
	End If
	
	Redim arr( Len(txt)-1 ) As Byte
	Dim i As Integer
	For i = 1 To Len(txt)
		arr( i-1 ) = Cbyte(Asc( Mid(txt, i, 1) ))
	Next
	
	Call stream.Write(arr)
End Function