string VB6 使用密码加密文本

VB6 encrypt text using password

提问by SharpAffair

Looking for a simple text encryption/decryption VB6 code. Ideally, the solution should accept (text, password)arguments and produce readable output (without any special characters), so it can be used anywhere without encoding issues.

寻找一个简单的文本加密/解密 VB6 代码。理想情况下，解决方案应该接受(text, password)参数并产生可读的输出（没有任何特殊字符），因此它可以在任何地方使用而不会出现编码问题。

There are lots of code available for .NET, but not really much I can find for legacy VB6. Only this I've found so far: http://www.devx.com/vb2themax/Tip/19211

有很多可用于 .NET 的代码，但对于旧版 VB6，我能找到的代码并不多。到目前为止我只找到了这个：http: //www.devx.com/vb2themax/Tip/19211

回答by wqw

I'm using RC4 implementation like this

我正在使用这样的 RC4 实现

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

Command1outputs this:

Command1输出这个：

9ED5556B3F4DD5C90471C319402E
a message here

You might need better error handling on FromHexDumpthough.

不过，您可能需要更好的错误处理FromHexDump。

Update (2018-05-04)

更新 (2018-05-04)

For much stronger AES 256-bit encryption (in ECB mode) and proper handling of unicode texts/passwords you can check out Simple AES 256-bit password protected encryptionas implemented in mdAesEcb.basmodule (~380 LOC).

对于更强大的 AES 256 位加密（在 ECB 模式下）和正确处理 unicode 文本/密码，您可以查看模块中实现的简单 AES 256 位密码保护加密mdAesEcb.bas（~380 LOC）。

回答by Deanna

MD5sum the the text and password together as a one way hash (and then to check, you encrypt again and compare with the stored hash. (This won't work if you MUST decrypt it again though)

MD5sum 文本和密码作为一种单向哈希（然后检查，你再次加密并与存储的哈希进行比较。（如果你必须再次解密，这将不起作用）

回答by jac

Here's my encryption class. I use several constants to define the encryption key because in my mind it's a little more secure from someone trying to decompile the code to find it. Cryptography isn't my thing so maybe I'm kidding myself. Anyway, I used this class in an ActiveX dll called from other programs to do encryption and the reverse in a separate dll for decryption. I did it this way so people who shouldn't be seeing encrypted data don't even have the dll to do the decrypting. Change the key constants to what you want (5 long). I use a mix including unprintable characters and it has worked well for me so far. The CAPICOMis part of Windows® so you don't have to distribute.

这是我的加密课程。我使用几个常量来定义加密密钥，因为在我看来，有人试图反编译代码以找到它会更安全一些。密码学不是我的专业，所以也许我是在开玩笑。无论如何，我在从其他程序调用的 ActiveX dll 中使用了这个类来进行加密，并在一个单独的 dll 中进行反向解密。我这样做是为了让那些不应该看到加密数据的人甚至没有 dll 来进行解密。将键常量更改为您想要的（5 长）。我使用了一个包含不可打印字符的组合，到目前为止它对我来说效果很好。该CAPICOM为Windows的，所以你不必分配部分。

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