- Encode : 入力ストリームのバイナリをBase64にエンコードし、出力ストリームに書き出す
- Decode : 入力ストリームのBase64テキストを、バイナリストリームとして出力する
Notes/Domino 9.0.1 over
Sub Initialize
Dim session As New NotesSession
Dim fileIn As NotesStream
Set fileIn = session.Createstream()
'---
'エンコードしたいデータ(バイナリファイルでも可)
'Call fileIn.Open("doclink.gif", "binary")
'---
Call fileIn.Open(Timer() & ".txt", "UTF-8")
Call fileIn.Writetext("a", EOL_NONE)
fileIn.Position = 0
'Base64へエンコード
Dim base64 As New CBase64
If Not base64.Encode(fileIn) = 0 Then
Error Err, Error
End If
'ファイルへエクスポート
Dim fileOut As NotesStream
Set fileOut = session.Createstream()
Call fileOut.Open(Timer() & ".txt", "ASCII")
If Not base64.Export(Fileout) = 0 Then
Error Err, Error
End If
Call fileOut.Close()
'以下はデバッグ用
Dim base64String As String
base64String = base64.ToString()
Print Now ":" base64String '->YQ==
End SubSub Initialize
Dim ss As New NotesSession
Dim stream As NotesStream
'デコードしたいBase64テキスト
Set stream = ss.Createstream()
Call stream.open(Timer() & ".txt", "ASCII")
Call stream.Writetext("YQ==", EOL_NONE) 'YQ== -> a
'デコード
Dim base64 As New CBase64
If Not base64.Decode(stream) = 0 Then
Error Err, Error
End If
'エクスポート
Set stream = ss.Createstream()
Call stream.open(Timer() & ".txt", "UTF-8")
If not base64.Export(stream) = 0 Then
Error Err, Error
End If
Call stream.close()
'以下はデバッグ用
Dim base64String As String
base64String = base64.ToString()
Print Now ":" & base64String ' empty
End SubClass CBase64
Sub New()
Me.zBufferLlength = 255
'--
Me.zLineLength = 0
Me.zEOL = EOL_NONE
Me.zPadding = "="
End Sub
Sub Delete()
If Not Me.zFileOut Is Nothing Then
Call Me.zFileOut.Truncate()
Call Me.zFileOut.Close()
End If
End Sub
'@param {Long} LineLength
' (default) 0
' exp. 76
Property Set LineLength As Long
Me.zLineLength = LineLength
If Not Me.zLineLength = 0 Then
If Me.zEOL = EOL_NONE Then
Me.zEOL = EOL_CRLF
End If
Else
Me.zEOL = EOL_NONE
End If
End Property
'@see https://help.hcltechsw.com/dom_designer/9.0.1/appdev/H_WRITETEXT_METHOD_STREAM.html
'@param {Long} EOL
' (default) EOL_NONE
' exp. EOL_CR_LF
Property Set EOL As Long
Me.zEOL = EOL
If Not Me.zEOL = EOL_NONE Then
Me.zLineLength = 76
Else
Me.zLineLength = 0
End If
End Property
'@param {String} Padding
' (default) =
Property Set Padding As String
Me.zPadding = Padding
End Property
'Returns the stored data as text.
'@return {String}
' Encoded or decoded binary data.
' The result of encoding is stored as ASCII code,
' but the result of decoding is stored as binary data,
' so it may not meet your expectations.
Function ToString() As String
Me.zFileOut.Position = 0
ToString = Me.zFileOut.Readtext
End Function
'Exporting retained data.
'If you want to export text,
'you need to specify the character encoding for the Stream.
'@param {NotesStream} fileOut
' stream to write the encoded or decoded binary data to.
'@return {Integer}
' If there is an error, the error number.
Function Export(fileOut As NotesStream) As Integer
On Error GoTo ErrorHandle
If Me.zFileOut Is Nothing Then
Exit Function
End If
Me.zFileOut.Position = 0
Do Until Me.zFileOut.Iseos = True
Call fileOut.Write(Me.zFileOut.Read(Me.zBufferLlength))
Loop
Exit Function
ErrorHandle:
Export = Err
Exit Function
End Function
' Text or Binary -> Base64
'@see https://tex2e.github.io/rfc-translater/html/rfc4648.html
'@param {NotesStream} fileIn
' Data stream to encode. text or binary.
'@return {Integer}
' If there is an error, the error number.
Function Encode(fileIn As NotesStream) As Integer
On Error GoTo ErrorHandle
Dim ss As New NotesSession
Dim base64 As NotesStream
Set base64 = ss.Createstream()
Call base64.Open(Timer() & ".base64", "ASCII")
Dim bit6 As String
Dim charCount As Long
fileIn.Position = 0
Do Until fileIn.Iseos = True
Dim chunk As Variant
chunk = fileIn.Read(Me.zBufferLlength)
ForAll c In chunk
Dim piese As Byte
piese = c
'byte -> bit8
Dim bit8 As String
If Not Me.zByteToBit(piese, bit8) = 0 Then
Error Err, Error
End If
'bit8 -> bit6
Dim p As Byte
Dim char As String
For p = 1 To 8
bit6 = bit6 & Mid(bit8, p, 1)
'Process until 6 bits are complete
If Len(bit6) = 6 Then
'bit6 -> char
If Not Me.zBit6ToChar(bit6, char) = 0 Then
Error Err, Error
End If
'add stream
Call base64.Writetext(char, EOL_NONE)
charCount = charCount + 1
If charCount = Me.zLineLength Then
Call base64.Writetext("", Me.zEOL)
charCount = 0
End If
'Clear after processing
bit6 = ""
End If
Next
End ForAll
Loop
'Not cleared
If Not bit6 = "" Then
'Less than 6 bits
If Len(bit6) < 6 Then
bit6 = bit6 & String(6-Len(bit6), "0")
End If
'bit -> char
If Not Me.zBit6ToChar(bit6, char) = 0 Then
Error Err, Error
End If
'add stream
Call base64.Writetext(char, EOL_NONE)
charCount = charCount + 1
If charCount = Me.zLineLength Then
Call base64.Writetext("", Me.zEOL)
charCount = 0
End If
'Clear after processing
bit6 = ""
End If
'The output string is less than four characters long
If Not Me.zPadding = "" Then
Do Until (base64.Bytes) Mod 4 = 0
'Fill with "="
Call base64.Writetext(Me.zPadding, EOL_NONE)
charCount = charCount + 1
If charCount = Me.zLineLength Then
Call base64.Writetext("", Me.zEOL)
charCount = 0
End If
Loop
End If
base64.Position = 0
Set Me.zFileOut = base64
Exit Function
ErrorHandle:
Encode = Err
Exit Function
End Function
'Base64 -> Binary
'@param {NotesStream} base64
' A base64 encoded text stream.
'@return {Integer}
' If there is an error, the error number.
Function Decode(base64 As NotesStream) As Integer
On Error GoTo ErrorHandle
Dim ss As New NotesSession
Dim stream As NotesStream
Dim base64Char As String
base64Char = Me.zBase64Char
'All processed as binary data
Set stream = ss.Createstream()
Call stream.Open(Timer() & ".tmp", "binary")
base64.Position = 0
Do Until base64.Iseos = True
Dim buffer As String
buffer = base64.Readtext
Do Until buffer = ""
'buffer -> char
Dim char As String
char = Mid(buffer, 1, 1)
buffer = Mid(buffer, 2)
'char -> byte
Dim p As Byte
p = InStr(1, base64Char, char, 0)
If p = 0 Then
GoTo NextChar
End If
'byte -> bit8
Dim bit6 As String
If Not Me.zByteToBit(p-1, bit6) = 0 Then
Error Err, Error
End If
'bit8 -> bit6
bit6 = Right(bit6, 6)
Dim bit8 As String
For p = 1 To Len(bit6)
bit8 = bit8 & Mid(bit6, p, 1)
If Len(bit8) = 8 Then
Dim chunk(0) As Byte
chunk(0) = CByte("&B" & bit8)
Call stream.Write(chunk)
bit8 = ""
End If
Next
NextChar:
Loop
Loop
Set Me.zFileOut = stream
Exit Function
ErrorHandle:
Decode = Err
Exit Function
End Function
' private ---
Private zFileOut As NotesStream
Private zBufferLlength As Long
Private zLineLength As Long
Private zEOL As Long
Private zPadding As String
Private Property Get zBase64Char As String
zBase64Char = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
End Property
Private Function zByteToBit(piese As Byte, bit As String) As Integer
On Error GoTo ErrorHandle
'byte -> bit
bit = Bin$(piese)
' If it is less than 8 bits, adjust it to fit
bit = Right("00000000" & bit, 8)
Exit Function
ErrorHandle:
zByteToBit = Err
Exit Function
End Function
Private Function zBit6ToChar(bit6 As String, char As String) As Integer
On Error GoTo ErrorHandle
'bit -> byte
Dim pos As Byte
pos = CByte("&B" & bit6) + 1
'byte -> char
char = Mid(Me.zBase64Char, pos, 1)
Exit Function
ErrorHandle:
zBit6ToChar = Err
Exit Function
End Function
End Class