ExcelVBAでRSA暗号

これは何?

なんとなく、ExcelでRSA暗号って使えるのかな?と思ってしまったので、やってみたら、意外と簡単でした、というお話です。

ただ、実用性があるかどうかは別問題です。

要約

System.Security.Cryptography.RSACryptoServiceProviderオブジェクトを作って、定義されているメソッドを利用するだけです。

Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")

' 秘密鍵の生成
secretKey = objRsa.ToXmlString(True)

' 公開鍵の生成
publicKey = objRsa.ToXmlString(False)

' 暗号化
objRsa.FromXmlString (publicKey)
encryptedBytes = objRsa.Encrypt("暗号化したいバイト配列", False)

' 復号
objRsa.FromXmlString (secretKey)
decryptedString = objRsa.Decrypt(encryptedBytes, False)

set objRsa = Nothing

つまりは、VB.netとかで使っているコードがそのまま使えますよ、ということですね。

鍵の生成

まずは、RSA暗号で必要な公開鍵と秘密鍵を生成します。

鍵の生成

Public Function generateKey() As String ()
    Dim objRsa As Object
    Dim lstKeys(2) As String
    Dim publicKey As String
    Dim secretKey As String

    publicKey = ""
    secretKey = ""

    Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")
    publicKey = objRsa.ToXmlString(False)
    secretKey = objRsa.ToXmlString(True)
    Set objRsa = Nothing

    lstKeys(0) = publicKey
    lstKeys(1) = secretKey

    generateKey = lstKeys
End Sub

Base64

では、早速暗号化・・・の前に、暗号化したデータはバイナリデータで、そのままでは少々扱いにくいので、Base64エンコードするためのコードを示しておきます。

Base64エンコード

Public Function encodeBase64(ByVal byteData() As Byte) As String
    Dim objXML As Object, objElement As Object

    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objElement = objXML.CreateElement("tmp")
    With objElement
        .DataType = "bin.base64"
        .NodeTypedValue = byteData
        encodeBase64 = .Text
    End With
    Set objElement = Nothing
    Set objXML = Nothing

    ' 改行コードは削除
    encodeBase64 = Replace(encodeBase64, vbLf, "")
    encodeBase64 = Replace(encodeBase64, vbCr, "")
End Function

エンコードしたデータは戻すことになるので、デコードのコードも。

Base64デコード

Public Function decodeBase64(ByVal encodedString As String) As Byte()
    Dim objXML As Object, objElement As Object

    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objElement = objXML.CreateElement("tmp")
    With objElement
        .DataType = "bin.base64"
        .Text = Trim(encodedString)
        decodeBase64 = .NodeTypedValue
    End With
    Set objElement = Nothing
    Set objXML = Nothing
End Function

暗号化

では、本題の暗号化のコードです。

暗号化

Public Function encryptString(ByVal plainText As String, ByVal publicKey As String) As String
    Dim objRsa As Object
    Dim arrUnicode() As Byte
    Dim arrEncrypted() As Byte

    encryptString = ""

    ' 今回のコードではUnicodeで120バイト以上の文字列は暗号化できません。
    If LenB(StrConv(plainText, vbUnicode)) >= 120 Then Exit Function

    ' 文字列をバイト配列に変換
    arrUnicode = StrConv(plainText, vbUnicode)

    ' RSA暗号化
    Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")
    objRsa.FromXmlString (publicKey)
    arrEncrypted = objRsa.Encrypt(arrUnicode, False)
    Set objRsa = Nothing

    ' 暗号化結果をBase64でエンコードして文字列に
    encryptString = encodeBase64(arrEncrypted)
End Sub

復号

復号化ではなくて復号。

復号

Public Function decryptData(ByVal base64Encoded As String, ByVal secretKey As String) As String
    Dim objRsa As Object
    Dim arrDecrypted() As Byte
    Dim arrTemp() As Byte

    ' Base64デコードして、バイナリデータを取得
    arrTemp = decodeBase64(base64Encoded)

    ' 復号
    Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")
    objRsa.FromXmlString (secretKey)
    arrDecrypted = objRsa.Decrypt(arrTemp, False)
    Set objRsa = Nothing

    ' Unicodeからシステムの文字コードに変換
    decryptData = StrConv(arrDecrypted, vbFromUnicode)
End Sub

同じようにすればRijndaelなんかも使えます。そっちだと文字数の制限とかもないですね。