simple text encryption

Share your advanced PureBasic knowledge/code with the community.
Manne
User
User
Posts: 30
Joined: Mon Apr 28, 2003 8:49 pm

simple text encryption

Post by Manne »

Code updated For 5.20+

Maybe useful for someone. :wink:

include:

Code: Select all

Procedure CalculateSeed(InputNumber)
  ProcedureReturn Int(Log(InputNumber) * Cos(InputNumber) * 137)
EndProcedure

Procedure GetPasswordValue(Password.s)
  
  For i = 1 To Len(Password)
    ASCII_Vals = ASCII_Vals + Asc(Mid(Password, i, 1))
  Next i
  
  If ASCII_Vals > Len(Password)
    ProcedureReturn Int(CalculateSeed(ASCII_Vals) / CalculateSeed(Len(Password) + 1))
  Else
    ProcedureReturn CalculateSeed(ASCII_Vals)
  EndIf
EndProcedure

Procedure WrapNumber(lngNumber, lngMinimum, lngMaximum)
  Define Range, check
  Range = lngMaximum - lngMinimum
  check = lngNumber
  
  If lngNumber > lngMaximum
    Repeat
      check = check - Range
    Until check <= lngMaximum
  ElseIf lngNumber < lngMinimum
    Repeat
      check = check + Range
    Until check >= lngMinimum
  EndIf
  ProcedureReturn check
EndProcedure

Procedure.s Encrypt(Password.s, Input.s)
  Define PasswordVal, CurrentChar, CurrentMod
  enctxt.s 
  PasswordVal = GetPasswordValue(Password)
  
  CurrentMod = 2
  
  For i = 1 To Len(Input)
    CurrentChar = Asc(Mid(Input, i, 1))
    CurrentChar = CurrentChar + PasswordVal
    CurrentChar = CurrentChar - CalculateSeed(CurrentMod)
    CurrentChar = WrapNumber(CurrentChar, 0, 255)
    enctxt = enctxt + Chr(CurrentChar)
    CurrentMod = CurrentMod + 1
    
    If CurrentMod > 30
      CurrentMod = 2
    EndIf
  Next i
  ProcedureReturn enctxt 
EndProcedure

Procedure.s Decrypt(Password.s, Input.s)
  Define PasswordVal, CurrentChar, CurrentMod
  dectxt.s 
  PasswordVal = GetPasswordValue(Password)
  CurrentMod = 2
  
  For i = 1 To Len(Input)
    CurrentChar = Asc(Mid(Input, i, 1))
    CurrentChar = CurrentChar - PasswordVal
    CurrentChar = CurrentChar + CalculateSeed(CurrentMod)
    CurrentChar = WrapNumber(CurrentChar, 0, 255)
    dectxt = dectxt + Chr(CurrentChar)
    CurrentMod = CurrentMod + 1
    
    If CurrentMod > 30
      CurrentMod = 2
    EndIf
  Next i
  ProcedureReturn dectxt   
EndProcedure
a little example.
main:

Code: Select all

; PureBasic Visual Designer v3.82 build 1354

IncludeFile "Common.pb"
IncludeFile "Procedures.pbi"

Open_Window_0()
SetActiveGadget(#String_0)
DisableGadget(#Button_0, 1)
DisableGadget(#Button_1, 1)

Repeat
  
  Event = WaitWindowEvent()
  If Event = #PB_Event_CloseWindow
    Quit = 1
  ElseIf Event = #PB_Event_Gadget Or Event = #PB_Event_Menu
    
    Select EventGadget()
      Case #Button_0  ;Encrypt
        If GetGadgetText(#String_0) = ""
          MessageRequester("Error", "Missing Password!", #MB_ICONWARNING)
        Else
          SetGadgetText(#String_2, Encrypt(GetGadgetText(#String_0), GetGadgetText(#String_1)))
          If Len(GetGadgetText(#String_2)) <> Len(GetGadgetText(#String_1))
            SetGadgetText(#String_2, "") 
            StatusBarText(#StatusBar_0, 0, "invisible character/s found, please use another pw.")
          Else
            SetGadgetText(#String_1, "")
            DisableGadget(#Button_0, 1)
            DisableGadget(#Button_1, 0)
            StatusBarText(#StatusBar_0, 0, "Encryption successful!")
          EndIf
        EndIf
      Case #Button_1  ;Decrypt
        If GetGadgetText(#String_0) = ""
          MessageRequester("Error", "Missing Password!", #MB_ICONWARNING)
        Else
          SetGadgetText(#String_1, Decrypt(GetGadgetText(#String_0), GetGadgetText(#String_2)))
          SetGadgetText(#String_2, "")
          DisableGadget(#Button_1, 1)
          DisableGadget(#Button_0, 0)
          StatusBarText(#StatusBar_0, 0, "Decryption succesful!")
        EndIf
      Case #String_1  ; Input
        If EventType() = #PB_EventType_Change
          DisableGadget(#Button_0, 0)
        EndIf
      Case #String_2  ; Output
        If EventType() = #PB_EventType_Change
          DisableGadget(#Button_1, 0)
        EndIf
    EndSelect
  EndIf
  
Until Quit

End
common:

Code: Select all

; PureBasic Visual Designer v3.82 build 1354


;- Window Constants
;
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #Text_0
  #String_0
  #String_1
  #Text_1
  #Button_0
  #Button_1
  #String_2
  #StatusBar_0
EndEnumeration

;- Fonts
;
Global FontID1
FontID1 = LoadFont(1, "Arial", 10, #PB_Font_Bold)
Global FontID2
FontID2 = LoadFont(2, "Arial", 8, #PB_Font_Bold)

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 433, 212, 322, 370 , "Text-Crypt",  #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
    If CreateStatusBar(#StatusBar_0, WindowID(#Window_0))
      AddStatusBarField(322)
    EndIf
    
    ;         If CreateGadgetList(WindowID(#Window_0))
    TextGadget(#Text_0, 20, 20, 65, 20, "Password:")
    SetGadgetFont(#Text_0, FontID2)
    StringGadget(#String_0, 90, 18, 210, 20, "", #PB_String_Password)
    SendMessage_(GadgetID(#String_0), #EM_LIMITTEXT, 100, 0)
    EditorGadget(#String_1, 20, 70, 280, 100, #ES_AUTOVSCROLL|#WS_VSCROLL|#ESB_DISABLE_LEFT|#ESB_DISABLE_RIGHT)
    SendMessage_(GadgetID(#String_1), #EM_LIMITTEXT, 1000, 0)
    TextGadget(#Text_1, 48, 50, 45, 15, "Input:")
    ButtonGadget(#Button_0, 20, 180, 280, 30, "Encrypt")
    AddKeyboardShortcut(#Window_0, #PB_Shortcut_Control | #PB_Shortcut_E, #Button_0)
    SetGadgetFont(#Button_0, FontID2)
    ButtonGadget(#Button_1, 20, 210, 280, 30, "Decrypt")
    AddKeyboardShortcut(#Window_0, #PB_Shortcut_Control | #PB_Shortcut_D, #Button_1)
    SetGadgetFont(#Button_1, FontID2)
    EditorGadget(#String_2, 20, 250, 280, 100, #ES_AUTOVSCROLL|#WS_VSCROLL|#ESB_DISABLE_LEFT|#ESB_DISABLE_RIGHT)
    SendMessage_(GadgetID(#String_2), #EM_LIMITTEXT, 1000, 0)
    ;         EndIf
  EndIf
EndProcedure

Manne
collectordave
Addict
Addict
Posts: 1309
Joined: Fri Aug 28, 2015 6:10 pm
Location: Portugal

Re: simple text encryption

Post by collectordave »

Thanks for sharing.

Easy to use and I am using it to encrypt my passwords etc.


CD
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: simple text encryption

Post by Kwai chang caine »

2004 always works here with 5.72 :wink:
Not see before, a "little bit" late :oops: thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
Post Reply