Шифрование и дешифрование строк в Excel

Ответ 1

В представленной вами ссылке показано, как выполнять строковое шифрование и дешифрование с помощью VB.NET и, следовательно, использовать .NET Framework.

В настоящее время продукты Microsoft Office еще не могут использовать компонент компонент Visual Studio Tools для приложений, который позволит продуктам Office получать доступ к платформе BCL.NET. библиотеки базового класса), которые, в свою очередь, получают доступ к базовому Windows CSP (поставщику криптографического сервера) и обеспечивают хорошую оболочку вокруг этих функций шифрования/дешифрования.

В настоящее время продукты Office застряли со старым VBA (Visual Basic для приложений), который основан на старом VB6 (и ранее) версии Visual Basic, основанные на COM, а не на .NET Framework.

Из-за всего этого вам придется либо обратиться к API Win32 для доступа к функциям CSP, либо вам придется использовать метод "roll-your-own" в чистом коде VB6/VBA, хотя это вероятно, будет менее безопасным. Все зависит от того, насколько безопасным будет ваше шифрование.

Если вы хотите использовать "рулонную собственную" процедуру шифрования/дешифрования базовой строки, взгляните на эту ссылку, чтобы начать:

Шифровать строку легко
Лучшее шифрование XOR с читаемой строкой
vb6 - функция шифрования
Функция Visual Basic 6/VBA для шифрования/дешифрования строк

Если вы хотите получить доступ к API Win32 и использовать базовый Windows CSP (гораздо более безопасный вариант), см. эти ссылки для получения подробной информации о том, как этого добиться:

Как зашифровать строку в Visual Basic 6.0
Доступ к функциям CryptEncrypt (CryptoAPI/WinAPI) в VBA

Эта последняя ссылка, скорее всего, та, которую вы хотите, и включает в себя полный модуль VBA Class для "обертывания" функций Windows CSP.

Ответ 2

Создайте модуль класса, называемый 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

Ответ 3

Вот базовый пример симметричного шифрования/дешифрования:

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. Это просто пример для начала.

Ответ 4

Этот код прекрасно работает в 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

Ответ 5

Вы можете вызывать данные ячейки Excel Excel через любую оболочку script. Установите GPL Bert (http://bert-toolkit.com/) Интерфейс языка R для Excel. Используйте R script ниже в Excel, чтобы передать данные ячеек в 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 сохраняет дешифрованный текст в буфере обмена. Оба типа функций: String → String. Обычные оговорки об исключении одиночных кавычек в строках с одной кавычкой.

Ответ 6

Этот код хорошо работает для меня (3DES Encryption/Decryption):

Я храню 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 не выполнять прописку. Если параметр padding задан равным 3, я получаю результат точно так же, как в С++-реализации алгоритма DES_ede3_cbc_encrypt и который согласуется с тем, что производится этим онлайн-инструментом ,

Ответ 7

Вы можете использовать бесплатную веб-надстройку для Excel 2016 года (и Excel онлайн) с надписью Cell Conceal.
Это в магазине приложений Microsoft.

https://appsource.microsoft.com/en-us/product/office/WA200000075?mktcmpid=discgrp

(1) Просто зайдите в магазин AppSource и найдите "Скрытие ячейки" (2) Если у вас Desktop Excel 2016 или более поздней версии, перейдите на "Вставить" → Store--> Поиск скрытия ячейки

Он прост в использовании и имеет несколько вариантов защиты конфиденциальных данных.