VB6パスワードを使用してテキストを暗号化

Question

単純なテキストの暗号化/復号化VB6コードをお探しですか？理想的には、解決策は(text, password)引数を受け入れ、（特殊文字を使用せずに）読み取り可能な出力を生成する必要があるため、エンコードの問題が発生しなければどこでも使用できます。

.NET用のコードはたくさんありますが、従来のVB6ではそれほど多くはありません。 http://www.devx.com/vb2themax/Tip/19211

Answer 1

私はこの本

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出力のようなRC4の実装を使用しています：

9ED5556B3F4DD5C90471C319402E 
a message here 

あなたはしかしFromHexDumpに優れたエラー処理が必要になる場合があります。

Answer 2

MD5sum一方向ハッシュとしてのテキストとパスワードを一緒にして（チェックして、再度暗号化して保存されたハッシュと比較します（これはあなたがしかし、もう一度解読する必要があります）

Answer 3

ここに私の暗号化クラスがあります。私は暗号化キーを定義するためにいくつかの定数を使用しています。とにかく、私はこのクラスを他のプログラムから呼び出されたActiveX 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