web-dev-qa-db-ja.com

Excelでの文字列の暗号化と復号化

Excel VisualBasicといくつかの暗号化サービスプロバイダーを使用して文字列の暗号化/復号化を実行できるかどうかに興味があります。

チュートリアル Visual Basicでの文字列の暗号化と復号化 を見つけましたが、スタンドアロンのVisual Basicでのみ有効であるようです。

では、別の暗号化方法を提案したり、Excel Visual Basicにウォークスルーを採用する方法を示したりしますか？

excel-vbaencryptionstringvbaexcel
12
Alexander Prokofyev

提供するリンクは、VB.NETを使用して、したがって.NET Frameworkを使用して文字列の暗号化と復号化を実行する方法を示しています。

現在、Microsoft Office製品はまだ Visual Studio Tools for Applications コンポーネントを使用できません。これにより、Office製品は.NET FrameworkのBCL（基本クラスライブラリ）にアクセスし、基盤となるWindows CSP（暗号化サーバープロバイダー）、これらの暗号化/復号化機能の優れたラッパーを提供します。

当面の間、Office製品は古いVBA（ Visual Basic for Applications ）に固執します。これは、COMではなくCOMに基づく古いVB6（およびそれ以前）バージョンのVisualBasicに基づいています。 。ネットフレームワーク。

これらすべてのために、CSP関数にアクセスするためにWin32 APIを呼び出す必要があるか、純粋なVB6/VBAコードで「独自の」暗号化方式を使用する必要がありますが、これは可能性が高いです。安全性が低い。それはすべて、暗号化をどの程度「安全」にするかによって異なります。

「自分でロール」する基本的な文字列暗号化/復号化ルーチンが必要な場合は、次のリンクを参照して始めてください。

文字列を簡単に暗号化する
より良いXOR読み取り可能な文字列による暗号化
vb6-暗号化機能
Visual Basic 6/VBA文字列暗号化/復号化関数

Win32 APIにアクセスし、基盤となるWindows CSP（はるかに安全なオプション）を使用する場合、これを実現する方法の詳細については、次のリンクを参照してください。

Visual Basic 6.0で文字列を暗号化する方法
VBAのCryptEncrypt（CryptoAPI/WinAPI）関数へのアクセス

その最後のリンクはおそらくあなたが望むものであり、WindowsCSP機能を「ラップ」するための完全なVBAクラスモジュールが含まれています。

23
CraigTP

ClsCifradoというクラスモジュールを作成します。

Option Explicit
Option Compare Binary

Private clsClave As String

Property Get Clave() As String
    Clave = clsClave
End Property

Property Let Clave(value As String)
    clsClave = value
End Property


Function Cifrar(Frase As String) As String

    Dim Cachos() As Byte
    Dim LaClave() As Byte
    Dim i As Integer
    Dim Largo As Integer

    If Frase <> "" Then
        Cachos() = StrConv(Frase, vbFromUnicode)
        LaClave() = StrConv(clsClave, vbFromUnicode)
        Largo = Len(clsClave)

        For i = LBound(Cachos) To UBound(Cachos)
            Cachos(i) = (Cachos(i) Xor LaClave(i Mod Largo)) + 34
        Next i

        Cifrar = StrConv(Cachos(), vbUnicode)
    Else
        Cifrar = ""
    End If

End Function

Function Descifrar(Frase As String) As String

    Dim Cachos() As Byte
    Dim LaClave() As Byte
    Dim i As Integer
    Dim Largo As Integer

    If Frase <> "" Then
        Cachos() = StrConv(Frase, vbFromUnicode)
        LaClave() = StrConv(clsClave, vbFromUnicode)
        Largo = Len(clsClave)

        For i = LBound(Cachos) To UBound(Cachos)
            Cachos(i) = Cachos(i) - 34
            Cachos(i) = (Cachos(i) Xor LaClave(i Mod Largo))
        Next i

        Descifrar = StrConv(Cachos(), vbUnicode)
    Else
        Descifrar = ""
    End If

End Function

コードで使用できるようになりました。

暗号化する

Private Sub btnCifrar_Click()

    Dim Texto As String
    Dim cCifrado As clsCifrado

    Set cCifrado = New clsCifrado

    '---poner la contraseña
    If tbxClave.Text = "" Then
        MsgBox "The Password is missing"
        End Sub
    Else
        cCifrado.Clave = tbxClave.Text
    End If

    '---Sacar los datos
    Texto = tbxFrase.Text

    '---cifrar el texto
    Texto = cCifrado.Cifrar(Texto)

    tbxFrase.Text = Texto

 End Sub

解読するには

Private Sub btnDescifrar_Click()

    Dim Texto As String
    Dim cCifrado As clsCifrado

    Set cCifrado = New clsCifrado

    '---poner la contraseña
    If tbxClave.Text = "" Then
        MsgBox "The Password is missing"
        End Sub
    Else
        cCifrado.Clave = tbxClave.Text
    End If

    '---Sacar los datos
    Texto = tbxFrase.Text

    '---cifrar el texto
    Texto = cCifrado.Descifrar(Texto)

    tbxFrase.Text = Texto
End Sub
4
user3407604

以下は、対称的な暗号化/復号化の基本的な例です。

Sub testit()
    Dim inputStr As String
    inputStr = "Hello world!"

    Dim encrypted As String, decrypted As String
    encrypted = scramble(inputStr)
    decrypted = scramble(encrypted)
    Debug.Print encrypted
    Debug.Print decrypted
End Sub


Function stringToByteArray(str As String) As Variant
    Dim bytes() As Byte
    bytes = str
    stringToByteArray = bytes
End Function

Function byteArrayToString(bytes() As Byte) As String
    Dim str As String
    str = bytes
    byteArrayToString = str
End Function


Function scramble(str As String) As String
    Const SECRET_PASSWORD As String = "K*4HD%f#nwS%sdf032#gfl!HLKN*pq7"

    Dim stringBytes() As Byte, passwordBytes() As Byte
    stringBytes = stringToByteArray(str)
    passwordBytes = stringToByteArray(SECRET_PASSWORD)

    Dim upperLim As Long
    upperLim = UBound(stringBytes)
    ReDim scrambledBytes(0 To upperLim) As Byte
    Dim idx As Long
    For idx = LBound(stringBytes) To upperLim
        scrambledBytes(idx) = stringBytes(idx) Xor passwordBytes(idx)
    Next idx
    scramble = byteArrayToString(scrambledBytes)
End Function

指定された入力文字列がSECRET_PASSWORDより長い場合、これがクラッシュすることに注意してください。これは、開始するための単なる例です。

2
CodeKid

このコードはVBAで正常に機能し、VB.NETに簡単に移動できます

「通常の」文字以外の処理を回避します。 AllowedCharsで、許可する文字を決定します。

Public Function CleanEncryptSTR(MyString As String, MyPassword As String, Encrypt As Boolean) As String
'Encrypts strings chars contained in Allowedchars
'MyString = String to decrypt
'MyPassword = Password
'Encrypt True: Encrypy   False: Decrypt
    Dim i As Integer
    Dim ASCToAdd As Integer
    Dim ThisChar As String
    Dim ThisASC As Integer
    Dim NewASC As Integer
    Dim MyStringEncrypted As String
    Dim AllowedChars As String

    AllowedChars = "&0123456789;ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

    If Len(MyPassword) > 0 Then
        For i = 1 To Len(MyString)
'            ThisASC = Asc(Mid(MyString, i, 1))
'            ThisASC = IntFromArray(Asc(Mid(MyString, i, 1)), MyVector())

            ThisChar = Mid(MyString, i, 1)
            ThisASC = InStr(AllowedChars, ThisChar)

            If ThisASC > 0 Then
                ASCToAdd = Asc(Mid(MyPassword, i Mod Len(MyPassword) + 1, 1))
                If Encrypt Then
                    NewASC = ThisASC + ASCToAdd
                Else
                    NewASC = ThisASC - ASCToAdd
                End If
                NewASC = NewASC Mod Len(AllowedChars)
                If NewASC <= 0 Then
                    NewASC = NewASC + Len(AllowedChars)
                End If

                MyStringEncrypted = MyStringEncrypted & Mid(AllowedChars, NewASC, 1)
            Else
                MyStringEncrypted = MyStringEncrypted & ThisChar
            End If
        Next i
    Else
        MyStringEncrypted = MyString
    End If

    CleanEncryptSTR = MyStringEncrypted

End Function
2
user3579314

任意のシェルスクリプトを介してパイプExcelセルデータを呼び出すことができます。 Excel用のGPLバート（ http://bert-toolkit.com/ ）R言語インターフェイスをインストールします。以下のExcelのRスクリプトを使用して、セルデータをBash/Perl/gpg/opensslにパイプします。

 c:\> cat c:\R322\callable_from_Excel.R
    CRYPTIT <- function( PLAINTEXT, MASTER_PASS ) {
    system(
      sprintf("bash -c 'echo '%s' |
        gpg --symmetric --cipher-algo blowfish --force-mdc --passphrase '%s' -q  |
        base64 -w 0'",
        PLAINTEXT, MASTER_PASS),
      intern=TRUE)
  }

DECRYPTIT <- function( CRYPTTEXT, MASTER_PASS ) {
    system(
      sprintf("bash -c 'echo '%s'|
        base64 -d |
        gpg --passphrase '%s' -q |
        putclip | getclip' ",CRYPTTEXT,MASTER_PASS),
      intern=TRUE)  
  }

Excelでは、次のことを試すことができます。C1= CRYPTIT（A1、A2）およびC2 = DECRYPTIT（C1、A2）オプション：putclipは、復号化されたテキストをクリップボードに保存します。両方の関数タイプは次のとおりです。文字列->文字列。一重引用符で囲まれた文字列で一重引用符をエスケープする場合の通常の注意事項。

1
mosh

このコードは私にとってうまく機能します（3DES暗号化/復号化）：

INITIALIZATION_VECTORとTRIPLE_DES_KEYを環境変数（ここに掲載されている値とは明らかに異なる値）として保存し、VBA Environ（）関数を使用して取得するため、VBAコード内のすべての機密データ（パスワード）が暗号化されます。

Option Explicit

Public Const INITIALIZATION_VECTOR = "zlrs$5kd"  'Always 8 characters

Public Const TRIPLE_DES_KEY = ">tlF8adk=35K{dsa" 'Always 16 characters

Sub TestEncrypt()
    MsgBox "This is an encrypted string: -> " & EncryptStringTripleDES("This is an encrypted string:")
    Debug.Print EncryptStringTripleDES("This is an encrypted string:")
End Sub

Sub TestDecrypt()
    MsgBox "u99CVItCGiMQEVYHf8+S22QbJ5CPQGDXuS5n1jvEIgU= -> " & DecryptStringTripleDES("u99CVItCGiMQEVYHf8+S22QbJ5CPQGDXuS5n1jvEIgU=")
End Sub


Function EncryptStringTripleDES(plain_string As String) As Variant

    Dim encryption_object As Object
    Dim plain_byte_data() As Byte
    Dim encrypted_byte_data() As Byte
    Dim encrypted_base64_string As String

    EncryptStringTripleDES = Null

    On Error GoTo FunctionError

    plain_byte_data = CreateObject("System.Text.UTF8Encoding").GetBytes_4(plain_string)

    Set encryption_object = CreateObject("System.Security.Cryptography.TripleDESCryptoServiceProvider")
    encryption_object.Padding = 3
    encryption_object.key = CreateObject("System.Text.UTF8Encoding").GetBytes_4(TRIPLE_DES_KEY)
    encryption_object.IV = CreateObject("System.Text.UTF8Encoding").GetBytes_4(INITIALIZATION_VECTOR)
    encrypted_byte_data = _
            encryption_object.CreateEncryptor().TransformFinalBlock(plain_byte_data, 0, UBound(plain_byte_data) + 1)

    encrypted_base64_string = BytesToBase64(encrypted_byte_data)

    EncryptStringTripleDES = encrypted_base64_string

    Exit Function

FunctionError:

    MsgBox "TripleDES encryption failed"

End Function

Function DecryptStringTripleDES(encrypted_string As String) As Variant

    Dim encryption_object As Object
    Dim encrypted_byte_data() As Byte
    Dim plain_byte_data() As Byte
    Dim plain_string As String

    DecryptStringTripleDES = Null

    On Error GoTo FunctionError

    encrypted_byte_data = Base64toBytes(encrypted_string)

    Set encryption_object = CreateObject("System.Security.Cryptography.TripleDESCryptoServiceProvider")
    encryption_object.Padding = 3
    encryption_object.key = CreateObject("System.Text.UTF8Encoding").GetBytes_4(TRIPLE_DES_KEY)
    encryption_object.IV = CreateObject("System.Text.UTF8Encoding").GetBytes_4(INITIALIZATION_VECTOR)
    plain_byte_data = encryption_object.CreateDecryptor().TransformFinalBlock(encrypted_byte_data, 0, UBound(encrypted_byte_data) + 1)

    plain_string = CreateObject("System.Text.UTF8Encoding").GetString(plain_byte_data)

    DecryptStringTripleDES = plain_string

    Exit Function

FunctionError:

    MsgBox "TripleDES decryption failed"

End Function


Function BytesToBase64(varBytes() As Byte) As String
    With CreateObject("MSXML2.DomDocument").createElement("b64")
        .DataType = "bin.base64"
        .nodeTypedValue = varBytes
        BytesToBase64 = Replace(.Text, vbLf, "")
    End With
End Function


Function Base64toBytes(varStr As String) As Byte()
    With CreateObject("MSXML2.DOMDocument").createElement("b64")
         .DataType = "bin.base64"
         .Text = varStr
         Base64toBytes = .nodeTypedValue
    End With
End Function

ここから取得したソースコード： https://Gist.github.com/motoraku/97ad730891e59159d86c

元のコードと私のコードの違いに注意してください。これは、追加のオプションencryption_object.Padding = 3で、VBAを強制的にnotパディングを実行しません。パディングオプションを3に設定すると、DES_ede3_cbc_encryptアルゴリズムのC++実装とまったく同じ結果が得られます。これは、この オンラインツール によって生成されるものと一致します。

1
OGCJN