Password Seeded Bit Encryption

[lawsonm1]

Here is a program for encrypting and decrypting files. I did not write it, and I'm sure the NSA could break it in two femtoseconds, but I have used it and it seems to work. I am thinking of adding the ability to do batch encrypt/decrypt on my list of things I want to do.

Anyway, I was thinking you all might want to add this to the Samples Gallery or Programs sections. Thanks, Mike

Code: QB64: [Select]

1. ['''
2. ' P_S_B_E (Password_Seeded_Bit_Encryption), version 1.1
3. '
4. ' (C)opyright 2004, Pure QB Innovations
5. '
6. '
7. ' Email any questions, comments, or beta results to...
8. ' ESmemberNEMESIS@aol.com
9. '
10. ' Visit the Pure QB Innovations web site at...
11. ' http://members.aol.com/esmembernemesis/index.htm
12. '
13. ' THIS PROGRAM MAY BE DISTRIBUTED FREELY AS PUBLIC DOMAIN SOFTWARE
14. ' AS LONG AS ANY PART OF THIS FILE IS NOT ALTERED IN ANY WAY.
15. ' IF YOU DO WISH TO USE THESE ROUTINES IN YOUR OWN PROGRAMS
16. ' THEN PLEASE GIVE CREDIT TO THE AUTHOR... Mario LaRosa.
17. '
18. '''
19. '
20. ON ERROR GOTO Event
21. '
22. DEFINT A-Z
23. '
24. SCREEN 0: WIDTH 80
25. '
26. GOSUB Title
27. GOSUB Menu
28. GOSUB File
29. GOSUB Pass
30. GOSUB Plant
31. GOSUB Algorithm
32. GOSUB Status
33. '
34. RUN
35. '
36. Title:
37. CLS
38. COLOR 8: LOCATE 25, 1: PRINT "( )opyright 2004,";
39. COLOR 7: LOCATE 25, 2: PRINT "C";
40. COLOR 4: LOCATE 25, 19: PRINT "Pure";
41. COLOR 2: LOCATE 25, 24: PRINT "QB";
42. COLOR 1: LOCATE 25, 27: PRINT "Innovations";
43. COLOR 8: LOCATE 1, 25: PRINT "Password_Seeded_Bit_Encryption"
44. COLOR 7: LOCATE 1, 25: PRINT "P"
45. LOCATE 1, 34: PRINT "S"
46. LOCATE 1, 41: PRINT "B"
47. LOCATE 1, 45: PRINT "E"
48. RETURN
49. '
50. Menu:
51. COLOR 8
52. PRINT: PRINT: PRINT
53. PRINT "Please choose an option..."
54. PRINT
55. PRINT " [";: COLOR 7: PRINT "D";: COLOR 8: PRINT "]ecrypt file"
56. PRINT " [";: COLOR 7: PRINT "E";: COLOR 8: PRINT "]ncrypt file"
57. PRINT " [";: COLOR 7: PRINT "Q";: COLOR 8: PRINT "]uit PSBE"
58. DO
59.     K$ = INKEY$
60.     SELECT CASE UCASE$(K$)
61.         CASE "E"
62.             Choice$ = "encrypt"
63.             EXIT DO
64.         CASE "D"
65.             Choice$ = "decrypt"
66.             EXIT DO
67.         CASE "Q"
68.             COLOR 7
69.             SYSTEM
70.     END SELECT
71. LOOP
72. RETURN
73. '
74. File:
75. GOSUB Title
76. COLOR 8
77. PRINT: PRINT: PRINT "Enter the name (including the source path),"
78. PRINT "of the file you wish to "; Choice$; "..."
79. COLOR 7: PRINT: LINE INPUT " "; File$
80. FileNum = FREEFILE
81. OPEN File$ FOR BINARY AS FileNum
82. LenFile& = LOF(FileNum)
83. IF LenFile& = 0 THEN CLOSE FileNum: KILL File$: ERROR 53
84. RETURN
85. '
86. Pass:
87. COLOR 8
88. PRINT: PRINT "Enter password to "; Choice$; " this file..."
89. COLOR 7
90. PRINT: LINE INPUT " "; Password$
91. LenPassword = LEN(Password$)
92. IF LenPassword < 1 THEN
93.     COLOR 4
94.     PRINT: PRINT "Password not legal."
95.     SLEEP 2
96.     RUN
97. END IF
98. RETURN
99. '
100. Plant:
101. seed& = &H8000
102. RANDOMIZE LenPassword
103. FOR x = 1 TO LenPassword
104.     r = INT(RND(1) * LenPassword + 1)
105.     seed& = seed& + ASC(MID$(Password$, r, 1)) + (&H100 * (x - 1))
106. NEXT
107. RANDOMIZE seed&
108. RETURN
109. '
110. Algorithm:
111. COLOR 4: PRINT: PRINT "Are you sure?"
112. COLOR 8: PRINT: PRINT " [ ]o or [ ]es";
113. COLOR 15: LOCATE 15, 3: PRINT "N"
114. LOCATE 15, 11: PRINT "Y"
115. DO
116.     K$ = INKEY$
117.     SELECT CASE UCASE$(K$)
118.         CASE "Y"
119.             COLOR 2: PRINT: PRINT "..."; Choice$; "ing..."
120.             EXIT DO
121.         CASE "N"
122.             RUN
123.     END SELECT
124. LOOP
125. DIM b AS STRING * 1
126. SELECT CASE Choice$
127.     CASE "encrypt"
128.         FOR i& = 1 TO LenFile&
129.             GET FileNum, i&, b
130.             r = INT(RND(1) * LenPassword + 1)
131.             f = ASC(MID$(Password$, r, 1))
132.             s = ASC(b)
133.             n = (f + s) AND 255
134.             b = CHR$(n)
135.             PUT FileNum, i&, b
136.         NEXT
137.     CASE "decrypt"
138.         FOR i& = 1 TO LenFile&
139.             GET FileNum, i&, b
140.             r = INT(RND(1) * LenPassword + 1)
141.             f = ASC(MID$(Password$, r, 1))
142.             s = ASC(b)
143.             n = (s - f) AND 255
144.             b = CHR$(n)
145.             PUT FileNum, i&, b
146.         NEXT
147. END SELECT
148. CLOSE FileNum
149. RETURN
150. '
151. Status:
152. COLOR 7
153. PRINT: PRINT "File has been "; Choice$; "ed."
154. SLEEP 2
155. RETURN
156. '
157. Event:
158. COLOR 4: PRINT: PRINT "File not found."
159. SLEEP 2
160. RUN
161. '
162.  
163. ]

[Qwerkey]

It is preferable to put a post with Program Code into the Programs Section, rather than QB64 Discussion.  It is likely to get forgotten here.  This for futre reference.