CUBE SYSTEM

' +--------------------------------------+
' |        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