Sub Encode()
Sheets("Encode").Select
Cells.Range("B4").Value = Base64Encode(Cells.Range("B2").Value)
End Sub
Sub Decode()
Sheets("Decode").Select
Cells.Range("B4").Value = Base64Decode(Cells.Range("B2").Value)
End Sub
''
' Base64-encode text.
'
' @param {Variant} Text Text to encode
' @return {String} Encoded string
''
Public Function Base64Encode(Text As String) As String
#If Mac Then
Dim web_Command As String
web_Command = "printf " & PrepareTextForPrintf(Text) & " | openssl base64"
Base64Encode = ExecuteInShell(web_Command).Output
#Else
Dim web_Bytes() As Byte
web_Bytes = VBA.StrConv(Text, vbFromUnicode)
Base64Encode = web_AnsiBytesToBase64(web_Bytes)
#End If
Base64Encode = VBA.Replace$(Base64Encode, vbLf, "")
End Function
''
' Decode Base64-encoded text
'
' @param {Variant} Encoded Text to decode
' @return {String} Decoded string
''
Public Function Base64Decode(Encoded As Variant) As String
' Add trailing padding, if necessary
If (VBA.Len(Encoded) Mod 4 > 0) Then
Encoded = Encoded & VBA.Left("====", 4 - (VBA.Len(Encoded) Mod 4))
End If
#If Mac Then
Dim web_Command As String
web_Command = "echo " & PrepareTextForShell(Encoded) & " | openssl base64 -d"
Base64Decode = ExecuteInShell(web_Command).Output
#Else
Dim web_XmlObj As Object
Dim web_Node As Object
Set web_XmlObj = CreateObject("MSXML2.DOMDocument")
Set web_Node = web_XmlObj.createElement("b64")
web_Node.DataType = "bin.base64"
web_Node.Text = Encoded
Base64Decode = VBA.StrConv(web_Node.nodeTypedValue, vbUnicode)
Set web_Node = Nothing
Set web_XmlObj = Nothing
#End If
End Function
#If Mac Then
#Else
Private Function web_AnsiBytesToBase64(web_Bytes() As Byte)
' Use XML to convert to Base64
Dim web_XmlObj As Object
Dim web_Node As Object
Set web_XmlObj = CreateObject("MSXML2.DOMDocument")
Set web_Node = web_XmlObj.createElement("b64")
web_Node.DataType = "bin.base64"
web_Node.nodeTypedValue = web_Bytes
web_AnsiBytesToBase64 = web_Node.Text
Set web_Node = Nothing
Set web_XmlObj = Nothing
End Function
Private Function web_AnsiBytesToHex(web_Bytes() As Byte)
Dim web_i As Long
For web_i = LBound(web_Bytes) To UBound(web_Bytes)
web_AnsiBytesToHex = web_AnsiBytesToHex & VBA.LCase$(VBA.Right$("0" &
VBA.Hex$(web_Bytes(web_i)), 2))
Next web_i
End Function
#End If
