Cube system

Soyez le premier à donner votre avis sur cette source.

Vue 5 007 fois - Téléchargée 337 fois

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

Ajouter un commentaire

Commentaires

Messages postés
51
Date d'inscription
dimanche 11 décembre 2005
Statut
Membre
Dernière intervention
11 octobre 2014

Les données et le pass sont regrouper en bloc 64bits (8 caracteres), puis leurs bits sont stocker dans des matrices 8x8bits.
Ensuite on decale la matrice du pass de 90° et on Xor les deux tableau entre eux.

Sa évite la redondance d'un simple> A Xor B = C
en créant un chainage au niveau des bits et non seulement au niveau d'un octet,

Il est clair que le traitement peut etre améliorer, je vais voir aussi pour ajouter un chono TickCount pour voir les performance entre les différante méthodes
A+ et merci pour vos idées
Messages postés
146
Date d'inscription
dimanche 23 janvier 2005
Statut
Membre
Dernière intervention
17 novembre 2009

En plus des remarques précédentes je rajouterai pourquoi mettre les fonctions DecBin et BinDec en private dans un module et les appeler par "mdlCube.xxx" autant les mettre dans la Form1, ou les passer en public, de même pour les autres fonctions (en public celles-ci) qui sont appelées par "mdlCube.xxx" !!

Pour les conversions BIN et DEC, je propose:

Public Function BinDec(Bin As String) As Long
Dim i as Integer

BinDec = 0
For i = Len(Bin) To 1 Step -1
If Mid$(Bin, i, 1) "1" Then BinDec BinDec + 2 ^ (Len(Bin) - i)
Next i

End Function
'*******************************************

Public Function DecBin(Dec As Long) As String

If Dec <= 0 Then
DecBin = "00000000"
Exit Function
End If

DecBin = ""
While Dec > 0
DecBin = CStr(Dec Mod 2) & DecBin
Dec = Dec \ 2
Wend

' pour utiliser les 8 bits dans le contexte présent
DecBin = Format(DecBin, "00000000")

End Function

Je ne ferai pas de commentaires sur le mode de crypage, il faut que je l'étudie un peu plus profondément, mais le résulat semble assez "chinois" à décrypter !

@+
Messages postés
2501
Date d'inscription
jeudi 14 juillet 2005
Statut
Contributeur
Dernière intervention
5 juin 2016
1
Evidemment tu peux les adapter pour travailler sur des longs, si tu veux.
Messages postés
2501
Date d'inscription
jeudi 14 juillet 2005
Statut
Contributeur
Dernière intervention
5 juin 2016
1
Tes fonctions BinDec et DecBin sont NULLES.
(à mettre dans mod_BaseConv.bas) :

Option Explicit
Public Const Charset As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Public Function DecToBase(Number As Integer, Base As Byte) As String
Dim Rest As Integer, Result As String
If Base > 36 Then Exit Function
Do
Rest = Number Mod Base
Number = Number \ Base
Result = Mid(Charset, Rest + 1, 1) & Result
Loop While Number > 0
BaseConv = Result
End Function

Public Function BaseToDec(Number As String, Base As Byte) As Integer
Dim Position As Integer, Position2 As Integer, Result As Integer
Dim Current As Byte
If Base > 36 Then Exit Function
Position = 1
Do
Current = InStr(1, Charset, Mid(Number, Position, 1), vbTextCompare) - 1
Position2 = Len(Number) - Position
Result = Result + (Current * Base ^ Position2)

Position = Position + 1
Loop While Position <= Len(Number)
BaseToDec = Result
End Function
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
62
Asc(0) ? pourquoi ne pas mettre 0 direct ?

Bit6 = Int(Dec / 4)
preferer
Bit6 = (Dec \ 4)

mais DecBin et BinDec sont pas optimales, me semble...

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.