Encrypt and decrypt text with own alphabet from userform.

[Visor]

Dear friends of the forum, with the aim of generating a userform to encrypt and decrypt text I would like to achieve that what is written in textbox1 can enter in cell B2.
Likewise can show in the textbox1 what is contained in cell B2
The macro is made with characters selected in a personal way but I suppose the same should work
I appreciate your support for this approach.
I upload a file so you can see it.

 

[Hui]

You may want to consider extending that to multiple characters like

Sub escribirminusc()
dimletram As String, tletram As String, newletram As String
Dim i As Integer

letram = TextBox1.Text

Dim newletram As String
newletram = ""

For i = 1 To Len(letram)
  tletram = Mid(letram, i, 1)
  Select Case tletram
  Case Is = "a"
    newletram = newletram + "1"
  Case Is = "b"
    newletram = newletram + "2"
  Case Is = "c"
    newletram = newletram + "3"
  Case Is = "d"
    newletram = newletram + "4"
  Case Is = "e"
    newletram = newletram + "5"
  Case Is = "f"
    newletram = newletram + "6"
  Case Is = "g"
    newletram = newletram + "7"
  Case Is = "h"
    newletram = newletram + "8"
  Case Is = "i"
    newletram = newletram + "9"
  Case Is = "j"
    newletram = newletram + "{1"
  Case Is = "k"
    newletram = newletram + "{2"
  Case Is = "l"
    newletram = newletram + "{3"
  Case Is = "m"
    newletram = newletram + "{4"
  Case Is = "n"
    newletram = newletram + "{5"
  Case Is = "ñ"
    newletram = newletram + "{6"
  Case Is = "o"
    newletram = newletram + "{7"
  Case Is = "p"
    newletram = newletram + "{8"
  Case Is = "q"
    newletram = newletram + "{9"
  Case Is = "r"
    newletram = newletram + "[1"
  Case Is = "s"
    newletram = newletram + "[2"
  Case Is = "t"
    newletram = newletram + "[3"
  Case Is = "u"
    newletram = newletram + "[4"
  Case Is = "v"
    newletram = newletram + "[5"
  Case Is = "w"
    newletram = newletram + "[6"
  Case Is = "x"
    newletram = newletram + "[7"
  Case Is = "y"
    newletram = newletram + "[8"
  Case Is = "z"
    newletram = newletram + "[9"
  End Select

Next i

Hoja1.Cells(2, 2) = newletram
End Sub

 

[Marc L]

As a starter :​

Function Crypto$(ByVal S$)
          Dim B() As Byte, L&
              B = StrConv(S, vbFromUnicode)
          For L = 0 To UBound(B):  B(L) = 255 - B(L):  Next
         Crypto = StrReverse$(StrConv(B, vbUnicode))
End Function

Sub Demo1()
    Debug.Print Crypto("ѐ•žž‹ß‘–ŒßӐ•ž‹žß†ž—ߐ±")
End Sub

Sub Demo2()
    Debug.Print Crypto("Have a good day !")
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Visor]

Dear teacher Hui, yes! Likewise, it's just how I want it to work.
But as I see what you have written is "ello handoo" as the capital letter H and C has not come out






How is it possible to write Hello Chandoo, capital letters and minuscule?

I also can not decipher when I click on the READ button
Also, how can I make it so that I incorporate zero 0 so that I insert a space between each word each time I press the spacebar?
Thanks again for everything
I upload the file again
so you can see the advances.

Thanks Marc L but I'm not really looking for UDF, I'd like to use the userform

 

[Visor]

Greetings Master Hui, I understood, .. the solution was that I join all the codes of the select case, .. so I did and it turned out very well.
What I have left is to incorporate the space bar and insert a zero "0" in the sheet and then use the READ button
sorry I was slow to understand

 

[Visor]

Master Hui, this result very goo!!

Case Is = Chr(32)
newletraMay = newletraMay + "0"

to include space.

only, is error decrypt gtext when I use LEER button

 

[Visor]

Dear Marc L,
The lightness sometimes brings problems! I apologize..
And that happens to me because I do not know how to handle functions from the userforms

I have now reviewed that I am on the desktop with my own PC, I have seen that you use functions and this mecrum and decode with extraordinary precision, and although it is not a proper or capricious alphabet works perfectly .. But I have a question, those who want to decipher They will achieve quickly if they have the same knowledge of yours, because the symbols are public.
In the alphabet itself, it will take them a long time to decipher, and this is what makes it different, in this subject

 

[Marc L]

It was first a sample to show you another way at same first level
difficulty to decipher but yes as your alphabet ciphering is unusual …

A level 2 sample :​

Function CryptoNU6$(ByVal S$)
    Dim B() As Byte, L&, M As Byte, D As Byte
        B = StrConv(S, vbFromUnicode)
    For L = 0 To UBound(B)
                    M = B(L) Mod 32
        Select Case M
              Case 0, 1, 4, 5, 26, 27, 30, 31:     D = 26
              Case 2, 3, 6, 7, 24, 25, 28, 29:     D = 22
              Case 8, 9, 12, 13, 18, 19, 22, 23:   D = 10
              Case Else:                           D = 6
        End Select
              B(L) = B(L) + IIf(M > 15, -D, D)
    Next
         CryptoNU6 = StrReverse$(StrConv(B, vbUnicode))
End Function

Sub DemoNU6_1()
    Debug.Print CryptoNU6("4up{x{hn:tsi:6up{n{:c{r:uT")
End Sub

Sub DemoNU6_2()
    Debug.Print CryptoNU6("Have a good day !")
End Sub

You may Like it !
​

 

[Visor]

Great, although it leaves me with no questions because I do not know if it is associated to a pre-established code, or it is generated randomly. If it is one established as ASCII, some good expert will decipher it.
That is why he proposed his own alphabet.
I would like to do a test:
Can you tell me what is the message I have written here below?

;vlh{w:{:iost}:is:isrn:6vvm:}{iiw:rn:ihrjsy~:nc:~t{:hnnv:w{i:rn:hu|:ihny{h{ry:nth||s~:imuri:nbn:rn:n{rn:nut:un:}tsnihnts:is:ns:6V:yh{W:h{^

Equally, Master my sincere regards, very grateful for your support

 

[Marc L]

Yes EZ with my code like « ge well, this is genius a marvel! » …
But without any code if I do not know its algorithm
it's more difficult to break …
(as my demonstrations come from encryptions I broke …)

See also the World War II Enigma algorithm using different
keys so even with the code if you do not have the right keys
it could be a mess to decipher …

A sample (english) :
Ymubwt dmec yt jd ric evw uim cobt vn kbgorbgogoe wpss
dmec ujjm cc y tjmmcor ntwdfpnbri xfp llput xffpf zmv mgwc.

A pretty good privacy needs a stronger level 3 encryption
but before to see a sample of a jewel I made,
back between level 1 & 2 with this :

but yes as your alphabet ciphering is unusual …

I found in my archives a code near to the one of your initial
post using a char key & 1 to 9 for each original character
(so not so unusual …) :​

Function Encrypt9$(ByVal S$)
    Dim B() As Byte, L&
        B = S
    For L = 0 To UBound(B) Step 2
        B(L + 1) = 49 + B(L) Mod 9
        B(L) = 227 + B(L) \ 9
    Next
         Encrypt9 = StrReverse$(StrConv(B, vbUnicode))
End Function

Function Decrypt9$(ByVal S$)
    Dim B() As Byte, L&, C%
        If Len(S) Mod 2 Then Exit Function
        B = StrConv(StrReverse(S), vbFromUnicode)
    For L = 0 To UBound(B) Step 2
        C = (B(L) - 227) * 9 + B(L + 1) - 49
        If C < 0 Or C > 255 Then Exit Function
        B(L) = C
        B(L + 1) = 0
    Next
         Decrypt9 = B
End Function

Sub DemoD9()
    Debug.Print Decrypt9("2è4ï8î8í9í8í7ï9ï6æ3ï7î8ï6æ9ç4ï8î8í9ï8í6æ5ð8í6î6æ4ï7ë")
End Sub

Sub DemoE9()
    Debug.Print Encrypt9("Have a good day !")
End Sub

You should Like it !
​

 

[Visor]

Hi
I do not know what's going on but I do not see how it works


The text that is there, copy it from your previous post

 

[Marc L]

I use it only in VBA, never in worksheets (as often private functions)
but I just try a formula in a worksheet : it rocks without any issue !



So you just made an error within your formulas …
​

 

[Visor]

I saw that it was a UDF function, so I used it in the worksheet
but,..
I got lost, ... Maybe I should use it in a userform ... !! ??

 

[Marc L]

The place doesn't matter as the logic doesn't change …

Don't you see each time the VBA demonstrations ?! So just try them …

For your formula errors, very EZ logic, according to my previous screenshot,
from initial text in G2, what are the formulas in G4 & G6 cells ?
​

 

[Visor]

That's why I said I got lost, because in G4 I have



and, in G6 I have

 

[Marc L]

I have exactly the same without the { character;
maybe it depends where you have pasted the code …

But try at least my VBA Demo procedures as the purpose
of those functions was clearly not to be like any UDF,
a nonsense in term of privacy ! As there are Private
in a "protected" module or in a standalone workbook …
​