2009-09-24 72 views
10

Tôi quan tâm nếu có thể thực hiện mã hóa/giải mã chuỗi bằng Excel Visual Basic và một số nhà cung cấp dịch vụ mã hóa.Mã hóa và giải mã chuỗi trong Excel

Tôi đã tìm thấy một hướng dẫn Encrypting and Decrypting Strings in Visual Basic, nhưng có vẻ như nó chỉ hợp lệ cho Visual Basic độc lập.

Vì vậy, bạn có gợi ý cho tôi một phương pháp mã hóa khác hoặc hiển thị cách hướng dẫn có thể được áp dụng cho Excel Visual Basic không?

Trả lời

21

Liên kết bạn cung cấp cho thấy cách thực hiện mã hóa và giải mã chuỗi bằng VB.NET, và do đó, bằng cách sử dụng Khuôn khổ .NET.

Hiện tại, các sản phẩm Microsoft Office chưa thể sử dụng thành phần Visual Studio Tools for Applications sẽ cho phép các sản phẩm Office truy cập vào BCL của .NET framework (thư viện lớp cơ sở), lần lượt truy cập CSP Windows bên dưới (nhà cung cấp máy chủ mã hóa) và cung cấp wrapper đẹp xung quanh các chức năng mã hóa/giải mã.

Hiện tại, các sản phẩm Office bị kẹt với VBA cũ (Visual Basic for Applications) dựa trên phiên bản VB6 cũ (và cũ hơn) của Visual Basic dựa trên COM, chứ không phải Khuôn khổ .NET.

Vì tất cả điều này, bạn sẽ cần phải gọi API Win32 để truy cập các hàm CSP hoặc bạn sẽ phải "mã hóa riêng của bạn" trong mã VB6/VBA thuần túy, mặc dù có thể kém an toàn hơn. Tất cả phụ thuộc vào cách "an toàn" bạn muốn mã hóa của mình.

Nếu bạn muốn "roll-của riêng bạn-" chuỗi thói quen mã hóa/giải mã cơ bản, hãy nhìn vào những liên kết để giúp bạn bắt đầu:

Encrypt a String Easily
Better XOR Encryption with a readable string
vb6 - encryption function
Visual Basic 6/VBA String Encryption/Decryption Function

Nếu bạn muốn truy cập API Win32 và sử dụng Windows CSP cơ bản (tùy chọn an toàn hơn), hãy xem các liên kết này để biết thông tin chi tiết về cách đạt được điều này:

How to encrypt a string in Visual Basic 6.0
Access to CryptEncrypt (CryptoAPI/WinAPI) functions in VBA

Đó liên kết cuối cùng là khả năng mà bạn vẫn muốn và bao gồm một module VBA Lớp hoàn chỉnh để "bọc" các chức năng của Windows CSP.

+0

Cảm ơn bạn rất nhiều! Giải thích rất chi tiết và một số liên kết hữu ích. Muốn tất cả các câu trả lời ở đây giống như của bạn. –

2

Tạo một Module Lớp gọi 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 

Bây giờ bạn có thể sử dụng nó trong mã của bạn:

để Cipher


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 

Để descipher


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 
0

Đây là một cơ bản symetric mã hóa/giải mã ví dụ:

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

    Dim enctrypted 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 

Hãy nhận biết rằng điều này sẽ sụp đổ nếu chuỗi đầu vào cho trước của bạn dài hơn SECRET_PASSWORD . Đây chỉ là một ví dụ để bắt đầu.

1

Bạn có thể gọi dữ liệu ô excel của ống thông qua bất kỳ tập lệnh shell nào. Cài đặt giao diện ngôn ngữ GPL Bert (http://bert-toolkit.com/) cho Excel. Sử dụng tập lệnh R bên dưới trong Excel để chuyển dữ liệu ô thành 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) 
    } 

Trong Excel, bạn có thể thử: C1 = CRYPTIT (A1, A2) và C2 = DECRYPTIT (C1, A2) Tùy chọn: putclip tiết kiệm văn bản giải mã trong clipboard. Cả hai loại chức năng là: String -> String. Thận trọng thông thường về việc thoát dấu nháy đơn trong các chuỗi được trích dẫn một lần.

0

Mã này hoạt động tốt đối với tôi (3DES Encryption/Decryption):

tôi lưu trữ INITIALIZATION_VECTOR và TRIPLE_DES_KEY như biến môi trường (rõ ràng giá trị khác với những đăng ở đây) và nhận được chúng sử dụng) chức năng (VBA Môi trường, vì vậy tất cả các dữ liệu nhạy cảm (mật khẩu) trong mã VBA được mã hóa.

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 

Source code lấy từ đây: https://gist.github.com/motoraku/97ad730891e59159d86c

Lưu ý sự khác biệt giữa các mã gốc và mã của tôi, đó là thêm tùy chọn encryption_object.Padding = 3 mà buộc VBA để không thực hiện đệm. Với tùy chọn padding được đặt thành 3 tôi nhận được kết quả chính xác như trong C++ thực hiện thuật toán DES_ede3_cbc_encrypt và đó là trong thỏa thuận với những gì được sản xuất bởi online tool này.

Các vấn đề liên quan