ExcelVBAでRSA暗号


# これは何?

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

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

# 要約

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

```VBA
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暗号で必要な公開鍵と秘密鍵を生成します。

```VBA:鍵の生成
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エンコードするためのコードを示しておきます。

```VBA: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
```

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

```VBA: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
```

# 暗号化

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

```VBA:暗号化
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
```

# 復号

復号化ではなくて復号。

```VBA:復号
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なんかも使えます。そっちだと文字数の制限とかもないですね。