it-swarm.com.de

Zeichenfolgen in Excel verschlüsseln und entschlüsseln

Ich bin interessiert, ob es möglich ist, Zeichenfolgen mit Excel Visual Basic und einem Kryptografiedienstanbieter zu verschlüsseln oder zu entschlüsseln.

Ich habe eine exemplarische Vorgehensweise gefunden Verschlüsseln und Entschlüsseln von Zeichenfolgen in Visual Basic , aber es scheint, dass es nur für eigenständige Visual Basic gültig ist.

Würden Sie mir eine andere Verschlüsselungsmethode vorschlagen oder zeigen, wie die exemplarische Vorgehensweise für Excel Visual Basic übernommen werden kann?

12

Der von Ihnen bereitgestellte Link zeigt, wie Sie die Zeichenfolgenverschlüsselung und -entschlüsselung mit VB.NET und damit mit .NET Framework durchführen.

Derzeit können Microsoft Office-Produkte die Komponente Visual Studio Tools für Applikationen noch nicht verwenden, mit der Office-Produkte auf die BCL (Basisklassenbibliotheken) von .NET Framework zugreifen können, die wiederum auf den zugrunde liegenden Windows CSP (Kryptografieserver-Anbieter) zugreifen ) und bieten einen Nizza Wrapper um diese Verschlüsselungs-/Entschlüsselungsfunktionen.

Zur Zeit stecken Office-Produkte in der alten VBA ( Visual Basic für Applikationen ), die auf der alten VB6-Version (und früheren Versionen) von Visual Basic basiert, die auf COM und nicht auf .NET Framework basiert .

Aus diesem Grund müssen Sie entweder die Win32-API aufrufen, um auf die CSP-Funktionen zuzugreifen, oder Sie müssen eine eigene Verschlüsselungsmethode in reinem VB6/VBA-Code erstellen, obwohl dies wahrscheinlich der Fall ist weniger sicher. Es hängt alles davon ab, wie "sicher" Ihre Verschlüsselung sein soll.

Wenn Sie die grundlegende Verschlüsselungs-/Entschlüsselungsroutine für Zeichenfolgen selbst erstellen möchten, sehen Sie sich diesen Link an, um zu beginnen:

Einen String einfach verschlüsseln
Besser XOR Verschlüsselung mit einer lesbaren Zeichenfolge
vb6 - Verschlüsselungsfunktion
Visual Basic 6/VBA-String-Verschlüsselungs Entschlüsselungsfunktion - /

Wenn Sie auf die Win32-API zugreifen und den zugrunde liegenden Windows CSP (eine viel sicherere Option) verwenden möchten, finden Sie unter diesen Links detaillierte Informationen dazu, wie Sie dies erreichen:

So verschlüsseln Sie eine Zeichenfolge in Visual Basic 6.0
Zugriff auf CryptEncrypt (CryptoAPI/WinAPI) -Funktionen in VBA

Dieser letzte Link ist wahrscheinlich der, den Sie möchten, und enthält ein vollständiges VBA-Klassenmodul, um die Windows CSP-Funktionen zu "umbrechen".

22
CraigTP

Erstellen Sie ein Klassenmodul mit dem Namen 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

Jetzt können Sie es in Ihrem Code verwenden:

zu beziffern


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

Zu entziffern


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
user3407604

Sie können Pipe-Excel-Zellendaten über ein beliebiges Shell-Skript aufrufen. Installieren Sie die GPL Bert ( http://bert-toolkit.com/ ) R-Sprachschnittstelle für Excel. Verwenden Sie die R-Skript unten in Excel, um Zellendaten an Bash/Perl/gpg/openssl weiterzuleiten.

 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)  
  } 

In Excel können Sie versuchen: C1 = CRYPTIT (A1, A2) und C2 = DECRYPTIT (C1, A2) Optional: putclip speichert entschlüsselten Text in der Zwischenablage. Beide Funktionstypen sind: String - > String. Übliche Vorsichtsmaßnahmen, um einfache Anführungszeichen in einfach zitierten Strings zu umgehen.

1
mosh

Dieser Code funktioniert gut für mich (3DES-Verschlüsselung/Entschlüsselung):  

Ich speichere INITIALIZATION_VECTOR und TRIPLE_DES_KEY als Umgebungsvariablen (offensichtlich andere Werte als die hier angegebenen) und erhalte sie mithilfe der VBA Environ () -Funktion, sodass alle vertraulichen Daten (Passwörter) im VBA-Code verschlüsselt werden.

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

Der Quellcode stammt von hier: https://Gist.github.com/motoraku/97ad730891e59159d86c

Beachten Sie den Unterschied zwischen dem Originalcode und meinem Code. Dies ist die zusätzliche Option encryption_object.Padding = 3 , die VBA zwingt, keine Auffüllung durchzuführen. Wenn die Auffülloption auf 3 gesetzt ist, erhalte ich das Ergebnis genau wie bei der C++ - Implementierung des DES_ede3_cbc_encrypt-Algorithmus und was mit dem übereinstimmt, was von diesem Online-Tool erzeugt wird. 

0
OGCJN

Hier ist ein einfaches Beispiel für symmetrische Verschlüsselung/Entschlüsselung:

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

Beachten Sie, dass dies abstürzt, wenn die angegebene Eingabezeichenfolge länger als SECRET_PASSWORD ist. Dies ist nur ein Beispiel für den Einstieg.

0
CodeKid

Dieser Code funktioniert in VBA einwandfrei und kann problemlos in VB.NET verschoben werden

Vermeidet den Umgang mit nicht "normalen" Zeichen. Sie entscheiden in AllowedChars, welche Zeichen zulässig sind.

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
0
user3579314