Cube system

Description

Algorythme de chiffrement a clef symétrique

mdlCube.bas:
-CLoad(filename)
-CCrypt(Password)
-CSave(filename)

Source / Exemple :


' +--------------------------------------+
' |        CUBE SYSTEM 64b               |
' +--------------------------------------+
' |        By Synfonia - Evildark Europe |
' | Algorithme de chiffrement symétrique |
' |(c)opyright 2009, all rights réserved |
' +--------------------------------------+
'
Option Explicit
Dim File() As Byte
Private Filesize As Long
Public Progress As Integer
'
Public Sub CLoad(Filename As String)
On Error Resume Next
Open Filename For Binary Access Read As #1
    Filesize = LOF(1)
    ReDim File(1 To Filesize)
    Get #1, , File()
Close #1
End Sub
'
Public Sub CSave(Filename As String)
On Error Resume Next
Open Filename For Binary Access Write As #1
    Put #1, , File()
Close #1
End Sub
'
Public Sub CCrypt(Password As String)
On Error Resume Next
Dim MATRIX(1 To 8, 1 To 8, 1 To 2) As Byte
Dim X As Integer
Dim Y As Integer
Dim Z As Long
Dim N As Long
Dim TMP As String
' Initialisation.
For X = 1 To 8
For Y = 1 To 8
    MATRIX(X, Y, 1) = Asc(0)
    MATRIX(X, Y, 2) = Asc(0)
Next: Next
' Boucle -----------------
For Z = 0 To Filesize Step 8
    ' Vérification de la taille.
    If (Z + 8) > Filesize Then
        N = Filesize - Z
    Else
        N = 8
    End If
    ' Chargement dun bloc de 64bits.
    For X = 1 To N
    For Y = 1 To 8
        MATRIX(X, Y, 1) = Asc(Mid$(DecBin(Val(File(Z + X))), Y, 1))
        MATRIX(Y, X, 2) = Asc(Mid$(DecBin(Asc(Mid$(Password, ((Z + X) Mod Len(Password)) + 1, 1))), Y, 1))
    Next: Next
    ' Chiffrement du bloc de 64bits.
    For Y = 1 To 8
    For X = 1 To 8
        MATRIX(X, Y, 1) = MATRIX(X, Y, 1) Xor MATRIX(X, Y, 2)
        MATRIX(X, Y, 2) = Asc(0)
    Next: Next
    ' Déchargement du bloc.
    TMP = ""
    For X = 1 To N
    For Y = 1 To 8
        TMP = TMP & MATRIX(X, Y, 1)
        MATRIX(X, Y, 1) = Asc(0)
        If Y = 8 Then
            File(Z + X) = BinDec(TMP)
            TMP = ""
        End If
    Next: Next
    ' Calcul du pourcentage restant.
    DoEvents
    Progress = Int((Z * 100) / Filesize)
Next
Progress = 100
End Sub
'
Private Function BinDec(Bin As String) As Long
' Séquence bits en octet.
Bin = Format(Bin, "00000000")
BinDec = (Val(Mid$(Bin, 1, 1)) * 128) + (Val(Mid$(Bin, 2, 1)) * 64) + _
(Val(Mid$(Bin, 3, 1)) * 32) + (Val(Mid$(Bin, 4, 1)) * 16) + _
(Val(Mid$(Bin, 5, 1)) * 8) + (Val(Mid$(Bin, 6, 1)) * 4) + _
(Val(Mid$(Bin, 7, 1)) * 2) + Val(Mid$(Bin, 8, 1))
End Function
'
Private Function DecBin(Dec As Long) As String
' Séquence octet en bits.
If Dec < 0 Then Dec = 0
If Dec > 255 Then Dec = 255
Dim Bit1 As Long, Bit2 As Long, Bit3 As Long, Bit4 As Long, Bit5 As Long, Bit6 As Long, Bit7 As Long, Bit8 As Long
' Bit1
Bit1 = Int(Dec / 128)
Dec = Dec - (Bit1 * 128)
' Bit2
Bit2 = Int(Dec / 64)
Dec = Dec - (Bit2 * 64)
' Bit3
Bit3 = Int(Dec / 32)
Dec = Dec - (Bit3 * 32)
' Bit4
Bit4 = Int(Dec / 16)
Dec = Dec - (Bit4 * 16)
' Bit5
Bit5 = Int(Dec / 8)
Dec = Dec - (Bit5 * 8)
' Bit6
Bit6 = Int(Dec / 4)
Dec = Dec - (Bit6 * 4)
' Bit7
Bit7 = Int(Dec / 2)
Dec = Dec - (Bit7 * 2)
' Bit8
Bit8 = Int(Dec)
DecBin = Bit1 & Bit2 & Bit3 & Bit4 & Bit5 & Bit6 & Bit7 & Bit8
End Function

Conclusion :


Voir le zip ;)

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.