The Crypt

[bplus]

A quick little InForm project to test a couple buttons and some textbox, translate a secret message or decode one.

Code: (Select All)

'Cryptogram.bas for QB64 version 1106 just before 1.2 number change
' first test of Inform beta 7, B+ 2018-06-02
' now to figure out all the files that are needed to distribute this tiny little test

': This program uses
': InForm - GUI library for QB64 - Beta version 7
': Fellippe Heitor, 2016-2018 - fellippe@qb64.org - [url=https://qb64phoenix.com/forum/member.php?action=profile&uid=325]@fellippeheitor[/url]
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------

': Controls' IDs: ------------------------------------------------------------------
Rem NOTICE: THIS FORM HAS BEEN RECENTLY EDITED
'>> The controls in the list below may have been added or renamed,
'>> and previously existing controls may have been deleted since
'>> this program's structure was first generated.
'>> Make sure to check your code in the events SUBs so that
'>> you can take your recent edits into consideration.

' and I lost all the following code!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Secret Santa 3.bas for QB64 B+ 2018-05-01
' based on versions of Secret Santa I did in JB  2016-12-03
' the letters and digits want to give each other presents at Christmas
' if A is Santa to B, then B can't also be Santa to A (or B)

'To keep Code more secret randomize with a secret seed known only to you and intended reciever
secret## = 3254760 '< user and reciever should Enter this number
Randomize secret##

Dim Shared letters$, Reform$, Code$
letters$ = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz1234567890"
L = Len(letters$)
Dim LS$(L)
'laod array
For i = 1 To L
    LS$(i) = Mid$(letters$, i, 1)
Next
'scramble array   Knuth Shuffle method
For i = L To 2 Step -1
    R = Int(i * Rnd) + 1
    Swap LS$(i), LS$(R)
Next
'now reform the Letters
Reform$ = ""
For i = 1 To L
    Reform$ = Reform$ + LS$(i)
Next

' Here is simple trick to non repetition > pair the letter with the next one up!!!
Code$ = ""
For i = 1 To L - 1
    Code$ = Code$ + Mid$(Reform$, i + 1, 1)
Next
'catch last letter pair to first
Code$ = Code$ + Mid$(Reform$, 1, 1)


': ---------------------------------------------------------------------------------
Dim Shared Cryptogram As Long
Dim Shared lbMessage As Long
Dim Shared tbMessage As Long
Dim Shared btCode As Long
Dim Shared lbCoded As Long
Dim Shared tbCode As Long
Dim Shared btDecode As Long
Dim Shared lbCodeMessage As Long
Dim Shared lbDecodedMessage As Long

': External modules: ---------------------------------------------------------------
'$Include:'InForm\InForm.bi'
'$Include:'InForm\xp.uitheme'
'$Include:'Cryptogram.frm'


Function encrypt$ (codeThis$)
    For i = 1 To Len(codeThis$)
        c$ = Mid$(codeThis$, i, 1)
        If InStr(letters$, c$) = 0 Then coded$ = coded$ + c$ Else coded$ = coded$ + encryptChar$(Mid$(codeThis$, i, 1))
    Next
    encrypt$ = coded$
End Function

Function decode$ (This$)
    For i = 1 To Len(This$)
        c$ = Mid$(This$, i, 1)
        If InStr(letters$, c$) = 0 Then dc$ = dc$ + c$ Else dc$ = dc$ + decodeChar$(Mid$(This$, i, 1))
    Next
    decode$ = dc$
End Function

Function encryptChar$ (forLetter$)
    p = InStr(Reform$, forLetter$)
    encryptChar$ = Mid$(Code$, p, 1)
End Function

Function decodeChar$ (Letter$)
    p = InStr(Code$, Letter$)
    decodeChar$ = Mid$(Reform$, p, 1)
End Function


': Event procedures: ---------------------------------------------------------------
Sub __UI_BeforeInit

End Sub

Sub __UI_OnLoad

End Sub

Sub __UI_BeforeUpdateDisplay
    'This event occurs at approximately 30 frames per second.
    'You can change the update frequency by calling SetFrameRate DesiredRate%

End Sub

Sub __UI_BeforeUnload
    'If you set __UI_UnloadSignal = False here you can
    'cancel the user's request to close.

End Sub

Sub __UI_Click (id As Long)
    Select Case id
        Case Cryptogram

        Case lbMessage

        Case tbMessage

        Case btCode
            Caption(lbCodeMessage) = encrypt$(Text(tbMessage))

        Case lbCoded

        Case tbCode

        Case btDecode
            Caption(lbDecodedMessage) = decode$(Text(tbCode))
            'SetFocus tbMessage  works

    End Select
End Sub

Sub __UI_MouseEnter (id As Long)
    Select Case id
        Case Cryptogram

        Case lbMessage

        Case tbMessage

        Case btCode

        Case lbCoded

        Case tbCode

        Case btDecode

    End Select
End Sub

Sub __UI_MouseLeave (id As Long)
    Select Case id
        Case Cryptogram

        Case lbMessage

        Case tbMessage

        Case btCode

        Case lbCoded

        Case tbCode

        Case btDecode

    End Select
End Sub

Sub __UI_FocusIn (id As Long)
    Select Case id
        Case tbMessage

        Case btCode

        Case tbCode

        Case btDecode

    End Select
End Sub

Sub __UI_FocusOut (id As Long)
    'This event occurs right before a control loses focus.
    'To prevent a control from losing focus, set __UI_KeepFocus = True below.
    Select Case id
        Case tbMessage

        Case btCode

        Case tbCode

        Case btDecode

    End Select
End Sub

Sub __UI_MouseDown (id As Long)
    Select Case id
        Case Cryptogram

        Case lbMessage

        Case tbMessage

        Case btCode

        Case lbCoded

        Case tbCode

        Case btDecode

    End Select
End Sub

Sub __UI_MouseUp (id As Long)
    Select Case id
        Case Cryptogram

        Case lbMessage

        Case tbMessage

        Case btCode

        Case lbCoded

        Case tbCode

        Case btDecode

    End Select
End Sub

Sub __UI_KeyPress (id As Long)
    'When this event is fired, __UI_KeyHit will contain the code of the key hit.
    'You can change it and even cancel it by making it = 0
    Select Case id
        Case tbMessage

        Case btCode

        Case tbCode

        Case btDecode

    End Select
End Sub

Sub __UI_TextChanged (id As Long)
    Select Case id
        Case tbMessage

        Case tbCode

    End Select
End Sub

Sub __UI_ValueChanged (id As Long)
    Select Case id
    End Select
End Sub

Sub __UI_FormResized

End Sub

'$Include:'InForm\InForm.ui'

.frm code too?

Code: (Select All)

': This form was generated by
': InForm - GUI library for QB64 - Beta version 7
': Fellippe Heitor, 2016-2018 - fellippe@qb64.org - [url=https://qb64phoenix.com/forum/member.php?action=profile&uid=325]@fellippeheitor[/url]
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
SUB __UI_LoadForm

    $RESIZE:ON
    DIM __UI_NewID AS LONG

    __UI_NewID = __UI_NewControl(__UI_Type_Form, "Cryptogram", 800, 300, 0, 0, 0)
    SetCaption __UI_NewID, "The Crypt"
    Control(__UI_NewID).Stretch = False
    Control(__UI_NewID).Font = SetFont("segoeui.ttf", 12)
    Control(__UI_NewID).CenteredWindow = True
    Control(__UI_NewID).CanResize = True

    __UI_NewID = __UI_NewControl(__UI_Type_Label, "lbMessage", 49, 21, 10, 10, 0)
    SetCaption __UI_NewID, "Message:"
    Control(__UI_NewID).Stretch = False
    Control(__UI_NewID).VAlign = __UI_Middle

    __UI_NewID = __UI_NewControl(__UI_Type_TextBox, "tbMessage", 780, 23, 10, 36, 0)
    SetCaption __UI_NewID, "Tell me a secret"
    Control(__UI_NewID).Stretch = False
    Control(__UI_NewID).HasBorder = True
    Control(__UI_NewID).CanHaveFocus = True

    __UI_NewID = __UI_NewControl(__UI_Type_Button, "btCode", 80, 23, 10, 64, 0)
    SetCaption __UI_NewID, "Code"
    Control(__UI_NewID).Stretch = False
    Control(__UI_NewID).CanHaveFocus = True

    __UI_NewID = __UI_NewControl(__UI_Type_Label, "lbCoded", 38, 21, 10, 175, 0)
    SetCaption __UI_NewID, "Coded:"
    Control(__UI_NewID).Stretch = False
    Control(__UI_NewID).VAlign = __UI_Middle

    __UI_NewID = __UI_NewControl(__UI_Type_TextBox, "tbCode", 780, 23, 10, 201, 0)
    SetCaption __UI_NewID, "???????????????????"
    Control(__UI_NewID).Stretch = False
    Control(__UI_NewID).HasBorder = True
    Control(__UI_NewID).CanHaveFocus = True

    __UI_NewID = __UI_NewControl(__UI_Type_Button, "btDecode", 80, 23, 10, 229, 0)
    SetCaption __UI_NewID, "Decode"
    Control(__UI_NewID).Stretch = False
    Control(__UI_NewID).CanHaveFocus = True

    __UI_NewID = __UI_NewControl(__UI_Type_Label, "lbCodeMessage", 780, 21, 10, 92, 0)
    SetCaption __UI_NewID, " "
    Control(__UI_NewID).Stretch = False
    Control(__UI_NewID).HasBorder = True
    Control(__UI_NewID).VAlign = __UI_Middle

    __UI_NewID = __UI_NewControl(__UI_Type_Label, "lbDecodedMessage", 780, 21, 10, 257, 0)
    SetCaption __UI_NewID, " "
    Control(__UI_NewID).Stretch = False
    Control(__UI_NewID).HasBorder = True
    Control(__UI_NewID).VAlign = __UI_Middle

END SUB

SUB __UI_AssignIDs
    Cryptogram = __UI_GetID("Cryptogram")
    lbMessage = __UI_GetID("lbMessage")
    tbMessage = __UI_GetID("tbMessage")
    btCode = __UI_GetID("btCode")
    lbCoded = __UI_GetID("lbCoded")
    tbCode = __UI_GetID("tbCode")
    btDecode = __UI_GetID("btDecode")
    lbCodeMessage = __UI_GetID("lbCodeMessage")
    lbDecodedMessage = __UI_GetID("lbDecodedMessage")
END SUB

snap of sample:
   

update testing download of The Crypt
   

and zip with all distribution files to run without InForm

[bplus]

The above really needs a key number to enter for coding and decoding. That would be next. Also there are much much much better methods to make code harder to break than this easy peasy coder!

[ahenry3068]

The above really needs a key number to enter for coding and decoding. That would be next. Also there are much much much better methods to make code harder to break than this easy peasy coder!

Did you see this https://qb64phoenix.com/forum/showthread...5#pid36485

and the expanded code HERE: https://qb64phoenix.com/forum/showthread...8#pid36508

[euklides]

Not very secure: the same letter replaces always the same other letter.


Please read about this coding system:  The Gold Bug  (1843), novel from Edgar Allan Poe ! 

[bplus]

@ahenry3068 you say seed I say number key, no I didn't see that link or maybe I did, coding systems can be kinda boring admittedly.

@euklides Read a book or get the gist of the thing in a minute?

AI:

In Edgar Allan Poe’s "The Gold-Bug" (1843), the code system is a mono-alphabetic substitution cipher used by character William Legrand to decode a message revealing Captain Kidd’s buried treasure. It replaces each letter of the alphabet with a specific symbol, number, or punctuation mark.
Key Details of the System:
Method: The cipher is broken using frequency analysis, where the most common symbols correspond to the most frequent letters in the English language (e.g., 'e', 't', 'a', 'o', 'i', 'n').
The Cryptogram: It begins with 53‡‡†305))6*;4826)4‡.) and uses characters like 8, ;, 4, ‡, ), and (.
Decryption: The message translates to: "A good glass in the bishop's hostel in the devil's seat twenty-one degrees and thirteen minutes northeast and by north main branch seventh limb east side shoot from the left eye of the death's-head a bee line from the tree through the shot fifty feet out".
Significance: This story is famous for popularizing cryptography in literature and demonstrating a methodical, rational approach to solving puzzles.
The code is not a simple Caesar shift but a complex substitution that requires analyzing the frequency of symbols, which Legrand explains in detail to the narrator.

I did say, "there are much much much better methods to make code harder to break than this easy peasy coder!"

I do have a system of numbers where none are repeated and there aren't blanks to separate words. So letter substitutions or word substitutions are useless.
But to keep the code secure you don't go around revealing how clever you are by showing off your system of coding.

Oh seeing frogs today!

[euklides]

It's not easy to catch frogs.  
But if we can't say anything in your country anymore, where does freedom go?
Of course I have also my own crypting system. 

[hsiangch_ong]

the folder name inside the zip file.  was spelled wrong.

i tried it on spirallinux (debian clone) with cinnamon desktop.  this is because i was worried.  about a slight defect in the screen shots above.  such poor font kerning.  it would have increased the security code a bit.  but only if exactly from what it had produced.  the user could get back the original readable phrase.

the encoding scheme is weak, yes.  but i found it sort of amusing.

the last "e" in "Message" was cut off.  not sure why.

---

almost forgot to mention.  the read-only text field.  doesn't allow copying.  i wasn't going to type in the whole encoded junk.  to see if i could get back english.

[bplus]

the folder name inside the zip file.  was spelled wrong.

Dyslexia strikes again! Not a critcal error just one for the critics

almost forgot to mention.  the read-only text field.  doesn't allow copying.  i wasn't going to type in the whole encoded junk.  to see if i could get back english.

 very good point, I tried a copy for a paste also, no joy!

Font kerning, never heard that expression before but also good point for this type app. Being able to see spaces double critical when copying code manually ie, no copy/paste to and from clipboard. Another feature to add to ToDo List for this app, use the clipboard to hold results.

[hsiangch_ong]

i'm sorry for the misleading message.  i didn't look over carefully.  the screenshot in the first post of this thread.  it revealed better that the crypt scheme isn't very good.  if the encrypted message has spaces in certain places.  then when it's decoded.  then those spaces appear in the same places.

i had thought it was bad font rendering.  "kerning" is how fonts are laid horizontally more or less.  for example in the word "troll".  with capital "t".  the "r" is fit under the "t" in "troll".  usually this is in "sans serif" font.  never in a monospaced font.

i say this because while using some windows programs.  on linux with wine.  the showing of the "default" windows font is variable.  in one operating system i tried.  the letters were too jagged.  also placing "w" then another letter right next to it.  tooked too funny.  anti-alias didn't make it better.  in fact made it more difficult to read.  when microsoft changed the "default" font in windows7 or whenever.  wine 8 and later sort of followed it.  the display got better as a result.  but still have to deal.  with the ends of text fields being chopped off.

[grymmjack]

@Bplus THANK YOU FOR SHARING SCREENSHOTS