Basic Univers
;/
;/                    Algorithmes de cryptage et de décryptage
;/                   Programme Eric Ducoulombier ( Erix14 )
;/                  Windows XP SP2 - PureBasic 3.94 - jaPBe 2.5.4.22
;/                                   28/08/2005
;/
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
     ; Première passe
     *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
     ; Seconde passe
     *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
     ; Première passe
     *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
     ; Seconde passe
     *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