问分形加密

EN

E(M(j), k) --> X(j)

E'(X(j), k) --> M(j)

( M(j) XOR k ) --> X(j)  *and also* ( X(j) XOR k ) --> M(j)

M(j) XOR K(j) --> X(j)

X(j) XOR K(j) --> M(j)

H(MK, j) --> K(j);  M(j) XOR K(j) --> X(j)

H(MK, j) --> K(j);  X(j) XOR K(j) --> M(j)

Option Explicit On

Public Class FractalEncrypt
'Fractal Encryption / Decryption demo class'
' 2009-08-08    RBarryYoung Created.'
' note: '
'   Property of R. Barry Young & Proactive Performance Solutions, Inc.,'
'   protected under open source license'
Public Const CrLower As Double = 0.1
Public Const CrUpper As Double = Math.PI / (2 * Math.E)
Public Const CiLower As Double = 0.1
Public Const CiUpper As Double = Math.PI / (2 * Math.E)

Public ReadOnly Cr As Double, Ci As Double, Sr As Double, Si As Double
Public ReadOnly BaseSeq As Integer

Public Sub New(ByVal KeyR As Double, ByVal KeyI As Double, ByVal SaltR As Double _
        , ByVal SaltI As Double, ByVal SeqStart As Integer)
    Cr = ((KeyR - CrLower) Mod (CrUpper - CrLower)) + CrLower
    Ci = ((KeyI - CiLower) Mod (CiUpper - CiLower)) + CiLower

    Sr = ((SaltR - CrLower) Mod (CrUpper - CrLower)) + CrLower
    Si = ((SaltI - CiLower) Mod (CiUpper - CiLower)) + CiLower

    BaseSeq = SeqStart
End Sub

Public Function Encrypt(ByVal Text As String, ByVal Seq As Integer) As String
    'Encrypt the string passed, adding on the sequence as a header.'
    Debug.Print("Encrypt<" & Seq & ">" & Len(Text) & ":" & Text)
    Dim CurSeq = BaseSeq + Seq
    'make the sequence prefix'
    Dim enc As String = Format(Seq, "000000000") & ":"

    Dim EncryptedOffset As Integer = 0
    Do While EncryptedOffset < Len(Text)
        'encrypt each 4 characters separately'
        enc = enc & Encrypt4(Text, EncryptedOffset, CurSeq)
        EncryptedOffset = EncryptedOffset + 4
    Loop

    Return enc
End Function

Public Function Decrypt(ByVal CrypText As String) As String
    'Decrypt the string passed, extracting the Sequence header first.'

    'Extract the sequence'
    Dim Seq As Integer = CInt(Left(CrypText, 9))
    Dim CurSeq = BaseSeq + Seq

    'Extract the encrypted message payload'
    CrypText = Mid(CrypText, 11)
    Debug.Print("Decrypt<" & Seq & ">" & Len(CrypText) & ":" & CrypText)

    'Now decrypt it 4 characters at a time'
    Dim txt As String = ""
    Dim EncryptedOffset As Integer = 0
    Do While EncryptedOffset < Len(CrypText)
        'encrypt each 4 characters separately'
        txt = txt & Encrypt4(CrypText, EncryptedOffset, CurSeq)
        EncryptedOffset = EncryptedOffset + 4
    Loop

    Return txt
End Function

Public Function Encrypt4(ByVal text As String, ByVal StrOffs As Integer _
        , ByVal CurSeq As Integer) As String
    'Encrypt/Decrypt 4 characters of the string.'
    ' (note: encrypt and decrypt are the same because XOR is its own complement)'
    Dim str As String = Mid(text, StrOffs + 1, 4)
    Dim enc As String

    'generate the seeds from the current message sequence and the current string offset'
    '1.   define complex Seq as (CurSeq, StrOffs)'
    Dim SeedR As Double = (Sr * CurSeq) - (Si * StrOffs)
    Dim SeedI As Double = (Sr * StrOffs) + (Si * CurSeq)
    '2.   remap the result back into the valid range'
    SeedR = SeedR Mod (CrUpper - CrLower)
    SeedI = SeedI Mod (CiUpper - CiLower)

    'generate the local keys from the master keys'
    Dim Zr As Double = SeedR, Zi As Double = SeedI
    Dim r As Double, i As Double, zx As Integer = 0, zy As Integer = 0
    '1.  apply the julia formula 16 times to hash it up good.'
    For j As Integer = 1 To 16
        'Z(n+1) = Z(n)^2 - C:'
        r = Zr * Zr - Zi * Zi - Cr
        i = 2 * Zr * Zi - Ci
        If Double.IsInfinity(r) Or Double.IsNaN(r) Then r = (zx \ zy) 'force an error'
        If Double.IsInfinity(i) Or Double.IsNaN(i) Then i = (zx \ zy) 'force an error'
        'put back into Z:'
        Zr = r : Zi = i
    Next
    '2.  remap the back into our results window'
    Zr = ((Zr - CrLower) Mod (CrUpper - CrLower)) + CrLower
    Zi = ((Zi - CiLower) Mod (CiUpper - CiLower)) + CiLower

    'Form the local keys into the Mask Keys variables (M).'
    Dim Mr As Integer, Mi As Integer
    '1.  scale them both into the range of about 2^30.'
    Mr = CInt((1024 * 1024 * 1024) * (Zr - CrLower) / (CrUpper - CrLower))
    Mi = CInt((1024 * 1024 * 1024) * (Zi - CiLower) / (CiUpper - CiLower))
    '2.  only use the lower 16 bits that are left:'
    Mr = Mr And 65535 : Mi = Mi And 65535

    'encode the current 4 characters as a 2 * 2-byte integer'
    Dim R2 As Integer, I2 As Integer
    If StrOffs + 1 <= Len(text) Then R2 = Asc(Mid(text, StrOffs + 1, 1))
    If StrOffs + 2 <= Len(text) Then R2 = R2 + 256 * Asc(Mid(text, StrOffs + 2, 1))
    If StrOffs + 3 <= Len(text) Then I2 = Asc(Mid(text, StrOffs + 3, 1))
    If StrOffs + 4 <= Len(text) Then I2 = I2 + 256 * Asc(Mid(text, StrOffs + 4, 1))

    'Encrypt (or Decrypt) the data by masking it with the local Keys'
    R2 = R2 Xor Mr
    I2 = I2 Xor Mi

    'recode them as ascii strings again:'
    enc = Chr(R2 And 255) & Chr(R2 \ 256) & Chr(I2 And 255) & Chr(I2 \ 256)

    Return enc
End Function
End Class