Encrypt/Decrypt v0.1

[TempodiBasic]

Hi Guys

here a ASCII program that let to play just a little with cryptography. It shows several methods that are based on the single unique relation between  character before and after traslation...
Enjoy to crypt your message

[bplus]

Looks like simple substitution BUT! you change the substitution codes as you progress through the message. Correct?

Like ye ol Enigma machine?

Got to say, I don't understand menu and nothing stays up long enough for me to read it (I am slow with bad eyes, it's true.) and where is my coded message going?

[TempodiBasic]

Hi Bplus
 Thank's to take a look at my encrypt/decrypt

Yes you are right,
 in this very early version of the program it has been coded the procedure that I have called Traslation, because getting together the avaible symbols to use for the message, we can build a ring (a linear sequence that restart itself) and we can code and decode shifting from original position to coded position and then backward .
The first and the second methods are a variable version of the Giulius Ceaser's cipher as can see at this webpage
 https://en.wikipedia.org/wiki/Caesar_cipher,  while the other methods also if they make a substitution one to one they use different aritmetic method to choose the final coded symbol.
So on other hand if we want call this procedure Substitution, we must say also one to one  in fact substitution one to one because we can also make a substitution one to many in so many manners....

Yes you are right also about time elapsed to read results of coding and decoding....
To give more time to read and let go on to the user that don't want spend all those seconds I must substituite _DELAY with SLEEP
and so I can rise the number of seconds from 2 to 6.
Moreover the output shows original message, result message both in coding both in decoding. And there is also a timestamp... (it is the same because QB64 is very fast!) and the number of characters of the message as checksum.

Here the new version 0.2 of Encrypt/Decrypt

Code: QB64: [Select]

1. _TITLE "QB64 encrypt/decrypt 0.1"
2. CONST MessageConst = "QB64 is the best evolution of QB4.5 and PDS 7.1 for multiplatform BASIC programming. Moreover Inform is a powerful tool to use hardly for our projects."
3. CONST StepConst = 1, JumpConst = 0
4. CONST ALPHAbeta = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" '26 maiuscole + 26 minuscole + 10 cifre
5.  
6. DIM SHARED DecrMessage$
7. _CONTROLCHR OFF
8. SCREEN 0
9.  
10. '-----------starting  help
11. COLOR 31, 2
12. _PRINTSTRING (6, 1), "CRYPTING/DECRYPTING METHODS"
13. COLOR 15, 1
14. _PRINTSTRING (6, 2), "Using linear correlation between character at start time and at end time"
15. _PRINTSTRING (6, 3), "Each message has the same number of characters at the start and at the end"
16. _PRINTSTRING (6, 5), "Press ESC to end, from 0 to 8 for choosing method, M S R J to set variables"
17. COLOR 15, 0
18. VIEW PRINT 8 TO 22
19. CLS
20. help
21.  
22. '-----------           setting to default the variables of crypting
23. mesg$ = MessageConst
24. steps% = 1 'how calculate next encrypted value
25. seed% = 1 'starting value to encrytp
26. jump% = 0 ' how many characters jump the coding
27.  
28. ' main loop
29. DO
30.     ' here user select method of encrypting to show
31.     choice$ = INKEY$
32.     IF LEN(choice$) > 0 AND choice$ <> CHR$(27) THEN ' do nothing but fix bug
33.         CLS
34.         SELECT CASE choice$
35.             CASE "M", "m"
36.                 ' modifying message to crypting
37.                 INPUT "Please type the new message and then press Enter, hit only Enter to cancel:", mesg$
38.                 IF LEN(mesg$) = 0 THEN mesg$ = MessageConst
39.                 PRINT " you set this message "; mesg$
40.             CASE "S", "s"
41.                 'modifying step of codifing
42.                 INPUT "Please type the number to encode the message: ", steps%
43.                 IF steps% <= 0 THEN steps% = 1
44.                 PRINT " you set this STEP"; steps%
45.             CASE "R", "r"
46.                 'radix or seed of starting to calculate
47.                 INPUT "please type the number to start to coding: ", seed%
48.                 IF seed% <= 0 THEN seed% = 1
49.                 PRINT " you set this SEED/RADIX "; seed%
50.             CASE "J", "j"
51.                 ' jump the number of character of the message to code
52.                 INPUT "Please type how many characters to jump (no code):", jump%
53.                 PRINT " you set this JUMP (characters no coded) "; jump%
54.             CASE "0"
55.                 ' encryptfixForward
56.                 encryptFixF mesg$, steps%, jump%
57.                 encryptFixB DecrMessage$, steps%, jump%
58.             CASE "1"
59.                 'encryptfixBackward
60.                 encryptFixB mesg$, steps%, jump%
61.                 encryptFixF DecrMessage$, steps%, jump%
62.             CASE "2"
63.                 ' progressive linear method increasing (+) by 1-2-3-4 starting from seed%
64.                 encryptProg mesg$, 1, steps%, seed%, jump%
65.                 encryptProg DecrMessage$, 2, steps%, seed%, jump%
66.             CASE "3"
67.                 ' progressive linear method decreasing (-) by 1-2-3-4 from seed%
68.                 encryptProg mesg$, 2, steps%, seed%, jump%
69.                 encryptProg DecrMessage$, 1, steps%, seed%, jump%
70.             CASE "4"
71.                 ' progressive linear method  alternating +/- vs -/+ by 1-2-3-4 from seed%
72.                 encryptProg mesg$, 3, steps%, seed%, jump%
73.                 encryptProg DecrMessage$, 4, steps%, seed%, jump%
74.             CASE "5"
75.                 ' progressive linear method  alternating -/+ vs +/- by 1-2-3-4 from seed%
76.                 encryptProg mesg$, 4, steps%, seed%, jump%
77.                 encryptProg DecrMessage$, 3, steps%, seed%, jump%
78.             CASE "6"
79.                 ' progressive quadratic method increasing by 1^2 +seed%, 2^2 + seed%, 3^2+ seed%
80.                 encryptProg mesg$, 5, steps%, seed%, jump%
81.                 encryptProg DecrMessage$, 6, steps%, seed%, jump%
82.             CASE "7"
83.                 ' progressive quadratic method decreasing by 1^2 +seed%, 2^2 + seed%, 3^2+ seed%
84.                 encryptProg mesg$, 6, steps%, seed%, jump%
85.                 encryptProg DecrMessage$, 5, steps%, seed%, jump%
86.             CASE "8"
87.                 ' progressive quadratic method alternating +/- vs -/+ by 1^2 +seed%, 2^2 + seed%, 3^2+ seed%
88.                 encryptProg mesg$, 7, steps%, seed%, jump%
89.                 encryptProg DecrMessage$, 8, steps%, seed%, jump%
90.             CASE "9"
91.                 ' progressive quadratic method alternating -/+ vs +/- by 1^2 +seed%, 2^2 + seed%, 3^2+ seed%
92.                 encryptProg mesg$, 8, steps%, seed%, jump%
93.                 encryptProg DecrMessage$, 7, steps%, seed%, jump%
94.  
95.  
96.             CASE ELSE
97.                 ' here we manage exceptions
98.                 PRINT "THIS CASE IS NOT YET CODED"
99.         END SELECT
100.         ' _DELAY 2
101.         SLEEP 6
102.         CLS
103.         help
104.     END IF
105. LOOP UNTIL choice$ = CHR$(27)
106.  
107. END ' logic end of program
108.  
109. '-------------------area of SUBroutines and Functions
110. SUB help
111.     PRINT " 0 encryptfixForward"
112.     PRINT " 1 encryptfixBackward"
113.     PRINT " 2 progressive linear method increasing "
114.     PRINT " 3 progressive linear method decreasing "
115.     PRINT " 4 progressive linear method  alternating +/-"
116.     PRINT " 5 progressive linear method  alternating  -/+"
117.     PRINT " 6 progressive quadratic method increasing by n^2"
118.     PRINT " 7 progressive quadratic method decreasing by n^2"
119.     PRINT " 8 progressive quadratic method alternating +/- vs -/+ by n^2 "
120.     PRINT " M to set message to crypting"
121.     PRINT " S to set step of crypting"
122.     PRINT " R to set radix of crypting"
123.     PRINT " J to set how characters to jump"
124. END SUB
125.  
126. SUB encryptProg (Messag$, step1%, steps%, seed%, jump%)
127.     ' step1% chooses the method, step2% chooses the step of sequence to add to seed  , seed% is the starting value
128.     msg$ = Messag$
129.     MsgLen% = LEN(msg$)
130.     DecrMessage$ = ""
131.     step2% = steps%
132.     b% = 0
133.     c% = LEN(ALPHAbeta)
134.     st1% = seed%
135.     sign% = 1
136.  
137.     PRINT msg$, TIME$, MsgLen% 'before traslation
138.  
139.     SELECT CASE step1%
140.         CASE 1 ' progressive linear method increasing (+) by 1-2-3-4 starting from seed%
141.             FOR a% = 1 TO MsgLen% STEP 1
142.                 ch$ = MID$(msg$, a%, 1)
143.                 IF b% < jump% THEN
144.                     b% = b% + 1
145.                 ELSE
146.                     IF INSTR(ALPHAbeta, ch$) > 0 THEN
147.                         pos1% = INSTR(ALPHAbeta, ch$)
148.                         st1% = st1% + step2% 'increasing the added factor
149.                         step2% = step2% + 1 ' linear increasing sequence
150.                         IF st1% > c% THEN st1% = st1% MOD c%
151.                         IF (pos1% + st1%) > c% THEN pos1% = (pos1% + st1%) - c% ELSE pos1% = pos1% + st1%
152.                         ch$ = MID$(ALPHAbeta, pos1%, 1)
153.                     END IF
154.                     b% = 0
155.  
156.                 END IF
157.                 DecrMessage$ = DecrMessage$ + ch$
158.             NEXT
159.  
160.             PRINT DecrMessage$, TIME$, LEN(DecrMessage$) 'after traslation
161.  
162.         CASE 2 ' progressive linear method decreasing (-) by 1-2-3-4 from seed%
163.  
164.             FOR a% = 1 TO MsgLen% STEP 1
165.                 ch$ = MID$(msg$, a%, 1)
166.                 IF b% < jump% THEN
167.                     b% = b% + 1
168.                 ELSE
169.                     IF INSTR(ALPHAbeta, ch$) > 0 THEN
170.                         pos1% = INSTR(ALPHAbeta, ch$)
171.                         st1% = st1% + step2%
172.                         step2% = step2% + 1 'increasing the added factor
173.                         IF st1% > c% THEN st1% = st1% MOD c%
174.                         IF (pos1% - st1%) < 1 THEN pos1% = (pos1% - st1%) + c% ELSE pos1% = pos1% - st1%
175.                         ch$ = MID$(ALPHAbeta, pos1%, 1)
176.                     END IF
177.                     b% = 0
178.                 END IF
179.                 DecrMessage$ = DecrMessage$ + ch$
180.             NEXT
181.  
182.             PRINT DecrMessage$, TIME$ 'after traslation
183.  
184.         CASE 3, 4 ' progressive linear method  alternating +/- vs -/+ by 1-2-3-4 from seed%
185.             IF step1% = 4 THEN sign% = -1
186.             FOR a% = 1 TO MsgLen% STEP 1
187.                 ch$ = MID$(msg$, a%, 1)
188.                 IF b% < jump% THEN
189.                     b% = b% + 1
190.                 ELSE
191.                     IF INSTR(ALPHAbeta, ch$) > 0 THEN
192.                         pos1% = INSTR(ALPHAbeta, ch$)
193.                         st1% = st1% + step2%
194.                         step2% = step2% + 1 'increasing the added factor
195.                         IF st1% > c% THEN st1% = st1% MOD c%
196.                         IF sign% = 1 THEN
197.                             IF (pos1% + st1%) > c% THEN pos1% = (pos1% + st1%) - c% ELSE pos1% = pos1% + st1%
198.                         ELSE
199.                             IF (pos1% - st1%) < 1 THEN pos1% = (pos1% - st1%) + c% ELSE pos1% = pos1% - st1%
200.                         END IF
201.                         sign% = sign% * -1
202.                         ch$ = MID$(ALPHAbeta, pos1%, 1)
203.                     END IF
204.                     b% = 0
205.                 END IF
206.                 DecrMessage$ = DecrMessage$ + ch$
207.             NEXT
208.  
209.             PRINT DecrMessage$, TIME$ 'after traslation
210.  
211.         CASE 5 ' progressive quadratic method increasing by 1^2 +seed%, 2^2 + seed%, 3^2+ seed%
212.             FOR a% = 1 TO MsgLen% STEP 1
213.                 ch$ = MID$(msg$, a%, 1)
214.                 IF b% < jump% THEN
215.                     b% = b% + 1
216.                 ELSE
217.                     IF INSTR(ALPHAbeta, ch$) > 0 THEN
218.                         pos1% = INSTR(ALPHAbeta, ch$)
219.                         st1% = st1% + (step2% ^ 2) 'increasing the added factor
220.                         step2% = step2% + 1 ' linear increasing sequence
221.                         IF st1% > c% THEN st1% = st1% MOD c%
222.                         IF (pos1% + st1%) > c% THEN pos1% = (pos1% + st1%) - c% ELSE pos1% = pos1% + st1%
223.                         ch$ = MID$(ALPHAbeta, pos1%, 1)
224.                     END IF
225.                     b% = 0
226.  
227.                 END IF
228.                 DecrMessage$ = DecrMessage$ + ch$
229.             NEXT
230.  
231.             PRINT DecrMessage$, TIME$, LEN(DecrMessage$) 'after traslation
232.  
233.         CASE 6 ' progressive quadratic method decreasing by 1^2 +seed%, 2^2 + seed%, 3^2+ seed%
234.  
235.             FOR a% = 1 TO MsgLen% STEP 1
236.                 ch$ = MID$(msg$, a%, 1)
237.                 IF b% < jump% THEN
238.                     b% = b% + 1
239.                 ELSE
240.                     IF INSTR(ALPHAbeta, ch$) > 0 THEN
241.                         pos1% = INSTR(ALPHAbeta, ch$)
242.                         st1% = st1% + step2% ^ 2
243.                         step2% = step2% + 1 'increasing the added factor
244.                         IF st1% > c% THEN st1% = st1% MOD c%
245.                         IF (pos1% - st1%) < 1 THEN pos1% = (pos1% - st1%) + c% ELSE pos1% = pos1% - st1%
246.                         ch$ = MID$(ALPHAbeta, pos1%, 1)
247.                     END IF
248.                     b% = 0
249.                 END IF
250.                 DecrMessage$ = DecrMessage$ + ch$
251.             NEXT
252.  
253.             PRINT DecrMessage$, TIME$, LEN(DecrMessage$) 'after traslation
254.  
255.         CASE 7, 8 ' progressive quadratic method alternating +/- vs -/+ by 1^2 +seed%, 2^2 + seed%, 3^2+ seed%
256.  
257.             IF step1% = 8 THEN sign% = -1
258.             FOR a% = 1 TO MsgLen% STEP 1
259.                 ch$ = MID$(msg$, a%, 1)
260.                 IF b% < jump% THEN
261.                     b% = b% + 1
262.                 ELSE
263.                     IF INSTR(ALPHAbeta, ch$) > 0 THEN
264.                         pos1% = INSTR(ALPHAbeta, ch$)
265.                         st1% = st1% + step2%
266.                         step2% = step2% + 1 'increasing the added factor
267.                         IF st1% > c% THEN st1% = st1% MOD c%
268.                         IF sign% = 1 THEN
269.                             IF (pos1% + st1%) > c% THEN pos1% = (pos1% + st1%) - c% ELSE pos1% = pos1% + st1%
270.                         ELSE
271.                             IF (pos1% - st1%) < 1 THEN pos1% = (pos1% - st1%) + c% ELSE pos1% = pos1% - st1%
272.                         END IF
273.                         sign% = sign% * -1
274.                         ch$ = MID$(ALPHAbeta, pos1%, 1)
275.                     END IF
276.                     b% = 0
277.                 END IF
278.                 DecrMessage$ = DecrMessage$ + ch$
279.             NEXT
280.  
281.             PRINT DecrMessage$, TIME$, LEN(DecrMessage$) 'after traslation
282.  
283.  
284.         CASE ELSE
285.     END SELECT
286.  
287. END SUB
288.  
289. SUB encryptFixF (Messag$, step2%, jump%)
290.     ' crypting fixed forward
291.     msg$ = Messag$
292.     IF step2% < 0 THEN step1% = -step2% ELSE step1% = step2%
293.     MsgLen% = LEN(msg$)
294.     DecrMessage$ = ""
295.  
296.     b% = 0
297.     c% = LEN(ALPHAbeta)
298.     PRINT msg$, TIME$, MsgLen% 'before traslation
299.     FOR a% = 1 TO MsgLen% STEP 1
300.         ch$ = MID$(msg$, a%, 1)
301.         IF b% < jump% THEN
302.             b% = b% + 1
303.         ELSE
304.             IF INSTR(ALPHAbeta, ch$) > 0 THEN
305.                 pos1% = INSTR(ALPHAbeta, ch$)
306.                 IF (pos1% + step1%) > c% THEN pos1% = (pos1% + step1%) - c% ELSE pos1% = pos1% + step1%
307.                 ch$ = MID$(ALPHAbeta, pos1%, 1)
308.             END IF
309.             b% = 0
310.         END IF
311.         DecrMessage$ = DecrMessage$ + ch$
312.     NEXT
313.  
314.     PRINT DecrMessage$, TIME$, MsgLen% 'after traslation
315. END SUB
316.  
317. SUB encryptFixB (Messag$, step2%, jump%)
318.     ' crypting fixed backward
319.     msg$ = Messag$
320.     IF step2% > 0 THEN step1% = -step2% ELSE step1% = step2%
321.     MsgLen% = LEN(msg$)
322.     DecrMessage$ = ""
323.  
324.     b% = 0
325.     c% = LEN(ALPHAbeta)
326.     PRINT msg$, TIME$, MsgLen% 'before traslation
327.     FOR a% = 1 TO MsgLen% STEP 1
328.         ch$ = MID$(msg$, a%, 1)
329.         IF b% < jump% THEN
330.             b% = b% + 1
331.         ELSE
332.  
333.             IF INSTR(ALPHAbeta, ch$) > 0 THEN
334.                 pos1% = INSTR(ALPHAbeta, ch$)
335.                 IF (pos1% + step1%) < 1 THEN pos1% = (pos1% + step1%) + c% ELSE pos1% = pos1% + step1%
336.                 ch$ = MID$(ALPHAbeta, pos1%, 1)
337.             END IF
338.             b% = 0
339.         END IF
340.         DecrMessage$ = DecrMessage$ + ch$
341.     NEXT
342.  
343.     PRINT DecrMessage$, TIME$, MsgLen% 'after traslation
344. END SUB
345.  

STEP and RADIX/SEED affect the result of calculation, JUMP affect what character in the message will be encrypted, MESSAGE let choose a different message to translate.

It maybe interesting to code an engine to attack with brute force this encoder and to get original message without decoding...

Thank's for read and try