VB6使用密碼加密文本

Question

尋找簡單的文本加密/解密VB6代碼。理想情況下，該解決方案應接受(text, password)參數並生成可讀輸出（不包含任何特殊字符），因此可在任何地方使用，而無需編碼問題。

.NET有很多可用的代碼，但對於傳統的VB6我可以找到很多代碼。只有這我找到迄今爲止：http://www.devx.com/vb2themax/Tip/19211

Answer 1

我使用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 

Command1輸出這樣的：

9ED5556B3F4DD5C90471C319402E 
a message here 

您可能需要更好的錯誤處理上FromHexDump雖然。

Answer 2

MD5sum文本和密碼一起作爲單向散列（然後檢查，你再次加密，並與存儲的散列進行比較。（這不會工作，如果你必須重新解密它）

Answer 3

這裏是我的加密類，我使用幾個常量來定義加密密鑰，因爲在我看來，它有點更安全，有人試圖反編譯代碼來找到它加密不是我的東西所以也許我在開玩笑吧，無論如何，我在其他程序調用的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