Basic Univers
Enumeration
#Window_0
EndEnumeration
Enumeration
#Editor_0
#String_0
#Button_0
#Button_1
#Text_0
EndEnumeration
Global FontID1, FontID2
FontID1 = LoadFont(1, "Times New Roman", 12, #PB_Font_Bold)
FontID2 = LoadFont(2, "Verdana", 10)
Procedure GenKey()
Key.s = ""
For t = 0 To 19
Char = Random(35)
If Char < 10
Key + Chr(48 + Char)
Else
Key + Chr(55 + Char)
EndIf
Next
SetGadgetText(#String_0, Key)
EndProcedure
Procedure AfficheMemoire(*Char.BYTE, Longueur)
Texte.s = ""
For t = 0 To Longueur Step 16
Texte + RSet(Hex(t), 4, "0") + Chr(9) + ":"
For r = 0 To 15
Texte + Chr(9) + RSet(Hex(*Char\b & $FF), 2, "0")
*Char + 1
Next
Texte + Chr(13)
Next
SetGadgetText(#Editor_0, Texte)
EndProcedure
Procedure Crypter(*Char.BYTE, Longueur, Key.s)
Debut = *Char
Fin = Debut + Longueur
*CharKey1.BYTE = @Key
pKeyRec = 0
For t = 0 To 3
pKeyRec +((*CharKey1\b - 48) & $F)
pKeyRec << 4
*CharKey1 + 1
Next
Debug Hex(pKeyRec)
IndB.w = 1
While *Char <= Fin
*CharKey1 = @Key
For r = 0 To 11
MOV al, *Char\b
XOR al, *CharKey1\b
ROL al, 4
MOV *Char\b, al
*Char + 1
*CharKey1 + 1
Next
If pKeyRec & IndB
*Char + 1
EndIf
ROL IndB, 1
Wend
*Char = Debut
*CharKey2.BYTE = @Key + 12
pKeyRec = 0
For t = 0 To 3
pKeyRec +((*CharKey2\b - 48) & $F)
pKeyRec << 4
*CharKey2 + 1
Next
Debug Hex(pKeyRec)
IndB.w = 1
While *Char <= Fin
*CharKey2 = @Key + 12
For r = 0 To 7
MOV al, *Char\b
XOR al, *CharKey2\b
MOV *Char\b, al
*Char + 1
*CharKey2 + 1
Next
If pKeyRec & IndB
*Char + 1
EndIf
ROL IndB, 1
Wend
EndProcedure
Procedure Decrypter(*Char.BYTE, Longueur, Key.s)
Debut = *Char
Fin = Debut + Longueur
*CharKey2.BYTE = @Key + 12
pKeyRec = 0
For t = 0 To 3
pKeyRec +((*CharKey2\b - 48) & $F)
pKeyRec << 4
*CharKey2 + 1
Next
Debug Hex(pKeyRec)
IndB.w = 1
While *Char <= Fin
*CharKey2 = @Key + 12
For r = 0 To 7
MOV al, *Char\b
XOR al, *CharKey2\b
MOV *Char\b, al
*Char + 1
*CharKey2 + 1
Next
If pKeyRec & IndB
*Char + 1
EndIf
ROL IndB, 1
Wend
*Char = Debut
*CharKey1.BYTE = @Key
pKeyRec = 0
For t = 0 To 3
pKeyRec +((*CharKey1\b - 48) & $F)
pKeyRec << 4
*CharKey1 + 1
Next
Debug Hex(pKeyRec)
IndB.w = 1
While *Char <= Fin
*CharKey1 = @Key
For r = 0 To 11
MOV al, *Char\b
ROR al, 4
XOR al, *CharKey1\b
MOV *Char\b, al
*Char + 1
*CharKey1 + 1
Next
If pKeyRec & IndB
*Char + 1
EndIf
ROL IndB, 1
Wend
EndProcedure
Dim Tab.l(17)
Tab(0) = 36
For t = 1 To 16
Tab(t) = 25 + t * 24
Next
Style = #PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_ScreenCentered
If OpenWindow(#Window_0, 319, 171, 600, 600, Style, "crypte & décrypte")
If CreateGadgetList(WindowID())
EditorGadget(#Editor_0, 10, 40, 580, 550)
SendMessage_(GadgetID(#Editor_0), #EM_SETBKGNDCOLOR, #Null, RGB(100, 150, 200))
SendMessage_(GadgetID(#Editor_0), #EM_SETTABSTOPS, 17, @Tab(0))
SetGadgetFont(#Editor_0, FontID2)
StringGadget(#String_0, 180, 10, 200, 20, "", #PB_String_UpperCase)
SendMessage_(GadgetID(#String_0), #EM_LIMITTEXT, 16, 0)
ButtonGadget(#Button_0, 400, 10, 90, 20, "KeyGen")
ButtonGadget(#Button_1, 500, 10, 90, 20, "Crypter")
TextGadget(#Text_0, 10, 10, 160, 20, "Clés de cryptage :", #PB_Text_Center)
SetGadgetFont(#Text_0, FontID1)
EndIf
HideWindow(#Window_0, 0)
EndIf
Memoire = AllocateMemory($FFF)
FillMemory_(Memoire, $1000, $00)
AfficheMemoire(Memoire, $FFF)
GenKey()
Repeat
Event = WaitWindowEvent()
WindowID = EventWindowID()
GadgetID = EventGadgetID()
EventType = EventType()
If Event = #PB_EventGadget
If GadgetID = #Editor_0
ElseIf GadgetID = #String_0
ElseIf GadgetID = #Button_0
GenKey()
ElseIf GadgetID = #Button_1
If GetGadgetText(#Button_1) = "Crypter"
Crypter(Memoire, $FFF, GetGadgetText(#String_0))
AfficheMemoire(Memoire, $FFF)
SetGadgetText(#Button_1, "Décrypter")
Else
Decrypter(Memoire, $FFF, GetGadgetText(#String_0))
AfficheMemoire(Memoire, $FFF)
SetGadgetText(#Button_1, "Crypter")
EndIf
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
End