'libBase64: 

%REM
	libBase64 v1.1

	Standard Base64 implementation optimized for the Lotus Notes environment.
	(--> http://tools.ietf.org/html/rfc4648 )

	This code may be used freely, as long as
	  - you accept, that NO WARRANTY is given:
	    use it a your own risk OR DON'T USE IT AT ALL
	  - this comment header is left intact

	Let me know, if you find bugs or improvements.

	A current version and some documentation should be available at
	http://wwWendt.de/tech/base64

	Martin Wendt (martin@wwWendt.de)

	[2007-05-22 mw]: v1.0
	- Created this file
	[2009-10-09 mw]: v1.1
	- Specify UTF-8 as the characterset when decoding to make the  library 
	  compatible with non-ascii letters. 
      Patch by jonathan.parish (at) pillsburylaw.com
    
	--------------------------------------------------------------------------------

Usage:
	Dim b64 As New CBase64()
	Print b64.encodeString ("test")
	Call b64.decodeFileToFile (fspecInput, fspecOutput)
%END REM

Option Public
Option Declare

'Use "libDebug" ' debugging and timings only !!

Class CBase64
	' version = 1.0
	
	' Set bMimeModeEncoding to False, if the encoding result should NOT contain 
	' line feeds at column 76
	' This is SLOWER, beacuse the LF is removed in a seperate scan afterwards
	' (default is bMimeModeEncoding=True)
	Public bMimeModeEncoding As Boolean
	
	Sub New()
		bMimeModeEncoding = True
	End Sub
	
	Sub Delete()
	End Sub
	
	
	Function encode (nsIn As NotesStream) As String
		Dim dwStart As Long
'		dwStart = timerStart()
		
		Dim session As New NotesSession
		Dim docTemp As NotesDocument
		Dim body As NotesMimeEntity
		
		Set docTemp = session.CurrentDatabase.CreateDocument
		Set body    = docTemp.CreateMIMEEntity
		
		session.ConvertMIME = False
		Call body.SetContentFromBytes (nsIn, "", ENC_NONE)
		Call body.EncodeContent (ENC_BASE64)
		
		encode = body.ContentAsText
		
		If Not bMimeModeEncoding Then
			Call Me.removeWhitespace (encode)
		End If
'		Print timerElapRateString (dwStart, "encodeToString", .001*nsIn.Bytes, "kBytes")
	End Function
	
	
	Function encodeString (strIn As String) As String
		Dim session As New NotesSession
		Dim nsIn As NotesStream
		Set nsIn = session.CreateStream
		Call nsIn.WriteText (strIn)
		encodeString = encode (nsIn)
		Call nsIn.Close
	End Function
	
	
	Function encodeFile (Byval fspecIn As String) As String
		Dim session As New NotesSession
		Dim nsIn As NotesStream
		Set nsIn  = session.CreateStream
		Call nsIn.Open (fspecIn, "binary")
		encodeFile = Me.encode (nsIn)
		Call nsIn.Close()
	End Function
	
	
	Function encodeFileToFile (Byval fspecIn As String, Byval fspecOut As String) As Boolean
		Dim session As New NotesSession
		Dim nsIn As NotesStream, nsOut As NotesStream
		
		Set nsIn  = session.CreateStream
		Call nsIn.Open (fspecIn, "binary")
		
		Set nsOut  = session.CreateStream
		Call nsOut.Open (fspecOut)
		Call nsOut.Truncate
		
		Call nsOut.WriteText ( Me.encode(nsIn) )
		
		Call nsIn.Close()
		Call nsOut.Close()
		
		encodeFileToFile = True
	End Function
	
	
	Function decode (nsIn As NotesStream) As NotesStream
		Dim dwStart As Long
'		dwStart = timerStart()
		
		Dim session As New NotesSession
		Dim docTemp As NotesDocument
		Dim body As NotesMimeEntity
		Dim nsOut As NotesStream
		
		Set docTemp = session.CurrentDatabase.CreateDocument
		Set body    = docTemp.CreateMIMEEntity
		Set nsOut   = session.CreateStream
		
		session.ConvertMIME = False
'		Call body.SetContentFromText (nsIn, "", ENC_BASE64)
		Call body.SetContentFromText (nsIn, "text/plain;charset=UTF-8", ENC_BASE64)
		
		Call body.GetContentAsBytes (nsOut, True)
		
		nsOut.Position = 0 ' rewind for later nsOut.Read access
		
		Set decode = nsOut
		
'		Print timerElapRateString (dwStart, "decode", .001*nsIn.Bytes, "kBytes")
	End Function
	
	
	Function decodeString (strIn As String) As NotesStream
		Dim session As New NotesSession
		
		Dim nsIn As NotesStream
		Set nsIn = session.CreateStream
		Call nsIn.WriteText (strIn)
		
		Set decodeString = Me.decode (nsIn)
		Call nsIn.Close()
	End Function
	
	
	Function decodeStringToString (strIn As String) As String
		' NOTE: use this function only, if you are shure that 
		'       the encoded content is not binary.
%REM
		This version:
	>>
		decodeStringToString = Me.decodeString (strIn).ReadText()
	<<
		had strange results:
		Passing an encoded ascii string like "SMOk[...]4NCg=="
		returns something like "||||||||||||||"
		This is propably because the ascii result is interpreted as Unicode

		The following version returns "H|ātten H|ūte ein ..."
		Which is propably because the ascii result is interpreted as utf-8
%END REM
		Dim session As New NotesSession
		Dim docTemp As NotesDocument
		Dim body As NotesMimeEntity
		
		Set docTemp = session.CurrentDatabase.CreateDocument
		Set body    = docTemp.CreateMIMEEntity
		
		Dim nsIn As NotesStream
		Set nsIn = session.CreateStream
		Call nsIn.WriteText (strIn)
		
		session.ConvertMIME = False
'		Call body.SetContentFromText (nsIn, "", ENC_BASE64)
		Call body.SetContentFromText (nsIn, "text/plain;charset=UTF-8", ENC_BASE64)
		
		body.DecodeContent
		decodeStringToString = body.ContentAsText
	End Function
	
	
	Function decodeFile (Byval fspecIn As String) As NotesStream
		Dim session As New NotesSession
		
		Dim nsIn As NotesStream
		Set nsIn = session.CreateStream
		Call nsIn.Open (fspecIn)
		
		Set decodefile = Me.decode (nsIn)
		Call nsIn.Close()
	End Function
	
	
	Function decodeFileToFile (Byval fspecIn As String, Byval fspecOut As String) As Boolean
		Dim session As New NotesSession
		Dim nsIn As NotesStream, nsOut As NotesStream, nsTemp As NotesStream
		
		Set nsIn  = session.CreateStream
		Call nsIn.Open (fspecIn)
		
		Set nsTemp = Me.decode (nsIn)
		
		Call nsIn.Close()
		
		Set nsOut  = session.CreateStream
		Call nsOut.Open (fspecOut)
		Call nsOut.Truncate
		
		Dim buffer As Variant
		Do
			buffer = nsTemp.Read (32767)
			Call nsOut.Write(buffer)
		Loop Until nsTemp.IsEOS
		
		Call nsTemp.Close()
		Call nsOut.Close()
		
		decodeFileTofile =  True
	End Function
	
	
	Function isValidBase64 (s As String) As Boolean
		' Credits to Mats Hasselquist
		Const ENC_BASE64_CHARS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
		isValidBase64 = False
		
		If Len(s) Mod 4 > 0 Then Exit Function
		If s Like "*[!" & ENC_BASE64_CHARS & "=]*" Then Exit Function
		
		Select Case Instr(s, "=")
		Case 1 To Len(s) - 2 : Exit Function
		Case Len(s) - 1 : If Right(s, 1) <> "=" Then Exit Function
		End Select
		
		isValidBase64=True
	End Function
	
	
	Sub removeWhitespace (s As String)
		' Remove CR, LF, tab and space
		Dim aFind(3) As String
		aFind(0) = Chr(13)
		aFind(1) = Chr(10)
		aFind(2) = Chr(9)
		aFind(3) = " "
		s = Replace (s, aFind, "")
	End Sub
End Class

Private Function base64Test0 (strTest As String, strB64 As String, bDump As Boolean) As Boolean
	Dim res As String, msg As String, bError As Boolean
	
	Dim b64 As New CBase64()
	b64.bMimeModeEncoding = False ' don't want whitespace in the result
	
	' test encode
	res = b64.encodeString (strTest)
	msg = "Base64('" & strTest & "') = '" & res & "'"
	If Strcompare(res,strB64,0)=0 Then
		msg = msg & " [ok]"
	Else
		msg = msg & " --> ERROR! Should be '" & strB64 & "'"
		bError = True
	End If
	If bDump Then Print msg
	
	' test decode
	res = b64.decodeStringToString (strB64)
	msg = "DecodeBase64('" & strB64 & "') = '" & res & "'"
	If Strcompare(res,strTest,0)=0 Then
		msg = msg & " [ok]"
	Else
		msg = msg & " --> ERROR! should be '" & strTest & "'"
		bError = True
	End If
	If bDump Then Print msg
	
	base64Test0 = Not bError
End Function

Function base64Test (bDump As Boolean) As Boolean
	Dim bRes As Boolean
	bRes = True
	
	' NOTE: these tests will FAIL, because we are 
	' passing Unicode, and the given encodings were calculated from Ascii !
	
	
	' Base64 test suite (http://tools.ietf.org/html/rfc4648)
	bRes = bRes And base64Test0 ("", "", bDump)
	bRes = bRes And base64Test0 ("f", "Zg==", bDump)
	bRes = bRes And base64Test0 ("fo", "Zm8=", bDump)
	bRes = bRes And base64Test0 ("foo", "Zm9v", bDump)
	bRes = bRes And base64Test0 ("foob", "Zm9vYg==", bDump)
	bRes = bRes And base64Test0 ("fooba", "Zm9vYmE=", bDump)
	bRes = bRes And base64Test0 ("foobar", "Zm9vYmFy", bDump)
	
	' sample string from Wikipedia
	' again, this will FAIL, because it was encode from Ascii
	Dim b64 As New CBase64()
	Print b64.decodeStringToString ("SMOkdHRlbiBIw7x0ZSBlaW4gw58gaW0gTmFtZW4sIHfDpHJlbiBzaWUgbcO2Z2xpY2hlcndlaXNlIGtlaW5lIEjDvHRlIG1laHIsDQpzb25kZXJuIEjDvMOfZS4NCg==")
	
	base64Test = bRes
	If bRes Then
		Print "Test Passed!"
	Else
		Print "Test FAILED!"
	End If
End Function