外部に提出しないExeclは効率UPのため2003を使用しています。最新のExeclでは、base64 エンコードくらいあるかと思っていましたが、ないんですね。「Execl base64」で検索してもあまり出てこなかったので、マクロExecl .xlm で作成しました。
Win32 APIの暗号化ライブラリで、API:CryptBinaryToStringA があったのでそちらの .dll を動的参照います。使用します。1コールでいけます。コードは以下の通りです。2003や32bit版offsice ビルドスイッチで切り分けています。URLセーフ(URLで使えない記号を置き替え、%xxのURLエンコードとはだいぶちがう) は、APIないので作りました。VBAエディタで「標準モジュール」に挿入します。
#If Win64 Then
Private Declare PtrSafe Function CryptBinaryToStringA Lib "Crypt32.dll" _
(pbBinary As Byte, _
ByVal cbBinary As Long, _
ByVal dwFlags As Long, _
pszString As Byte, _
pcchString As Long) As Long
#Else
Private Declare Function CryptBinaryToStringA Lib "Crypt32.dll" _
(pbBinary As Byte, _
ByVal cbBinary As Long, _
ByVal dwFlags As Long, _
pszString As Byte, _
pcchString As Long) As Long
#End If
Private Const CRYPT_STRING_BASE64HEADER As Long = &H0 ' Base64。証明書の先頭と末尾のヘッダーが含まれます。
Private Const CRYPT_STRING_BASE64 As Long = &H1 ' ヘッダーなしの Base64。
Private Const CRYPT_STRING_BINARY As Long = &H2 ' 純粋なバイナリ コピー。
Private Const CRYPT_STRING_BASE64REQUESTHEADER As Long = &H3 '要求の開始ヘッダーと終了ヘッダーを含む Base64。
Private Const CRYPT_STRING_HEX As Long = &H4 ' 16 進数のみ。
Private Const CRYPT_STRING_HEXASCII As Long = &H5 ' ASCII 文字表示の 16 進数。
Private Const CRYPT_STRING_BASE64X509CRLHEADER As Long = &H9 ' Base64( X.509 CRL の先頭ヘッダーと終了ヘッダーを含む)。
Private Const CRYPT_STRING_HEXADDR As Long = &HA 'アドレス表示を含む 16 進数。
Private Const CRYPT_STRING_HEXASCIIADDR As Long = &HB 'ASCII 文字とアドレス表示を含む 16 進数。
Private Const CRYPT_STRING_HEXRAW As Long = &HC ' 生の 16 進文字列。
Private Const CRYPT_STRING_STRICT = &H20000000 ' ASN.1 テキスト形式の厳密なデコードを適用します。
' BASE64
Public Function BASE64(ByVal hexData As String) As String
On Error GoTo ERROR01
BASE64 = "Error"
' String HEX をByte配列に変換
Dim binIn(512) As Byte
Dim binOut(512) As Byte
Dim result As Long
Dim sizeIn As Long
Dim sizeIo As Long
sizeIn = 0
Dim i As Long
If Len(hexData) = 0 Then
Return
End If
If Len(hexData) Mod 2 <> 0 Then
Return
End If
If Len(hexData) / 2 > UBound(binIn) - 1 Then
Return
End If
For i = 1 To Len(hexData) Step 2
binIn(sizeIn) = CLng("&h" & Mid(hexData, i, 2)) '16進バイナリ値に
sizeIn = sizeIn + 1
Next i
sizeIo = UBound(binIn) - 1
' BASE64に変換
result = CryptBinaryToStringA(binIn(0), sizeIn, CRYPT_STRING_BASE64, binOut(0), sizeIo)
If result = 0 Then Return
Dim base64str As String
base64str = ""
For i = 0 To sizeIo - 1
base64str = base64str & Chr(binOut(i)) 'ASII値を文字に
Next i
BASE64 = base64str
Exit Function
ERROR01:
End Function
' URL Safe BASE64
Public Function BASE64URLSAFE(ByVal hexData As String) As String
On Error GoTo ERROR01
BASE64URLSAFE = "Error"
Dim base64str As String
base64str = BASE64(hexData)
If base64str = "Error" Then Exit Function
' URLエンコードと違い文字置換のみ
' Win32APIは無い。
base64str = Replace(base64str, "=", "")
base64str = Replace(base64str, "+", "-")
base64str = Replace(base64str, "/", "_")
BASE64URLSAFE = base64str
Exit Function
ERROR01:
End Function
ちゃんとAPIエラー、引数エラー、VBエラー検出も組込みましょう。ネット上のサンプルはそれがあまりできていないようで実用上問題です。Execlの記述は、
