ExcelVBAでRSA暗号化方式を利用して文字列を暗号化、複合化するテストをしていますが、「実行時エラー」で進行できなくなります。
しかも、環境によってエラーの出る場所とコードが異なります。
まずはコード全文を記載します。
直接実施するのはSub test2()
とSub test3()
です。
lang
1Option Explicit 2 3'暗号化をするテスト 4Sub test2() 5 Dim EncodeByte() As Byte, EncodeB64 As String 6 7 EncodeByte = encode_Public("あああ1234", "<RSAKeyValue><Modulus>qQlZJlgWHZMLYx8yPl2WaWVcTX5IMy8YT3h7NV5TqPO3gaYx4TwOYIP427Nai3K1tEvJGPqCO/k6CsmGmvppDJ3c6sFZpiGzl6kovsNmuyTbSSXJZoAA2fZp/p0DjbrvU6L/US9Av1PeGZj5ymBhn6hQXsq4eHsMRL3e5KVK8vE=</Modulus><Exponent>AQAB</Exponent></RSAKeyValue>") 8 EncodeB64 = encodeBase64(EncodeByte) 9 10 Debug.Print (EncodeB64) 11End Sub 12 13'複合化をするテスト 14Sub test3() 15 Dim DecodeByte() As Byte, DecodeStr As String 16 17 DecodeByte = decodeBase64("okHIniM+3/6oG4KoJsihSE6PdwzKFGoOuiYCVzJJPEcC0R+vMKGsUBdZNkyy7CiR8fW44tJ4T1HtL3sw2TryxZF3NnFDbKUud8ZxYHRhL41C1htjjdGyPDRScI44wWxYmC1q1rFQmgx/zAJcsAbJfAV2yR2TZxO9FZD+bKYcVBA=") 18 DecodeStr = decode_Secret(DecodeByte, "<RSAKeyValue><Modulus>qQlZJlgWHZMLYx8yPl2WaWVcTX5IMy8YT3h7NV5TqPO3gaYx4TwOYIP427Nai3K1tEvJGPqCO/k6CsmGmvppDJ3c6sFZpiGzl6kovsNmuyTbSSXJZoAA2fZp/p0DjbrvU6L/US9Av1PeGZj5ymBhn6hQXsq4eHsMRL3e5KVK8vE=</Modulus><Exponent>AQAB</Exponent><P>40lEJMhUVCittkfXqWB4N") 19 20 Debug.Print (DecodeStr) 21End Sub 22 23'公開鍵暗号化 24Private Function encode_Public(ByVal Hirabun As String, ByVal PublicKey As String) As Byte() 25 Dim arrUnicode() As Byte, arrEncrypted() As Byte, objRsa As Object 26 27 Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider") '★検証環境2(Win10x64FCU)ではここでエラー 28 29 '文字列をバイトに変換 30 arrUnicode = StrConv(Hirabun, vbUnicode) 31 32 '暗号化 33 objRsa.FromXmlString (PublicKey) 34 arrEncrypted = objRsa.Encrypt(arrUnicode, False) 35 36 Set objRsa = Nothing 37 38 encode_Public = arrEncrypted 39End Function 40 41'秘密鍵復号化 42Private Function decode_Secret(ByRef Angoubun() As Byte, ByVal SecretKey As String) As String 43 Dim arrDecrypted() As Byte, objRsa As Object 44 45 Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider") '★検証環境2(Win10x64FCU)ではここでエラー 46 '複合 47 objRsa.FromXmlString (SecretKey) '★検証環境1(Win7x86環境)ではここでエラー 48 arrDecrypted = objRsa.Decrypt(Angoubun, False) 49 50 Set objRsa = Nothing 51 52 'バイトを文字列に戻す 53 decode_Secret = StrConv(arrDecrypted, vbFromUnicode) 54End Function 55 56'BASE64エンコード 57Private Function encodeBase64(ByRef byteData() As Byte) As String 58 Dim objXML As Object, objElement As Object 59 60 Set objXML = CreateObject("MSXML2.DOMDocument") 61 Set objElement = objXML.CreateElement("tmp") 62 With objElement 63 .DataType = "bin.base64" 64 .NodeTypedValue = byteData 65 encodeBase64 = .Text 66 End With 67 Set objElement = Nothing 68 Set objXML = Nothing 69 70 ' 改行コードは削除 71 encodeBase64 = Replace(encodeBase64, vbLf, "") 72 encodeBase64 = Replace(encodeBase64, vbCr, "") 73End Function 74 75'BASE64デコード 76Private Function decodeBase64(ByVal encodedString As String) As Byte() 77 Dim objXML As Object, objElement As Object 78 79 Set objXML = CreateObject("MSXML2.DOMDocument") 80 Set objElement = objXML.CreateElement("tmp") 81 With objElement 82 .DataType = "bin.base64" 83 .Text = Trim(encodedString) 84 decodeBase64 = .NodeTypedValue 85 End With 86 Set objElement = Nothing 87 Set objXML = Nothing 88End Function
●エラー1
「検証環境1」でobjRsa.FromXmlString (SecretKey)
を実行時に下記エラーが出ます。
実行時エラー '-2146233320(80131418)'
1行に無効な構文があります。
ちなみに、下記のようにエンコードとデコードを一気に実施するコードならうまく動きます。
lang
1Sub Test1() 2 Dim SecretKey As String, PublicKey As String, objRsa As Object 3 Dim arrUnicode() As Byte, arrEncrypted() As Byte, arrDecrypted() As Byte 4 5 '文字列をバイトに変換 6 arrUnicode = StrConv("暗号化1234", vbUnicode) 7 8 Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider") 9 10 '秘密鍵の生成 11 SecretKey = objRsa.ToXmlString(True) 12 13 '公開鍵の生成 14 PublicKey = objRsa.ToXmlString(False) 15 16 '暗号化 17 objRsa.FromXmlString (PublicKey) 18 arrEncrypted = objRsa.Encrypt(arrUnicode, False) 19 20 'Base64化 21 Dim Base64Encrypted As String 22 Base64Encrypted = encodeBase64(arrEncrypted) 23 Debug.Print "暗号化BASE64化:" & Base64Encrypted 24 25 '複合 26 objRsa.FromXmlString (SecretKey) 27 arrDecrypted = objRsa.Decrypt(decodeBase64(Base64Encrypted), False) 'arrEncryptedと同じものをdecodeBase64(Base64Encrypted)で代入 28 29 Debug.Print StrConv(arrDecrypted, vbFromUnicode) 30 31 Set objRsa = Nothing 32 33End Sub
●エラー2
「検証環境2」でSet objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")
を実行時に下記エラーが出ます。
実行時エラー '-2146232576(80131700)'
オートメーションエラーです。
ちなみに、Set objRsa = CreateObject("InternetExplorer.Application")
等は問題なく実施可能なため、CreateObjectコマンド自体は問題ないようです。
●参考にしたサイト
ExcelVBAでRSA暗号
●検証環境1
OS:Windows7x86
Office:Professional Plus 2010
●検証環境2
OS:Windows10x64 - バージョン:1709
Office:Professional Plus 2016
回答2件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2017/12/22 01:54