概要
Windowsが標準で提供しているCryptAPIを利用してAES 128bitによる暗号化・復号をやってみた。
試していないが、192bit、256bitにも対応しているつもり。例によってx64版のExcelにも対応させてみた。
CryptAPIのバージョンによってはAESは未サポートの場合があるようだが、Windows XP以降ならAESもサポートしている模様。
なお、Windows Vista以降なら、CNG(Cryptography API: Next Generation)も利用できるらしい。
参考
CryptAPIについては、トラスト・ソフトウェア・システムの暗号化と電子署名アプリの解説が詳しい。
解説にCryptCreateHashで生成したハッシュを鍵に使用する、とあるが、これはあくまでハッシュ生成関数を用いて生成したハッシュ値を鍵に指定する場合であり、特定文字列を鍵にしたい場合はハッシュではなくCryptImportKeyを使用する必要がある点に注意。
(もちろん、暗号化強度の点ではハッシュ値を用いた方がより良いとは思うが。)
なお、CryptImportKeyは、PUBLICKEYSTRUC BLOBに続いて暗号化鍵データをもつバイト型の配列を引数に取るため、これをあらかじめ生成しておく。
MSDNの説明にはCryptExportKeyでエクスポートした鍵とあるが、形式だけ合わせて自分で生成してしまえばいい。
コード
AESによる暗号化・復号のメインとなるクラスをクラスモジュールに定義。
クラスモジュールにした理由は特になし。標準モジュールでも構わない。
Cipherクラスモジュール
'CryptAPIを利用したAES暗号化/復号クラス
Option Explicit
'CryptAPI用定数定義
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
Private Const ALG_TYPE_BLOCK As Long = 1536
Private Const ALG_CLASS_DATA_ENCRYPT As Long = 24576
Private Const ALG_SID_AES_128 As Long = 14
Private Const ALG_SID_AES_192 As Long = 15
Private Const ALG_SID_AES_256 As Long = 16
Private Const PROV_RSA_AES As Long = 24
Private Const CALG_AES_128 As Long = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_AES_128
Private Const CALG_AES_192 As Long = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_AES_192
Private Const CALG_AES_256 As Long = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_AES_256
Private Const KP_IV As Long = 1
Private Const KP_PADDING As Long = 3
Private Const KP_MODE As Long = 4
Private Const PKCS5_PADDING As Long = 1
Private Const CRYPT_MODE_CBC As Long = 1
Private Const PLAINTEXTKEYBLOB As Long = 8
Private Const CUR_BLOB_VERSION As Long = 2
'WindowsAPI用定数定義
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER As Long = &H100
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200
Private Const FORMAT_MESSAGE_FROM_STRING As Long = &H400
Private Const FORMAT_MESSAGE_FROM_HMODULE As Long = &H800
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY As Long = 8192
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Long = 255
Private Const LANG_NEUTRAL As Long = &H0
Private Const SUBLANG_DEFAULT As Long = &H1
'CryptoAPI定義
#If VBA7 And Win64 Then
Private Declare PtrSafe Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" ( _
ByRef phProv As LongPtr, ByVal pszContainer As String, ByVal pszProvider As String, _
ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function CryptReleaseContext Lib "advapi32.dll" ( _
ByVal hProv As LongPtr, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function CryptImportKey Lib "advapi32.dll" ( _
ByVal hProv As LongPtr, ByRef pbData As Any, ByVal dwDataLen As Long, _
ByVal hPubKey As Long, ByVal dwFlags As Long, ByRef phKey As LongPtr) As Long
Private Declare PtrSafe Function CryptDestroyKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long
Private Declare PtrSafe Function CryptSetKeyParam Lib "advapi32.dll" ( _
ByVal hKey As LongPtr, ByVal dwParam As Long, ByRef pbData As Any, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function CryptDecrypt Lib "advapi32.dll" ( _
ByVal hKey As LongPtr, ByVal hHash As LongPtr, ByVal Final As Long, _
ByVal dwFlags As Long, ByRef pbData As Any, ByRef pdwDataLen As Long) As Long
Private Declare PtrSafe Function CryptEncrypt Lib "advapi32.dll" ( _
ByVal hKey As LongPtr, ByVal hHash As LongPtr, ByVal Final As Long, _
ByVal dwFlags As Long, ByRef pbData As Any, ByRef pdwDataLen As Long, _
ByVal dwBufLen As Long) As Long
#Else
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" ( _
ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, _
ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" ( _
ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptImportKey Lib "advapi32.dll" ( _
ByVal hProv As Long, ByRef pbData As Any, ByVal dwDataLen As Long, _
ByVal hPubKey As Long, ByVal dwFlags As Long, ByRef phKey As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function CryptSetKeyParam Lib "advapi32.dll" ( _
ByVal hKey As Long, ByVal dwParam As Long, ByRef pbData As Any, _
ByVal dwFlags As Long) As Long
Private Declare Function CryptDecrypt Lib "advapi32.dll" ( _
ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, _
ByVal dwFlags As Long, ByRef pbData As Any, ByRef pdwDataLen As Long) As Long
Private Declare Function CryptEncrypt Lib "advapi32.dll" ( _
ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, _
ByVal dwFlags As Long, ByRef pbData As Any, ByRef pdwDataLen As Long, _
ByVal dwBufLen As Long) As Long
#End If
'WindowsAPI定義
#If VBA7 And Win64 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare PtrSafe Function FormatMessage Lib "kernel32.dll" Alias "FormatMessageW" ( _
ByVal dwFlags As Long, ByRef lpSource As Any, ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, ByRef lpBuffer As LongPtr, ByVal nSize As Long, _
ByRef Arguments As Any) As Long
Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" ( _
ByVal lpString1 As LongPtr, ByVal lpString2 As LongPtr) As Long
Private Declare PtrSafe Function LocalFree Lib "kernel32.dll" (ByVal hMem As LongPtr) As Long
#Else
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function FormatMessage Lib "kernel32.dll" Alias "FormatMessageW" ( _
ByVal dwFlags As Long, ByRef lpSource As Any, ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, ByRef lpBuffer As Long, ByVal nSize As Long, _
ByRef Arguments As Any) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" ( _
ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function LocalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
#End If
'BLOBHEADERユーザ定義型
Private Type BLOBHEADER
bType As Byte
bVersion As Byte
reserved As Integer
aiKeyAlg As Long
End Type
'インポート用の鍵データのユーザ定義型
'
'PUBLICKEYSTRUC BLOBヘッダに続いて、鍵サイズ、鍵データが必要だが、
'鍵データについては鍵サイズによって配列サイズが変わるため、
'ロジック中で動的にメモリを確保するようにし、ここでは未定義とする
Private Type keyBlob
hdr As BLOBHEADER
keySize As Long
' keyData() As Byte
End Type
'鍵長定数定義
Public Enum AESKeyBits
AES_KEY128 = 128
AES_KEY192 = 192
AES_KEY256 = 256
End Enum
'エラーコード定義
Private Const ERR_CRYPT_API = vbObjectError + 513 'CryptAPIエラー
Private Const ERR_KEY_LENGTH = vbObjectError + 514 '鍵長エラー
Private Const ERR_IV_LENGTH = vbObjectError + 515 'IV長エラー
'AES/CBC/PKCS5Padding復号処理
'
'引数:
' [in] key: 鍵バイト列
' [in] iv: IVバイト列
' [in,out] data: [in]暗号化バイト列/[out]復号バイト列
' [in] keyBits: 鍵ビット長(デフォルト128bit)
'
'戻り値:
' なし
Public Sub decrypt(ByRef key() As Byte, ByRef iv() As Byte, ByRef data() As Byte, Optional ByVal keyBits As AESKeyBits = AES_KEY128)
#If VBA7 And Win64 Then
Dim hProv As LongPtr 'CSPハンドラ
Dim hKey As LongPtr '暗号鍵ハンドラ
#Else
Dim hProv As Long 'CSPハンドラ
Dim hKey As Long '暗号鍵ハンドラ
#End If
Dim algid As Long '暗号化アルゴリズム
On Error GoTo ErrorHandler
'AESの鍵長から暗号化アルゴリズムIDを設定
Select Case keyBits
Case AES_KEY128
algid = CALG_AES_128
Case AES_KEY192
algid = CALG_AES_192
Case AES_KEY256
algid = CALG_AES_256
End Select
Dim keyLength As Long '鍵バイト長
keyLength = keyBits / 8 'ビット->バイト変換
'鍵長のチェック
If UBound(key) + 1 <> keyLength Then
Err.Raise ERR_KEY_LENGTH, "decrypt()", "鍵長が不正です: " & UBound(key) + 1 & "byte"
End If
'IV長のチェック
If UBound(iv) + 1 <> 16 Then
Err.Raise ERR_IV_LENGTH, "decrypt()", "IV長が不正です: " & UBound(iv) + 1 & "byte"
End If
'CSP(Cryptographic Service Provider)のハンドルを取得
If Not CBool(CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_AES, CRYPT_VERIFYCONTEXT)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptAcquireContext()", Err.LastDllError
End If
Dim blob As keyBlob '鍵データ(ユーザ定義型)
Dim keyData() As Byte '鍵データ(バイト列)
'鍵データの作成
'keyBlobユーザ定義型に鍵データを結合したバイト列を無理やり作成する
blob.hdr.bType = PLAINTEXTKEYBLOB
blob.hdr.bVersion = CUR_BLOB_VERSION
blob.hdr.reserved = 0
blob.hdr.aiKeyAlg = algid
blob.keySize = keyLength
ReDim keyData(LenB(blob) + blob.keySize - 1)
Call CopyMemory(keyData(0), blob, LenB(blob))
Call CopyMemory(keyData(LenB(blob)), key(0), keyLength)
'鍵のインポート
If Not CBool(CryptImportKey(hProv, keyData(0), UBound(keyData) + 1, 0, 0, hKey)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptImportKey()", Err.LastDllError
End If
'パディング方式の設定(PKCS#5)
If Not CBool(CryptSetKeyParam(hKey, KP_PADDING, PKCS5_PADDING, 0)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptSetKeyParam():KP_PADDING", Err.LastDllError
End If
'IV(Initialization Vector)の設定
If Not CBool(CryptSetKeyParam(hKey, KP_IV, iv(0), 0)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptSetKeyParam():KP_IV", Err.LastDllError
End If
'暗号モードの設定(暗号文ブロック連鎖モード)
If Not CBool(CryptSetKeyParam(hKey, KP_MODE, CRYPT_MODE_CBC, 0)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptSetKeyParam():KP_MODE", Err.LastDllError
End If
'暗号化バイト列長
Dim dwDataLen As Long
dwDataLen = UBound(data) + 1
'CryptDecryptは、引数の暗号化バイト列に復号したバイト列を戻す仕様のため
'メソッドの引数の暗号化バイト列をローカル変数にコピーして使用する
Dim pbData() As Byte
ReDim pbData(dwDataLen - 1)
Call CopyMemory(pbData(0), data(0), UBound(data) + 1)
'復号処理
If Not CBool(CryptDecrypt(hKey, 0, True, 0, pbData(0), dwDataLen)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptDecrypt()", Err.LastDllError
End If
ReDim Preserve pbData(dwDataLen - 1)
data = pbData
'暗号鍵ハンドラの開放
If Not CBool(CryptDestroyKey(hKey)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptDestroyKey()", Err.LastDllError
End If
'CSPハンドラの開放
If Not CBool(CryptReleaseContext(hProv, 0)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptReleaseContext()", Err.LastDllError
End If
Exit Sub
ErrorHandler:
Dim errNumber As Long
Dim errSource As String
Dim errMessage As String
errMessage = ""
If Err.Number <> 0 Then
If Err.Number = ERR_CRYPT_API Then
errNumber = Err.Description
errSource = Err.Source
errMessage = GetErrorText(Err.Description)
Else
errNumber = Err.Number
errSource = Err.Source
errMessage = Err.Description
End If
End If
Err.Clear
If Not hKey <> 0 Then
'暗号鍵ハンドラの開放
Call CryptDestroyKey(hKey)
End If
If Not hProv <> 0 Then
'CSPハンドラの開放
Call CryptReleaseContext(hProv, 0)
End If
On Error GoTo 0
If errMessage <> "" Then
Err.Raise Number:=errNumber, Source:=errSource, Description:=errMessage
End If
End Sub
'AES/CBC/PKCS5Padding暗号化処理
'
'引数:
' [in] key: 鍵バイト列
' [in] iv: IVバイト列
' [in,out] data: [in]平文バイト列/[out]暗号化バイト列
' [in] keyBits: 鍵ビット長(デフォルト128bit)
'
'戻り値:
' なし
Public Sub encrypt(ByRef key() As Byte, ByRef iv() As Byte, ByRef data() As Byte, Optional ByVal keyBits As AESKeyBits = AES_KEY128)
#If VBA7 And Win64 Then
Dim hProv As LongPtr 'CSPハンドラ
Dim hKey As LongPtr '暗号鍵ハンドラ
#Else
Dim hProv As Long 'CSPハンドラ
Dim hKey As Long '暗号鍵ハンドラ
#End If
Dim algid As Long '暗号化アルゴリズム
On Error GoTo ErrorHandler
'AESの鍵長から暗号化アルゴリズムIDを設定
Select Case keyBits
Case AES_KEY128
algid = CALG_AES_128
Case AES_KEY192
algid = CALG_AES_192
Case AES_KEY256
algid = CALG_AES_256
End Select
Dim keyLength As Long '鍵バイト長
keyLength = keyBits / 8 'ビット->バイト変換
'鍵長のチェック
If UBound(key) + 1 <> keyLength Then
Err.Raise ERR_KEY_LENGTH, "decrypt()", "鍵長が不正です: " & UBound(key) + 1 & "byte"
End If
'IV長のチェック
If UBound(iv) + 1 <> 16 Then
Err.Raise ERR_IV_LENGTH, "decrypt()", "IV長が不正です: " & UBound(iv) + 1 & "byte"
End If
'CSP(Cryptographic Service Provider)のハンドルを取得
If Not CBool(CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_AES, CRYPT_VERIFYCONTEXT)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptAcquireContext()", Err.LastDllError
End If
Dim blob As keyBlob '鍵データ(ユーザ定義型)
Dim keyData() As Byte '鍵データ(バイト列)
'鍵データの作成
'keyBlobユーザ定義型に鍵データを結合したバイト列を無理やり作成する
blob.hdr.bType = PLAINTEXTKEYBLOB
blob.hdr.bVersion = CUR_BLOB_VERSION
blob.hdr.reserved = 0
blob.hdr.aiKeyAlg = algid
blob.keySize = keyLength
ReDim keyData(LenB(blob) + blob.keySize - 1)
Call CopyMemory(keyData(0), blob, LenB(blob))
Call CopyMemory(keyData(LenB(blob)), key(0), keyLength)
'鍵のインポート
If Not CBool(CryptImportKey(hProv, keyData(0), UBound(keyData) + 1, 0, 0, hKey)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptImportKey()", Err.LastDllError
End If
'パディング方式の設定(PKCS#5)
If Not CBool(CryptSetKeyParam(hKey, KP_PADDING, PKCS5_PADDING, 0)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptSetKeyParam():KP_PADDING", Err.LastDllError
End If
'IV(Initialization Vector)の設定
If Not CBool(CryptSetKeyParam(hKey, KP_IV, iv(0), 0)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptSetKeyParam():KP_IV", Err.LastDllError
End If
'暗号モードの設定(暗号文ブロック連鎖モード)
If Not CBool(CryptSetKeyParam(hKey, KP_MODE, CRYPT_MODE_CBC, 0)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptSetKeyParam():KP_MODE", Err.LastDllError
End If
'平文バイト列長
Dim dwPlainDataLen As Long
dwPlainDataLen = UBound(data) + 1
'暗号化バイト列長
Dim dwCryptDataLen As Long
dwCryptDataLen = dwPlainDataLen
'CryptEncryptは、引数の平文バイト列に暗号化したバイト列を戻す仕様のため
'メソッドの引数の平文バイト列をローカル変数にコピーして使用する
Dim pbData() As Byte
ReDim pbData(dwPlainDataLen - 1)
Call CopyMemory(pbData(0), data(0), dwPlainDataLen)
'暗号化処理
'暗号化後のバイト列長をあらかじめ問い合わせてバッファを拡張しておく
If Not CBool(CryptEncrypt(hKey, 0, True, 0, ByVal 0&, dwCryptDataLen, dwPlainDataLen)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptEncrypt()", Err.LastDllError
End If
If dwCryptDataLen > dwPlainDataLen Then
ReDim Preserve pbData(dwCryptDataLen - 1)
End If
If Not CBool(CryptEncrypt(hKey, 0, True, 0, pbData(0), dwPlainDataLen, dwCryptDataLen)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptEncrypt()", Err.LastDllError
End If
data = LeftB(pbData, dwCryptDataLen)
'暗号鍵ハンドラの開放
If Not CBool(CryptDestroyKey(hKey)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptDestroyKey()", Err.LastDllError
End If
'CSPハンドラの開放
If Not CBool(CryptReleaseContext(hProv, 0)) Then
Err.Raise ERR_CRYPT_API, "decrypt()->CryptReleaseContext()", Err.LastDllError
End If
Exit Sub
ErrorHandler:
Dim errNumber As Long
Dim errSource As String
Dim errMessage As String
errMessage = ""
If Err.Number <> 0 Then
If Err.Number = ERR_CRYPT_API Then
errNumber = Err.Description
errSource = Err.Source
errMessage = GetErrorText(Err.Description)
Else
errNumber = Err.Number
errSource = Err.Source
errMessage = Err.Description
End If
End If
Err.Clear
If Not hKey <> 0 Then
'暗号鍵ハンドラの開放
Call CryptDestroyKey(hKey)
End If
If Not hProv <> 0 Then
'CSPハンドラの開放
Call CryptReleaseContext(hProv, 0)
End If
On Error GoTo 0
If errMessage <> "" Then
Err.Raise Number:=errNumber, Source:=errSource, Description:=errMessage
End If
End Sub
'MAKELANGIDマクロのメソッド化による実装
Private Function MAKELANGID(ByVal p As Long, ByVal s As Long) As Long
MAKELANGID = (CLng(CInt(s)) * 1024) Or CLng(CInt(p))
End Function
'エラーコードからエラーメッセージを取得する
Private Function GetErrorText(ByVal ErrorCode As Long) As String
#If VBA7 And Win64 Then
Dim lpBuffer As LongPtr
#Else
Dim lpBuffer As Long
#End If
Dim messageLength As Long
messageLength = FormatMessage( _
FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
0, ErrorCode, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), _
lpBuffer, 0, 0)
If messageLength = 0 Then
GetErrorText = ""
Else
GetErrorText = Space$(messageLength)
Call lstrcpy(ByVal StrPtr(GetErrorText), ByVal lpBuffer)
Call LocalFree(lpBuffer)
End If
End Function
続いて汎用メソッドを標準モジュールに実装。
鍵やIVの定義時、暗号・復号文字列の出力時に使用するメソッド。
Base64標準モジュール
'Base64エンコーダ/デコーダ
Option Explicit
'Base64文字列をバイト列にデコードする
Public Function decode(ByVal strData As String) As Byte()
Dim objBase64 As Object
Set objBase64 = CreateObject("MSXML2.DOMDocument").createElement("b64")
objBase64.DataType = "bin.base64"
objBase64.Text = strData
decode = objBase64.nodeTypedValue
Set objBase64 = Nothing
End Function
'バイト列をBase64文字列にエンコードする
Public Function encode(ByRef byteData() As Byte) As String
Dim objBase64 As Object
Set objBase64 = CreateObject("MSXML2.DOMDocument").createElement("b64")
objBase64.DataType = "bin.base64"
objBase64.nodeTypedValue = byteData
encode = objBase64.Text
Set objBase64 = Nothing
End Function
StringUtility標準モジュール
'文字列<->バイト列変換ユーティリティ
Option Explicit
Private Const adTypeBinary As Integer = 1
Private Const adTypeText As Integer = 2
Private Const adStateOpen = 1
'バイト列をShift-JISで文字列に変換する
Public Function byteToString(ByRef byteData() As Byte) As String
Dim objStream As Object
On Error GoTo ErrorHandler
Set objStream = CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = adTypeBinary
objStream.Write byteData
objStream.Position = 0
objStream.Type = adTypeText
objStream.Charset = "shift-jis"
byteToString = objStream.ReadText
Exit Function
ErrorHandler:
If Not objStream Is Nothing Then
If (objStream.State And adStateOpen) = adStateOpen Then
objStream.Close
End If
End If
Set objStream = Nothing
MsgBox "エラーコード:" & Err.Number & vbCrLf & Err.Description
End Function
'文字列をShift-JISでバイト列に変換する
Public Function stringToByte(ByVal strData As String) As Byte()
Dim objStream As Object
On Error GoTo ErrorHandler
Set objStream = CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = adTypeText
objStream.Charset = "shift-jis"
objStream.WriteText strData
objStream.Position = 0
objStream.Type = adTypeBinary
stringToByte = objStream.Read
Exit Function
ErrorHandler:
If Not objStream Is Nothing Then
If (objStream.State And adStateOpen) = adStateOpen Then
objStream.Close
End If
End If
Set objStream = Nothing
MsgBox "エラーコード:" & Err.Number & vbCrLf & Err.Description
End Function
後は呼び出し部を任意のシートに定義。
Sheet1
Public Sub main()
Dim key() As Byte
Dim iv() As Byte
Dim data() As Byte
Dim objCipher As Cipher
key = StringUtility.stringToByte("12345678abcdefgh")
iv = StringUtility.stringToByte("hgfedcba87654321")
data = StringUtility.stringToByte("暗号化したい文字列をここに設定")
On Error GoTo ErrorHandler
Set objCipher = New Cipher
Call objCipher.encrypt(key, iv, data)
Debug.Print Base64.encode(data)
Call objCipher.decrypt(key, iv, data)
Debug.Print StringUtility.byteToString(data)
Exit Sub
ErrorHandler:
Dim message As String
message = "エラーコード: &H" & Hex(Err.Number) & vbCrLf & _
"ソース: " & Err.Source & vbCrLf & Err.Description
MsgBox message, vbCritical
End Sub