Мне интересно, можно ли выполнить строковое шифрование/дешифрование с помощью Excel Visual Basic и некоторого поставщика криптографических услуг.
Я нашел прохождение Шифрование и дешифрование строк в Visual Basic, но, похоже, он действителен только для автономного Visual Basic.
Итак, вы бы предложили мне другой метод шифрования или показать, как пошаговое руководство может быть принято для Excel Visual Basic?
В представленной вами ссылке показано, как выполнять строковое шифрование и дешифрование с помощью 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.
Создайте модуль класса, называемый 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
Вот базовый пример симметричного шифрования/дешифрования:
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. Это просто пример для начала.
Избегает работы с не "нормальными" персонажами. В 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
Вы можете вызывать данные ячейки 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. Обычные оговорки об исключении одиночных кавычек в строках с одной кавычкой.
Этот код хорошо работает для меня (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 и который согласуется с тем, что производится этим онлайн-инструментом ,
Вы можете использовать бесплатную веб-надстройку для Excel 2016 года (и Excel онлайн) с надписью Cell Conceal.
Это в магазине приложений Microsoft.
https://appsource.microsoft.com/en-us/product/office/WA200000075?mktcmpid=discgrp
(1) Просто зайдите в магазин AppSource и найдите "Скрытие ячейки" (2) Если у вас Desktop Excel 2016 или более поздней версии, перейдите на "Вставить" → Store--> Поиск скрытия ячейки
Он прост в использовании и имеет несколько вариантов защиты конфиденциальных данных.