VB6 text verschlüsseln mit Kennwort

Ich bin mit RC4 Implementierung sieht

Option Explicit

Private Sub Command1_Click()
    Dim sSecret     As String

    sSecret = ToHexDump(CryptRC4("a message here", "password"))
    Debug.Print sSecret
    Debug.Print CryptRC4(FromHexDump(sSecret), "password")
End Sub

Public Function CryptRC4(sText As String, sKey As String) As String
    Dim baS(0 To 255) As Byte
    Dim baK(0 To 255) As Byte
    Dim bytSwap     As Byte
    Dim lI          As Long
    Dim lJ          As Long
    Dim lIdx        As Long

    For lIdx = 0 To 255
        baS(lIdx) = lIdx
        baK(lIdx) = Asc(Mid$(sKey, 1 + (lIdx Mod Len(sKey)), 1))
    Next
    For lI = 0 To 255
        lJ = (lJ + baS(lI) + baK(lI)) Mod 256
        bytSwap = baS(lI)
        baS(lI) = baS(lJ)
        baS(lJ) = bytSwap
    Next
    lI = 0
    lJ = 0
    For lIdx = 1 To Len(sText)
        lI = (lI + 1) Mod 256
        lJ = (lJ + baS(lI)) Mod 256
        bytSwap = baS(lI)
        baS(lI) = baS(lJ)
        baS(lJ) = bytSwap
        CryptRC4 = CryptRC4 & Chr$((pvCryptXor(baS((CLng(baS(lI)) + baS(lJ)) Mod 256), Asc(Mid$(sText, lIdx, 1)))))
    Next
End Function

Private Function pvCryptXor(ByVal lI As Long, ByVal lJ As Long) As Long
    If lI = lJ Then
        pvCryptXor = lJ
    Else
        pvCryptXor = lI Xor lJ
    End If
End Function

Public Function ToHexDump(sText As String) As String
    Dim lIdx            As Long

    For lIdx = 1 To Len(sText)
        ToHexDump = ToHexDump & Right$("0" & Hex(Asc(Mid(sText, lIdx, 1))), 2)
    Next
End Function

Public Function FromHexDump(sText As String) As String
    Dim lIdx            As Long

    For lIdx = 1 To Len(sText) Step 2
        FromHexDump = FromHexDump & Chr$(CLng("&H" & Mid(sText, lIdx, 2)))
    Next
End Function

Command1 Ausgänge:

9ED5556B3F4DD5C90471C319402E
a message here

Müssen Sie möglicherweise eine bessere Fehlerbehandlung auf FromHexDump obwohl.

Update (2018-05-04)

Für viel stärkeren 256-bit AES-Verschlüsselung (ECB-Modus) und den richtigen Umgang mit unicode-Texten/Kennwörter, die Sie heraus überprüfen können Einfache AES-256-bit-Passwort-Verschlüsselung geschützt umgesetzt, in mdAesEcb.bas - Modul (~380 LOC).

InformationsquelleAutor wqw

Hier ist meine Verschlüsselung. Klasse. Ich benutze mehrere Konstanten zu definieren, die Verschlüsselung Schlüssel, weil in meinem Kopf es ist ein wenig sicherer aus, dass jemand versucht, zu dekompilieren, der code um es zu finden. Kryptographie ist nicht mein Ding, also vielleicht bin ich ein Scherz mich. Jedenfalls habe ich diese Klasse in eine ActiveX-dll-Aufruf aus anderen Programmen zu tun, die Verschlüsselung und die Rückseite in eine eigene dll für die Entschlüsselung. Ich habe es auf diese Weise also Menschen wer sollte nicht sehen, dass die verschlüsselten Daten nicht selbst habe die dll zu tun, die Sie entschlüsseln. Ändern Sie die key-Konstanten, was Sie wollen (5 lange). Ich benutze einen mix einschließlich nicht druckbarer Zeichen und es hat gut funktioniert für mich bisher. Die CAPICOM ist Teil von Windows®, so dass Sie nicht haben, zu verteilen.

Option Explicit

Private m_oENData As CAPICOM.EncryptedData

'combine these constants to build the encryption key
Private Const KEY1 = "12345"
Private Const KEY2 = "67890"
Private Const KEY3 = "abcde"
Private Const KEY4 = "fghij"
Private Const KEY5 = "klmno"

Private Sub Class_Initialize()

   On Error Resume Next

   Set m_oENData = New CAPICOM.EncryptedData
   If Err.Number <> 0 Then
      If Err.Number = 429 Then
         Err.Raise Err.Number, App.EXEName, "Failed to create the capi com object. " & _
               "Check that the capicom.dll file is installed and properly registered."
      Else
         Err.Raise Err.Number, Err.Source, Err.Description
      End If
   End If

End Sub

Private Sub Class_Terminate()

   Set m_oENData = Nothing

End Sub

Public Function EncryptAsBase64(ByVal RawString As String) As String
   EncryptAsBase64 = Encrypt(RawString, CAPICOM_ENCODE_BASE64)
End Function

Public Function EncryptAsBinary(ByVal RawString As String) As String
   EncryptAsBinary = Encrypt(RawString, CAPICOM_ENCODE_BINARY)
End Function

Private Function Encrypt(ByVal s As String, ByVal EncryptionType As CAPICOM.CAPICOM_ENCODING_TYPE) As String
   Dim oEN As New CAPICOM.EncryptedData
   Dim intENCType As CAPICOM.CAPICOM_ENCRYPTION_ALGORITHM
   Dim strSecret As String
   Dim intTries As Integer

   On Error GoTo errEncrypt

   intENCType = CAPICOM_ENCRYPTION_ALGORITHM_AES ' try this first and fall back if not supported

   With oEN
startEncryption:
      .Algorithm = intENCType
      strSecret = KEY2 & KEY5 & KEY4 & KEY1 & KEY3
      .SetSecret strSecret
      strSecret = ""
      .Content = s
      ' the first encryption type needs to be base64 as the .content property
      ' can loose information if I try to manipulate a binary string
      .Content = StrReverse(.Encrypt(CAPICOM_ENCODE_BASE64))
      strSecret = KEY1 & KEY4 & KEY3 & KEY2 & KEY5
      .SetSecret strSecret
      strSecret = ""
      Encrypt = .Encrypt(EncryptionType)
   End With

   Set oEN = Nothing

   Exit Function

errEncrypt:
   If Err.Number = -2138568448 Then
      ' if this is the first time the step the encryption back and try again
      If intTries < 1 Then
         intTries = intTries + 1
         intENCType = CAPICOM_ENCRYPTION_ALGORITHM_3DES
         Resume startEncryption
      End If
   End If

   Err.Raise Err.Number, Err.Source & ":Encrypt", Err.Description
   strSecret = ""
   Set oEN = Nothing

End Function

InformationsquelleAutor jac