FreeBasic

Хороший пример шифрования строк с паролем.
Платформы: Windows , Linux
Автор: voodooattack, создано в 2006 году.

    
    'Option Explicit
    
    #INCLUDE "crt.bi"
    
    ' Seed/Hash type: 
    '
    '   valid datatypes: ubyte/ushort/uinteger/ulongint (keep it unsigned)
    '
    
    Type vcrypt_seed As Uinteger
    
    Const vcrypt_seed_max As vcrypt_seed = (2 ^ (Sizeof(vcrypt_seed) * 8)) - 1
    
'------------------------------------------------------------------------------
'//////////////////////////////////////////////////////////////////////////////
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    Function HexEncode(Byval Buffer As Ubyte Ptr, Byval length As Integer) As String
        Dim i As Integer
        Dim r As String
        Dim s As String = Space(2)
        For i = 0 To length - 1
            Rset s, Hex(Buffer[i])
            If s[0] = Asc(" ") Then s[0] = Asc("0")
            r += s
        Next
        Return r
    End Function

    Function EvSum(Byval Buffer As Ubyte Ptr, length As Integer) As Integer
        Dim i As Integer
        Dim l As Integer
        l = buffer[0]
        For i = 1 To length - 2
            l = (l Xor Buffer[i]) Xor (Not i) Xor ((Buffer[i+1] Xor Buffer[i-1] Xor Buffer[length-i-1]) Shl (i Mod (Sizeof(l) * 8)))
        Next
        
        l = l Xor length Xor buffer[length - 1]
        
        Return l
    End Function

    Function DeVCrypt(eBuffer As String, Key As String) As String
        
        If Len(Key) = 0 Then Return eBuffer
        
        Dim d           As vcrypt_seed
        Dim r           As String
        Dim t           As String * Sizeof(vcrypt_seed)
        Dim i           As Integer
        Dim c           As Ubyte
        Dim l           As Ubyte
        Dim s           As String
        Dim Buffer      As String


        t = (eBuffer)
        
        memcpy @d, Strptr(t), Sizeof(vcrypt_seed)

        Buffer = String(Len(eBuffer)-sizeof(d), 0)
        memcpy(Strptr(Buffer), Strptr(eBuffer)+sizeof(d), Len(eBuffer) - Sizeof(d))
        
        d = d Xor EvSum(Strptr(Buffer), Len(Buffer)) Xor EvSum(Strptr(Key), Len(Key))
        memcpy Strptr(t), @d , Sizeof(vcrypt_seed)
        
        r = Space(Len(Buffer))
        
        Randomize d
        
        l = Rnd * 255
        
        For i = 0 To Len(Buffer) - 1
            c = Buffer[i] Xor EvSum(Strptr(Key), Len(Key)) Xor Len(Buffer) Xor l
            
            r[i] = c
            
            l = c Or ((c Xor t[l Mod Sizeof(d)] And Not l) Xor Key[i Mod Len(Key)] _
            Xor Not EvSum(Strptr(t),Sizeof(d))) _
            Xor (Rnd * 255) And &HFF 
            
            l = l Xor EvSum(Strptr(Buffer),i)
            l = l And &HFF
        Next
        
        Return r
        
    End Function
    
    
    Function VCrypt_SeedInit(Key As String) As vcrypt_seed
        
        Static d As vcrypt_seed

        Randomize (Timer * 1000)
        
        If d = 0 Then d = Cast(vcrypt_seed, vcrypt_seed_max) 'init the seed
        
        d = d Shl (Rnd * 8)
        d = Rnd Or Not d Or (Timer Shr 24)

        Randomize (Timer)
        d = d Xor EvSum(Strptr(Key), Len(Key)) * Rnd
        d = Iif(Rnd > .5, d Shr Rnd * ((Sizeof(vcrypt_seed) * 8) \ 16) ,d Shl Rnd * ((Sizeof(vcrypt_seed) * 8) \ 16))
        
        Return d
        
    End Function
    
    Function VCrypt(Buffer As String, Key As String) As String
        
        If Len(Key) = 0 Then Return Buffer
        
        Randomize Timer
        
        Dim d           As vcrypt_seed 
        Dim eBuffer     As String
        Dim t           As String * Sizeof(vcrypt_seed)
        Dim i           As Integer
        Dim c           As Ubyte
        Dim l           As Ubyte
        
        d = VCrypt_SeedInit(Key)

        memcpy Strptr(t), @d, Sizeof(vcrypt_seed)
        
        eBuffer = Space(Len(Buffer))
        
        Randomize d
        
        l = Rnd * 255
        
        For i = 0 To Len(Buffer) - 1
            c = Buffer[i] Xor EvSum(Strptr(Key), Len(Key)) Xor Len(Buffer) Xor l            
            eBuffer[i] = c
            
            l = Buffer[i] Or ((Buffer[i] Xor t[l Mod Sizeof(d)] And Not l) _
                Xor Key[i Mod Len(Key)] Xor Not EvSum(Strptr(t),Sizeof(d))) _
                Xor (Rnd * 255) And &HFF
            l = l Xor EvSum(Strptr(eBuffer),i)
            l = l And &HFF
        Next
        
        d = d Xor EvSum(Strptr(eBuffer), Len(eBuffer)) Xor EvSum(Strptr(Key), Len(Key))
        
        eBuffer = String(Sizeof(d),0) & eBuffer
        memcpy Strptr(eBuffer), @d, Sizeof(vcrypt_seed)
        
        Return eBuffer 
        
    End Function

'------------------------------------------------------------------------------
'//////////////////////////////////////////////////////////////////////////////
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    #DEFINE USE_STATIC_KEY

    Dim Buffer      As String
    Dim Key         As String
    Dim eBuffer     As String
    Dim dBuffer     As String
    Dim hexCrypt    As String
    Dim t           As Double
    Dim t2          As Double
    Dim t3          As Double
    Dim t4          As Double
    
    'screen 18
    
    
    Do While Multikey(1) = 0 And inkey$ <> Chr(255,107)
        
        Locate 1,1,0
        
        
        
        Cls
            
        Buffer = "FreeBASIC pwns j00!"
        
        #IFDEF USE_STATIC_KEY
            Key = "STATIC_KEY"
        #ELSE
            Randomize Timer
            Key = "random key! #" & (Rnd * 9999999999 ^ Rnd)
        #ENDIF
        
        t = Timer
        eBuffer = VCrypt(Buffer, Key)
        t2 = Timer
        
        'try to corrupt anything ;)
        
        'Key = Left(Key, Len(Key) - 1)
        'swap eBuffer[rnd * len(eBuffer)], eBuffer[rnd * len(eBuffer)]
        
        hexCrypt = HexEncode(Strptr(eBuffer), Len(eBuffer))
        
        t3 = Timer
        dBuffer = DeVCrypt(eBuffer, Key)
        t4 = Timer
        
        Print
        Print
        Print "  Original String: " & """" &  Buffer  & """" 
        Print "              Key: " & """" &  Key  & """"
        Print " Encrypted String: " & """" &  hexCrypt & """" 
        Print " Decrypted String: " & """" &  dBuffer  & """" 
        Print
        Print "           Intact: " & *iif((dBuffer = Buffer), @"Yes", @"No") 
        Print " Encrypted Length: " & Len(eBuffer) & Space(5)
        Print "  Original Length: " & Len(Buffer) & Space(5)
        Print "       Difference: " & Len(eBuffer) - Len(Buffer) 
        Print "  Encryption Time: " & Cuint(t2 - t) & " Seconds" 
        Print "  Decryption Time: " & Cuint(t4 - t3) & " Seconds"
        Print
        Print
        Print " Press ESC to exit..";
        
        Sleep 10
        
        If dBuffer <> Buffer Then Sleep
        
    Loop