Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Ce site au démarrage

begin process at 2013 06 19 00:30:15

Accueil Codes Tutoriels Forum Livres Emploi Services Connexion

Trouver un code source :

dans

[ Dernières recherches ]

Accueil >

Maths

> ALGORITHME AES (ADVANCED ENCRYPTION STANDARD) SUR VISUAL BASIC 6

ALGORITHME AES (ADVANCED ENCRYPTION STANDARD) SUR VISUAL BASIC 6

Information sur la source

Note :
Aucune note

Catégorie :Maths Classé sous :AES, VB6, GF28 Niveau :Débutant Date de création :08/06/2012 Vu / téléchargé :1 959 / 166

Auteur : laaraj11

Ecrire un message privé

Commentaire sur cette source (4)

Ajouter un commentaire et/ou une note

Description

Cliquez pour voir la capture en taille normale

Ceci est un programme qui utilise le chiffrement AES (devenu standard depuis 2001). Il prend en entrée un bloc de 128 bits (16 octets) et utilise une clé de 128 bits. Les 16 octets en entrée sont permutés selon une table définie au préalable. Ces octets sont ensuite placés dans une matrice de 4x4 éléments et ses lignes subissent une rotation vers la droite. L'incrément pour la rotation varie selon le numéro de la ligne. Une transformation linéaire est ensuite appliquée sur la matrice, elle consiste en la multiplication binaire de chaque élément de la matrice avec des polynômes issus d'une matrice auxiliaire, cette multiplication est soumise à des règles spéciales selon GF(28) (groupe de Galois ou corps fini). La transformation linéaire garantit une meilleure diffusion (propagation des bits dans la structure) sur plusieurs tours.

Source

'module.bas
'-----------------------------------------------------------
Public Function NoSpace(mystr As String) As String
a = 0: tmp = "": c = "": NoSpace = ""
For a = 1 To Len(mystr)
c = Mid(mystr, a, 1)
If Asc(c) <> 32 Then tmp = tmp & c Else
Next
NoSpace = tmp
End Function
Public Function AES_Encrypt(PlainText, AES_KEY)
Dim ExtendedKey, Key_i, DATA_i, After_XOR, SubBytes, SubBytes_TAB, ShiftRows, ShiftRows_TAB, MixColumns
ExtendedKey = GenKey(AES_KEY)
DATA_i = PlainText
1
i = i + 1
Key_i = Mid(ExtendedKey, 32 * (i - 1) + 1, 32)
After_XOR = XXOR_HEX(DATA_i, Key_i)
SubBytes_TAB = "637c777bf26b6fc53001672bfed7ab76ca82c97dfa5947f0add4a2af9ca472c0b7fd9326363ff7cc34a5e5f171d8311504c723c31896059a071280e2eb27b27509832c1a1b6e5aa0523bd6b329e32f8453d100ed20fcb15b6acbbe394a4c58cfd0efaafb434d338545f9027f503c9fa851a3408f929d38f5bcb6da2110fff3d2cd0c13ec5f974417c4a77e3d645d197360814fdc222a908846eeb814de5e0bdbe0323a0a4906245cc2d3ac629195e479e7c8376d8dd54ea96c56f4ea657aae08ba78252e1ca6b4c6e8dd741f4bbd8b8a703eb5664803f60e613557b986c11d9ee1f8981169d98e949b1e87e9ce5528df8ca1890dbfe6426841992d0fb054bb16"
SubBytes = Mask(After_XOR, SubBytes_TAB)
ShiftRows_TAB = "00050A0F04090E03080D02070C01060B"
ShiftRows = FxPermu(SubBytes, ShiftRows_TAB)
If i = 10 Then MixColumns = XXOR_HEX(ShiftRows, Right(ExtendedKey, 32)) Else MixColumns = fx_GF28(ShiftRows, 0)
If i <= 9 Then DATA_i = MixColumns: GoTo 1 Else
AES_Encrypt = MixColumns
End Function
Public Function AES_Decrypt(CipherText, AES_KEY)
Dim ExtendedKey, Key_i, DATA_i, After_XOR, SubBytes, SubBytes_TAB, ShiftRows, ShiftRows_TAB, MixColumns
ExtendedKey = GenKey(AES_KEY)
DATA_i = CipherText
1
i = i + 1
Key_i = Mid(ExtendedKey, Len(ExtendedKey) - 32 * i + 1, 32)
After_XOR = XXOR_HEX(DATA_i, Key_i)
If i = 1 Then MixColumns = After_XOR Else MixColumns = fx_GF28(After_XOR, 1)
ShiftRows_TAB = "000D0A0704010E0B0805020F0C090603"
ShiftRows = FxPermu(MixColumns, ShiftRows_TAB)
SubBytes_TAB = "52096ad53036a538bf40a39e81f3d7fb7ce339829b2fff87348e4344c4dee9cb547b9432a6c2233dee4c950b42fac34e082ea16628d924b2765ba2496d8bd12572f8f66486689816d4a45ccc5d65b6926c704850fdedb9da5e154657a78d9d8490d8ab008cbcd30af7e45805b8b34506d02c1e8fca3f0f02c1afbd0301138a6b3a9111414f67dcea97f2cfcef0b4e67396ac7422e7ad3585e2f937e81c75df6e47f11a711d29c5896fb7620eaa18be1bfc563e4bc6d279209adbc0fe78cd5af41fdda8338807c731b11210592780ec5f60517fa919b54a0d2de57a9f93c99cefa0e03b4dae2af5b0c8ebbb3c83539961172b047eba77d626e169146355210c7d"
SubBytes = Mask(ShiftRows, SubBytes_TAB)
If i <= 9 Then DATA_i = SubBytes: GoTo 1 Else
final = XXOR_HEX(SubBytes, Left(ExtendedKey, 32))
AES_Decrypt = final
End Function
Public Function GenKey(myKey)
Dim W(43)
tmp = myKey
W(0) = Left(myKey, 8)
W(1) = Mid(myKey, 9, 8)
W(2) = Mid(myKey, 17, 8)
W(3) = Right(myKey, 8)
1
i = i + 4
Rcon = Hex(BinToDec("1" & Nfois("0", Int(i / 4) - 1))): If Len(Rcon) = 1 Then Rcon = "0" & Rcon & "000000" Else Rcon = Rcon & "000000"
If i = 36 Then Rcon = "1B000000" Else
If i = 40 Then Rcon = "36000000" Else
MASK_TAB = "637c777bf26b6fc53001672bfed7ab76ca82c97dfa5947f0add4a2af9ca472c0b7fd9326363ff7cc34a5e5f171d8311504c723c31896059a071280e2eb27b27509832c1a1b6e5aa0523bd6b329e32f8453d100ed20fcb15b6acbbe394a4c58cfd0efaafb434d338545f9027f503c9fa851a3408f929d38f5bcb6da2110fff3d2cd0c13ec5f974417c4a77e3d645d197360814fdc222a908846eeb814de5e0bdbe0323a0a4906245cc2d3ac629195e479e7c8376d8dd54ea96c56f4ea657aae08ba78252e1ca6b4c6e8dd741f4bbd8b8a703eb5664803f60e613557b986c11d9ee1f8981169d98e949b1e87e9ce5528df8ca1890dbfe6426841992d0fb054bb16"
W(i) = XXOR_HEX(XXOR_HEX(Mask(FxPermu(W(i - 1), "01020300"), MASK_TAB), W(i - 4)), Rcon)
W(i + 1) = XXOR_HEX(W(i), W(i - 3))
W(i + 2) = XXOR_HEX(W(i + 1), W(i - 2))
W(i + 3) = XXOR_HEX(W(i + 2), W(i - 1))
If i + 3 <> 43 Then GoTo 1 Else
For x = 0 To 43
tmp2 = tmp2 & W(x)
Next
GenKey = tmp2
End Function
Public Function fx_GF28(myINPUT, Algo_TYPE)
For i = 1 To Len(myINPUT) / 2 Step 4
a0 = Mid(myINPUT, i * 2 - 1, 2)
a1 = Mid(myINPUT, i * 2 + 1, 2)
a2 = Mid(myINPUT, i * 2 + 3, 2)
a3 = Mid(myINPUT, i * 2 + 5, 2)
Select Case Algo_TYPE
Case 0
b0 = Hex(Val("&h" & GF28("02", a0)) Xor Val("&h" & GF28("03", a1)) Xor Val("&h" & a2) Xor Val("&h" & a3))
b1 = Hex(Val("&h" & a0) Xor Val("&h" & GF28("02", a1)) Xor Val("&h" & GF28("03", a2)) Xor Val("&h" & a3))
b2 = Hex(Val("&h" & a0) Xor Val("&h" & a1) Xor Val("&h" & GF28("02", a2)) Xor Val("&h" & GF28("03", a3)))
b3 = Hex(Val("&h" & GF28("03", a0)) Xor Val("&h" & a1) Xor Val("&h" & a2) Xor Val("&h" & GF28("02", a3)))
Case 1
b0 = Hex(Val("&h" & GF28("0E", a0)) Xor Val("&h" & GF28("0B", a1)) Xor Val("&h" & GF28("0D", a2)) Xor Val("&h" & GF28("09", a3)))
b1 = Hex(Val("&h" & GF28("09", a0)) Xor Val("&h" & GF28("0E", a1)) Xor Val("&h" & GF28("0B", a2)) Xor Val("&h" & GF28("0D", a3)))
b2 = Hex(Val("&h" & GF28("0D", a0)) Xor Val("&h" & GF28("09", a1)) Xor Val("&h" & GF28("0E", a2)) Xor Val("&h" & GF28("0B", a3)))
b3 = Hex(Val("&h" & GF28("0B", a0)) Xor Val("&h" & GF28("0D", a1)) Xor Val("&h" & GF28("09", a2)) Xor Val("&h" & GF28("0E", a3)))
End Select
If Len(b0) = 1 Then b0 = "0" & b0 Else
If Len(b1) = 1 Then b1 = "0" & b1 Else
If Len(b2) = 1 Then b2 = "0" & b2 Else
If Len(b3) = 1 Then b3 = "0" & b3 Else
c = c & b0 & b1 & b2 & b3
Next
fx_GF28 = c
End Function
Public Function FxPermu(mystr, PERMU_table) As String
ReDim mytab(Len(mystr) / 2)
For a = 1 To Len(mystr) / 2
b = Val("&h" & Mid(PERMU_table, 2 * a - 1, 2))
bb = 2 * b + 1
c = Mid(mystr, bb, 2)
d = d & c
Next
FxPermu = d
End Function
Public Function Mask(mystr, tmp) As String
Dim Masktable(15, 15) As String
For a = 0 To 15
For b = 0 To 15
d = 2 * (a * 16 + b) + 1
Masktable(a, b) = Mid(tmp, d, 2)
Next
Next
For e = 1 To Len(mystr) Step 2
x = Val("&h" & Mid(mystr, e, 1))
y = Val("&h" & Mid(mystr, e + 1, 1))
z = z + Masktable(x, y)
Next
Mask = z
End Function
Public Function ToBin(n) As String
Do Until n = 0
If (n Mod 2) Then ToBin = "1" & ToBin Else ToBin = "0" & ToBin
n = n \ 2
Loop
If Len(ToBin) <> 8 Then ToBin = Nfois("0", 8 - Len(ToBin)) & ToBin Else
End Function
Public Function Nfois(a, n) As String
For i = 1 To n
j = j & a
Next
Nfois = j
End Function
Public Function toPOS(nBIN) As String
For i = 1 To 8
a = Mid(nBIN, i, 1)
If a = 1 Then b = b & (8 - i)
Next
toPOS = b
End Function
Public Function XXOR(Small, Big) As String
For i = 1 To Len(Small)
c = Val(Mid(Small, i, 1))
d = Val(Mid(Big, i, 1))
e = c Xor d
ee = ee & LTrim(Str(e))
Next
XXOR = ee
End Function
Public Function XXOR_HEX(HEX1, HEX2)
For i = 1 To Len(HEX1) / 2
a = Val("&h" & Mid(HEX1, 2 * i - 1, 2))
b = Val("&h" & Mid(HEX2, 2 * i - 1, 2))
c = Hex(a Xor b): If Len(c) = 1 Then c = "0" & c Else
d = d & c
Next
XXOR_HEX = d
End Function
Public Function BinToDec(BinNum) As String
If Len(BinNum) <> 8 Then BinNum = Nfois("0", 8 - Len(BinNum)) & BinNum Else
For i = 8 To 1 Step -1
j = j + Val(Mid(BinNum, i, 1)) * 2 ^ (8 - i)
Next
BinToDec = j
End Function
Public Function GF28(FirstByte, SecondByte)
a = ToBin(Val("&h" & FirstByte))
b = ToBin(Val("&h" & SecondByte))
If a = 0 Or b = 0 Then GF28 = "00": GoTo 3 Else 'FAUX
c = toPOS(a)
d = toPOS(b)
ReDim tab1(Len(c) - 1, Len(d) - 1)
For i = 0 To Len(c) - 1
nbr1 = Val(Mid(c, i + 1, 1))
For j = 0 To Len(d) - 1
nbr2 = Val(Mid(d, j + 1, 1))
nbr3 = nbr1 + nbr2
str_nbr = LTrim(Str(nbr3))
If Len(str_nbr) = 1 Then str_nbr = "0" & str_nbr Else
str_nbr2 = str_nbr2 & str_nbr
Next
Next
1
For x = 1 To Len(str_nbr2) / 2
y = Mid(str_nbr2, x * 2 - 1, 2)
loc1 = InStr(str_nbr2, y)
loc2 = InStrRev(str_nbr2, y)
If (loc1 <> loc2) And (loc1 Mod 2 = 1) And (loc2 Mod 2 = 1) Then
str_nbr3 = Left(str_nbr2, loc1 - 1) & Mid(str_nbr2, loc1 + 2, loc2 - loc1 - 2) & Right(str_nbr2, Len(str_nbr2) - loc2 - 1)
str_nbr2 = str_nbr3
GoTo 1
End If
Next
lnSTR = Val(Left(str_nbr2, 2))
ReDim tab2(lnSTR)
For x = 1 To Len(str_nbr2) / 2
y = Val(Mid(str_nbr2, x * 2 - 1, 2))
tab2(y) = 1
Next
For x = lnSTR To 0 Step -1
If tab2(x) = "" Then tab2(x) = 0 Else
Step1 = Step1 & tab2(x)
Next
2
If Len(Step1) > 8 Then
XOR_const = "100011011" 'x^8+x^4+x^3+x+1
xor_str = XXOR(XOR_const, Step1)
If Val(xor_str) <> 0 Then After_XOR = Right(xor_str, Len(xor_str) - InStr(xor_str, "1") + 1) & Right(Step1, Len(Step1) - Len(xor_str)) Else After_XOR = Right(Step1, Len(Step1) - Len(xor_str))
Step1 = After_XOR
GoTo 2
End If
Step2 = Step1
myHex = Hex(BinToDec(Step2))
If Len(myHex) = 1 Then myHex = "0" & myHex Else
3 GF28 = myHex
End Function
'form1.frm
'---------------------------------------------------------
'Codé par laaraj11@hotmail.com
'En 2011
Private Sub Command1_Click()
Text4.Text = AES_Encrypt(NoSpace(Text1.Text), NoSpace(Text2.Text))
End Sub
Private Sub Command2_Click()
Text4.Text = AES_Decrypt(NoSpace(Text1.Text), NoSpace(Text2.Text))
End Sub
Private Sub Form_Load()
Skin1.LoadSkin "winaqua.skn"
Skin1.ApplySkin Me.hWnd
End Sub

'module.bas
'-----------------------------------------------------------

Public Function NoSpace(mystr As String) As String
a = 0: tmp = "": c = "": NoSpace = ""
For a = 1 To Len(mystr)
c = Mid(mystr, a, 1)
If Asc(c) <> 32 Then tmp = tmp & c Else
Next
NoSpace = tmp
End Function

Public Function AES_Encrypt(PlainText, AES_KEY)

Dim ExtendedKey, Key_i, DATA_i, After_XOR, SubBytes, SubBytes_TAB, ShiftRows, ShiftRows_TAB, MixColumns
ExtendedKey = GenKey(AES_KEY)
DATA_i = PlainText

1

i = i + 1
Key_i = Mid(ExtendedKey, 32 * (i - 1) + 1, 32)

After_XOR = XXOR_HEX(DATA_i, Key_i)
SubBytes_TAB = "637c777bf26b6fc53001672bfed7ab76ca82c97dfa5947f0add4a2af9ca472c0b7fd9326363ff7cc34a5e5f171d8311504c723c31896059a071280e2eb27b27509832c1a1b6e5aa0523bd6b329e32f8453d100ed20fcb15b6acbbe394a4c58cfd0efaafb434d338545f9027f503c9fa851a3408f929d38f5bcb6da2110fff3d2cd0c13ec5f974417c4a77e3d645d197360814fdc222a908846eeb814de5e0bdbe0323a0a4906245cc2d3ac629195e479e7c8376d8dd54ea96c56f4ea657aae08ba78252e1ca6b4c6e8dd741f4bbd8b8a703eb5664803f60e613557b986c11d9ee1f8981169d98e949b1e87e9ce5528df8ca1890dbfe6426841992d0fb054bb16"

SubBytes = Mask(After_XOR, SubBytes_TAB)

ShiftRows_TAB = "00050A0F04090E03080D02070C01060B"
ShiftRows = FxPermu(SubBytes, ShiftRows_TAB)

If i = 10 Then MixColumns = XXOR_HEX(ShiftRows, Right(ExtendedKey, 32)) Else MixColumns = fx_GF28(ShiftRows, 0)
If i <= 9 Then DATA_i = MixColumns: GoTo 1 Else

AES_Encrypt = MixColumns


End Function

Public Function AES_Decrypt(CipherText, AES_KEY)
Dim ExtendedKey, Key_i, DATA_i, After_XOR, SubBytes, SubBytes_TAB, ShiftRows, ShiftRows_TAB, MixColumns

ExtendedKey = GenKey(AES_KEY)
DATA_i = CipherText

1

i = i + 1
Key_i = Mid(ExtendedKey, Len(ExtendedKey) - 32 * i + 1, 32)




After_XOR = XXOR_HEX(DATA_i, Key_i)


If i = 1 Then MixColumns = After_XOR Else MixColumns = fx_GF28(After_XOR, 1)

ShiftRows_TAB = "000D0A0704010E0B0805020F0C090603"
ShiftRows = FxPermu(MixColumns, ShiftRows_TAB)


SubBytes_TAB = "52096ad53036a538bf40a39e81f3d7fb7ce339829b2fff87348e4344c4dee9cb547b9432a6c2233dee4c950b42fac34e082ea16628d924b2765ba2496d8bd12572f8f66486689816d4a45ccc5d65b6926c704850fdedb9da5e154657a78d9d8490d8ab008cbcd30af7e45805b8b34506d02c1e8fca3f0f02c1afbd0301138a6b3a9111414f67dcea97f2cfcef0b4e67396ac7422e7ad3585e2f937e81c75df6e47f11a711d29c5896fb7620eaa18be1bfc563e4bc6d279209adbc0fe78cd5af41fdda8338807c731b11210592780ec5f60517fa919b54a0d2de57a9f93c99cefa0e03b4dae2af5b0c8ebbb3c83539961172b047eba77d626e169146355210c7d"
SubBytes = Mask(ShiftRows, SubBytes_TAB)

If i <= 9 Then DATA_i = SubBytes: GoTo 1 Else

final = XXOR_HEX(SubBytes, Left(ExtendedKey, 32))

AES_Decrypt = final

End Function

Public Function GenKey(myKey)
Dim W(43)
tmp = myKey
W(0) = Left(myKey, 8)
W(1) = Mid(myKey, 9, 8)
W(2) = Mid(myKey, 17, 8)
W(3) = Right(myKey, 8)

1
i = i + 4
Rcon = Hex(BinToDec("1" & Nfois("0", Int(i / 4) - 1))): If Len(Rcon) = 1 Then Rcon = "0" & Rcon & "000000" Else Rcon = Rcon & "000000"
If i = 36 Then Rcon = "1B000000" Else
If i = 40 Then Rcon = "36000000" Else

MASK_TAB = "637c777bf26b6fc53001672bfed7ab76ca82c97dfa5947f0add4a2af9ca472c0b7fd9326363ff7cc34a5e5f171d8311504c723c31896059a071280e2eb27b27509832c1a1b6e5aa0523bd6b329e32f8453d100ed20fcb15b6acbbe394a4c58cfd0efaafb434d338545f9027f503c9fa851a3408f929d38f5bcb6da2110fff3d2cd0c13ec5f974417c4a77e3d645d197360814fdc222a908846eeb814de5e0bdbe0323a0a4906245cc2d3ac629195e479e7c8376d8dd54ea96c56f4ea657aae08ba78252e1ca6b4c6e8dd741f4bbd8b8a703eb5664803f60e613557b986c11d9ee1f8981169d98e949b1e87e9ce5528df8ca1890dbfe6426841992d0fb054bb16"
W(i) = XXOR_HEX(XXOR_HEX(Mask(FxPermu(W(i - 1), "01020300"), MASK_TAB), W(i - 4)), Rcon)
W(i + 1) = XXOR_HEX(W(i), W(i - 3))
W(i + 2) = XXOR_HEX(W(i + 1), W(i - 2))
W(i + 3) = XXOR_HEX(W(i + 2), W(i - 1))
If i + 3 <> 43 Then GoTo 1 Else

For x = 0 To 43
tmp2 = tmp2 & W(x)
Next

GenKey = tmp2

End Function

Public Function fx_GF28(myINPUT, Algo_TYPE)
For i = 1 To Len(myINPUT) / 2 Step 4
a0 = Mid(myINPUT, i * 2 - 1, 2)
a1 = Mid(myINPUT, i * 2 + 1, 2)
a2 = Mid(myINPUT, i * 2 + 3, 2)
a3 = Mid(myINPUT, i * 2 + 5, 2)


Select Case Algo_TYPE
Case 0
b0 = Hex(Val("&h" & GF28("02", a0)) Xor Val("&h" & GF28("03", a1)) Xor Val("&h" & a2) Xor Val("&h" & a3))
b1 = Hex(Val("&h" & a0) Xor Val("&h" & GF28("02", a1)) Xor Val("&h" & GF28("03", a2)) Xor Val("&h" & a3))
b2 = Hex(Val("&h" & a0) Xor Val("&h" & a1) Xor Val("&h" & GF28("02", a2)) Xor Val("&h" & GF28("03", a3)))
b3 = Hex(Val("&h" & GF28("03", a0)) Xor Val("&h" & a1) Xor Val("&h" & a2) Xor Val("&h" & GF28("02", a3)))
Case 1
b0 = Hex(Val("&h" & GF28("0E", a0)) Xor Val("&h" & GF28("0B", a1)) Xor Val("&h" & GF28("0D", a2)) Xor Val("&h" & GF28("09", a3)))
b1 = Hex(Val("&h" & GF28("09", a0)) Xor Val("&h" & GF28("0E", a1)) Xor Val("&h" & GF28("0B", a2)) Xor Val("&h" & GF28("0D", a3)))
b2 = Hex(Val("&h" & GF28("0D", a0)) Xor Val("&h" & GF28("09", a1)) Xor Val("&h" & GF28("0E", a2)) Xor Val("&h" & GF28("0B", a3)))
b3 = Hex(Val("&h" & GF28("0B", a0)) Xor Val("&h" & GF28("0D", a1)) Xor Val("&h" & GF28("09", a2)) Xor Val("&h" & GF28("0E", a3)))



End Select

If Len(b0) = 1 Then b0 = "0" & b0 Else
If Len(b1) = 1 Then b1 = "0" & b1 Else
If Len(b2) = 1 Then b2 = "0" & b2 Else
If Len(b3) = 1 Then b3 = "0" & b3 Else


c = c & b0 & b1 & b2 & b3

Next
fx_GF28 = c
End Function

Public Function FxPermu(mystr, PERMU_table) As String
ReDim mytab(Len(mystr) / 2)
For a = 1 To Len(mystr) / 2
b = Val("&h" & Mid(PERMU_table, 2 * a - 1, 2))
bb = 2 * b + 1
c = Mid(mystr, bb, 2)
d = d & c
Next
FxPermu = d
End Function

Public Function Mask(mystr, tmp) As String
Dim Masktable(15, 15) As String

For a = 0 To 15
    For b = 0 To 15
    d = 2 * (a * 16 + b) + 1
    Masktable(a, b) = Mid(tmp, d, 2)
    
    Next
Next
For e = 1 To Len(mystr) Step 2
x = Val("&h" & Mid(mystr, e, 1))
y = Val("&h" & Mid(mystr, e + 1, 1))
z = z + Masktable(x, y)
Next
Mask = z

End Function

Public Function ToBin(n) As String
Do Until n = 0
    If (n Mod 2) Then ToBin = "1" & ToBin Else ToBin = "0" & ToBin
    n = n \ 2
Loop
If Len(ToBin) <> 8 Then ToBin = Nfois("0", 8 - Len(ToBin)) & ToBin Else
End Function


Public Function Nfois(a, n) As String
For i = 1 To n
j = j & a
Next
Nfois = j
End Function

Public Function toPOS(nBIN) As String
For i = 1 To 8
a = Mid(nBIN, i, 1)
If a = 1 Then b = b & (8 - i)
Next
toPOS = b
End Function

Public Function XXOR(Small, Big) As String
For i = 1 To Len(Small)
c = Val(Mid(Small, i, 1))
d = Val(Mid(Big, i, 1))
e = c Xor d
ee = ee & LTrim(Str(e))
Next
XXOR = ee
End Function

Public Function XXOR_HEX(HEX1, HEX2)
For i = 1 To Len(HEX1) / 2
a = Val("&h" & Mid(HEX1, 2 * i - 1, 2))
b = Val("&h" & Mid(HEX2, 2 * i - 1, 2))
c = Hex(a Xor b): If Len(c) = 1 Then c = "0" & c Else
d = d & c
Next
XXOR_HEX = d
End Function

Public Function BinToDec(BinNum) As String
If Len(BinNum) <> 8 Then BinNum = Nfois("0", 8 - Len(BinNum)) & BinNum Else
  For i = 8 To 1 Step -1
 j = j + Val(Mid(BinNum, i, 1)) * 2 ^ (8 - i)
  Next
  BinToDec = j

End Function

Public Function GF28(FirstByte, SecondByte)
a = ToBin(Val("&h" & FirstByte))
b = ToBin(Val("&h" & SecondByte))
If a = 0 Or b = 0 Then GF28 = "00": GoTo 3 Else 'FAUX
c = toPOS(a)
d = toPOS(b)

ReDim tab1(Len(c) - 1, Len(d) - 1)

For i = 0 To Len(c) - 1
nbr1 = Val(Mid(c, i + 1, 1))
    For j = 0 To Len(d) - 1
    nbr2 = Val(Mid(d, j + 1, 1))
    nbr3 = nbr1 + nbr2
    str_nbr = LTrim(Str(nbr3))
    If Len(str_nbr) = 1 Then str_nbr = "0" & str_nbr Else
    str_nbr2 = str_nbr2 & str_nbr
    Next
Next

1
For x = 1 To Len(str_nbr2) / 2
y = Mid(str_nbr2, x * 2 - 1, 2)
loc1 = InStr(str_nbr2, y)
loc2 = InStrRev(str_nbr2, y)
If (loc1 <> loc2) And (loc1 Mod 2 = 1) And (loc2 Mod 2 = 1) Then
str_nbr3 = Left(str_nbr2, loc1 - 1) & Mid(str_nbr2, loc1 + 2, loc2 - loc1 - 2) & Right(str_nbr2, Len(str_nbr2) - loc2 - 1)
str_nbr2 = str_nbr3
GoTo 1
End If
Next


lnSTR = Val(Left(str_nbr2, 2))
ReDim tab2(lnSTR)
For x = 1 To Len(str_nbr2) / 2
y = Val(Mid(str_nbr2, x * 2 - 1, 2))

tab2(y) = 1
Next

For x = lnSTR To 0 Step -1
If tab2(x) = "" Then tab2(x) = 0 Else
Step1 = Step1 & tab2(x)
Next


2
If Len(Step1) > 8 Then
XOR_const = "100011011" 'x^8+x^4+x^3+x+1
xor_str = XXOR(XOR_const, Step1)

If Val(xor_str) <> 0 Then After_XOR = Right(xor_str, Len(xor_str) - InStr(xor_str, "1") + 1) & Right(Step1, Len(Step1) - Len(xor_str)) Else After_XOR = Right(Step1, Len(Step1) - Len(xor_str))
Step1 = After_XOR
GoTo 2
End If
Step2 = Step1
myHex = Hex(BinToDec(Step2))
If Len(myHex) = 1 Then myHex = "0" & myHex Else
3 GF28 = myHex
End Function

'form1.frm
'---------------------------------------------------------

'Codé par laaraj11@hotmail.com
'En 2011

Private Sub Command1_Click()
Text4.Text = AES_Encrypt(NoSpace(Text1.Text), NoSpace(Text2.Text))
End Sub


Private Sub Command2_Click()
Text4.Text = AES_Decrypt(NoSpace(Text1.Text), NoSpace(Text2.Text))
End Sub

Private Sub Form_Load()
Skin1.LoadSkin "winaqua.skn"
Skin1.ApplySkin Me.hWnd
End Sub

Conclusion

La difficulté dans ce programme réside dans la compréhension de l'algorithme ^^
Bonne lecture à tous !

Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Form1.frm 5 754 octets
Form1.frx564 octets
Module1.bas 8 728 octets
Project1.vbp 750 octets
Project1.vbw 82 octets
winaqua.skn193 093 octets

Télécharger le zip

Sources de la même categorie

TRANSFORMER UN NOMBRE AVEC VIRGULE EN FRACTION par alpha5

SIMULATEUR DE PROPAGATION DE FEU DE FORÊT (2D) par Spoonyx

NOMBRE PREMIER OU COMPOSÉ par apexinfo

COMBINAISONS, ARRANGEMENTS, PERMUTATIONS, ANAGRAMMES par Math_Ador

CRYPTAGE PAR TRANSLATION par ravorasolofo

Toutes les sources de la catégorie Maths

Sources en rapport avec celle ci

OBTENIR LA DATE DU JOUR DEPUIS LE WEB par jmc70

PROGRESSE BAR STYLE FACEBOOK par radicalc3d

PROJET VB FLEXGRID, DATA par radicalc3d

JEU DES BÂTONNETS par philbar71

TRADUCTEUR VB6.VBP EN VB5.VBP par joro

Commentaires et avis

Commentaire de NHenry le 08/06/2012 21:55:31 administrateur CS

Bonsoir,

Je n'ai regardé que le code posté :
- Mets TOUJOURS "Option Explicit" (sans les " ) en haut de tout te modules de code en VB6.
- Donnes un type à toutes tes variables, tu verras, ce sera plus lisible et plus sûr à l'usage (tout en étant plus rapide)
- Indentes ton code
- Vires les GOTO, il y a toujours une alternatives (ou alors, c'est que tu dois repenser ton code)
- Evites les multiples instructions sur une seule ligne :

Rcon = Hex(BinToDec("1" & Nfois("0", Int(i / 4) - 1))): If Len(Rcon) = 1 Then Rcon = "0" & Rcon & "000000" Else Rcon = Rcon & "000000"

Est plus dur à lire que :
Rcon = Hex(BinToDec("1" & Nfois("0", Int(i / 4) - 1)))
If Len(Rcon) = 1 Then
Rcon = "0" & Rcon & "000000"
Else
Rcon = Rcon & "000000"
End If

Je regarderais la suite après correction de ton code.

Commentaire de laaraj11 le 08/06/2012 22:35:04

Merci NHenry pour ces remarques !
En faite, je ne suis qu'un amateur en programmation ! je me rend compte que mon code n'est pas très didactique vue que j'ai pas mis de commentaires ni déclaré toutes mes variables !
Vous allez vous rendre compte en lisant la suite du code que la plupart des variables sont de type "String".
Je sais qu'il y'a beaucoup à optimiser !

Bonne soirée ^^

Commentaire de loulou69 le 11/06/2012 10:46:15

Bonjour
il faut apparemment une Dll spécifique même enregistré sous Windows\system32 j'ai une erreur de chargement Erreur Système &H80004005. ou peut on prendre la bonne version de cette Dll?.

Commentaire de laaraj11 le 12/06/2012 01:11:32

Cher LOULOU69,
la seul dll dans mon code est celle qui sert à améliorer le graphisme. Tu peux pallier à ce problème en effaçant les lignes suivant :
Private Sub Form_Load()
Skin1.LoadSkin "winaqua.skn"
Skin1.ApplySkin Me.hWnd
End Sub

et en supprimant l'objet Skin1 du form1 !

Espérant que ça va régler ton problème. Bon courage :)

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

base oracle et vb6 [ par yahyia ] Message : Question 1 : ODBC utilisé pour accéder à une base de données sous Oracle à partir de VB6 est celui de fourni avec VB6. L'accès aux donn Retirer des composantes [ par Amonbofis ] Bonjour!Quelqu'un peux me dire comment retirer des composantes de la listede VB6?Ici je veux dire, quand on veux ajouter une composante au projet,par Multirésolution [ par Vanille ] Dans une application VB4(16 bits), j'utilisais la ressource VSBBX, le contrôle VSElastic permettant la multirésolution. Ayant converti l'application e Decoupage d'une image [ par David ] Comment pourrait-on copier une image dans le presse papier avec une forme de secteur angulaire sous VB6Pas rectangulaire comme avec BitBlp le permet d Qui peut me renseigner sur Datareport / VB6 ? [ par dede ] La constitution de groupe sous datareport (VB6) .......Merci Lancer une appli depuis VB6 et attendre... [ par jean-claude ] Bonjour à tous,Comment faire pour lancer une autre appli depuis mon appli VB6 et attendre que l'utilisateur l'ait fermée avant de reprendre le fonctio Les graph sous vb6 [ par Fabrizo ] Salut,J'assaye de faire un graphique a partir de données acquise par PPI, mais je ne sait pas placer mes donnés dans la grille de microsoft exel (char Execution de programme vb6 depuis le web [ par tom ] Chers amis bonjour !!Je suis novice, et j'aurai voulu savoir comment faire pour executer des programmes en vb6 sur ma machine/serveur, depuis une page Problemes techniques sur VB6 [ par Ali ] Bonjour , je m'appelle Ali, et je debute aussi sur VB dans ma société. En fait je suis encore étudiant et j'effectue un stage dans une entreprise. El URGENT!!Probleme de compilation sous VB6 [ par ali ] Bonjour, J'ai un petit probleme:Je dois compiler mon programme sous VB6, et pour cela je dois ajouter le nom d'un fichier sous la " command"Comment do

Nos sponsors

Derniers Blogs

INTéGRATION YAMMER ET SHAREPOINT ONLINE (OFFICE 365), éTAPE 1 . par Patrick Guimonet

[DYNAMICS CRM] AJOUTER LES DOSSIERS DE CRM AU DOSSIER FAVORIS D'OUTLOOK par bianca

VISUAL STUDIO 2013 par Etienne Margraff

CONFIGURER LA COLLATION SQL SERVER POUR SHAREPOINT par JeremyJeanson

ETENDRE LE TEAM WEB ACCESS DE TFS 2012 - STEP 1: CRéATION DU PLUGIN par Philess

Forum

NOVICE EN VBA par serresarmand

RE : PETITE QUESTION par Wolfplayer97

RE : PETITE QUESTION par Zermelo

RE : PETITE QUESTION par Wolfplayer97

RE : MISE A JOUR par acive

Côté IT

Offres d'emploi

Formations Video

Appels d'offres

Developpeur Drupal Expert - -Rgie - Paris
Budget : 1 000€
Urgent - developpeur java-j2ee STRUTS2 -Paris
Budget : 400€
application ebook- Republication
Budget : 3 000€

Logiciels

Nego Facturation (1.85)
NEGO FACTURATION (1.85)

Nego Facturation est un logiciel complet qui permet de gérer vos factures et devis très simplemen...

Cliquez pour télécharger Nego Facturation
Devis-Factures PHMSD (2.2.0.1)
DEVIS-FACTURES PHMSD (2.2.0.1)

Configuration minimale Nécessite Windows™ 2000, XP, Windows 7, 8, Vista (Service Pack à...

Cliquez pour télécharger Devis-Factures PHMSD
WDmemoCode (2.0.0.1)
WDMEMOCODE (2.0.0.1)

WDmemoCode a été conçu pour aider les développeurs Windev à créer/compléter et conserver une base...

Cliquez pour télécharger WDmemoCode
ProtoMedic (4.0.0.11)
PROTOMEDIC (4.0.0.11)

ProtoMedic est un logiciel destiné principalement aux médecins généralistes. ProtoMedic permet d...

Cliquez pour télécharger ProtoMedic
MyCurriculum 2011 (7.4.1.12)
MYCURRICULUM 2011 (7.4.1.12)

Rédigez votre Curriculum Vitae mais également ceux de votre famille ou de vos amis très facilemen...

Cliquez pour télécharger MyCurriculum 2011