updated license and email addresses
[qbasicapps.git] / unsorted / passw.bas
1 ' Svjatoslav Agejenko svjatoslav@svjatoslav.eu year:2002\r
2 ' See or modify "passwd.dat" for password.\r
3 ' Is useful when compiled into EXE, and put into AUTOEXEC.BAT\r
4 \r
5 CHDIR ".\qbasicapps\unsorted"\r
6 \r
7 \r
8 DECLARE SUB check (a$)\r
9 DECLARE SUB start ()\r
10 DECLARE SUB mkv (s%, C%)\r
11 DECLARE SUB box (x1%, y1%, x2%, y2%)\r
12 \r
13 DIM SHARED cha\r
14 DIM SHARED pwd$\r
15 \r
16 start\r
17 \r
18 x = 25\r
19 x2 = 10\r
20 x3 = 0\r
21 B$ = ""\r
22 1\r
23 x = x + xs\r
24 IF x > 0 THEN xs = xs - .5\r
25 IF x < 0 THEN xs = xs + .5\r
26 xs = xs - (xs / 8)\r
27 IF x2 > 100 THEN x2 = 10\r
28 LINE (x2, 10)-(x2, 60), 0\r
29 PSET (x2, x + 35), 10\r
30 IF x2 < 99 THEN LINE (x2 + 1, 10)-(x2 + 1, 60), 3\r
31 x2 = x2 + 1\r
32 x3 = x3 + 1\r
33 IF x3 > 40 THEN x3 = 0: xs = xs - 5: SOUND 1000, 1\r
34 \r
35 SOUND 0, .5\r
36 \r
37 a$ = INKEY$\r
38 IF a$ = CHR$(13) THEN\r
39 check B$\r
40 B$ = ""\r
41 GOTO 2\r
42 END IF\r
43 IF a$ <> "" THEN\r
44 IF a$ = CHR$(8) THEN\r
45 IF LEN(B$) > 0 THEN B$ = LEFT$(B$, LEN(B$) - 1): GOTO 2\r
46 GOTO 2\r
47 END IF\r
48 B$ = B$ + a$\r
49 IF LEN(B$) > 10 THEN B$ = LEFT$(B$, 10)\r
50 2\r
51 FOR a = 1 TO 10\r
52 IF a <= LEN(B$) THEN C = 5 ELSE C = 1\r
53 CIRCLE (a * 15 + 20, 150), 6, C\r
54 PAINT (a * 15 + 20, 150), C\r
55 NEXT a\r
56 END IF\r
57 GOTO 1\r
58 \r
59 DEFINT A-Z\r
60 SUB box (x1, y1, x2, y2)\r
61 LINE (x1 + 1, y1 + 1)-(x2 - 1, y2 - 1), 0, BF\r
62 LINE (x1, y1)-(x2, y2), 10, B\r
63 LINE (x1, y1)-(x2, y1 - 9), 14, BF\r
64 LINE (x1, y1)-(x2, y1 - 9), 10, B\r
65 \r
66 LINE (x2 - 2, y1 - 2)-(x2 - 7, y1 - 7), 7, BF\r
67 LINE (x2 - 9, y1 - 2)-(x2 - 14, y1 - 7), 7, BF\r
68 \r
69 LINE (x2 - 2, y1 - 2)-(x2 - 7, y1 - 7), 0\r
70 LINE (x2 - 2, y1 - 7)-(x2 - 7, y1 - 2), 0\r
71 \r
72 LINE (x2 - 10, y1 - 3)-(x2 - 13, y1 - 3), 0\r
73 END SUB\r
74 \r
75 DEFSNG A-Z\r
76 SUB check (a$)\r
77 cha = cha - 1\r
78 \r
79 IF a$ = pwd$ THEN CLS : SCREEN 2: SYSTEM\r
80 \r
81 DIM buf(1 TO 3000)\r
82 \r
83 GET (79, 80)-(241, 141), buf(1)\r
84 \r
85 box 80, 90, 240, 140\r
86 LOCATE 14, 14\r
87 COLOR 12\r
88 PRINT "Wrong passworD"\r
89 COLOR 5\r
90 \r
91 LOCATE 16, 13\r
92 PRINT STR$(cha) + " chanses left"\r
93 \r
94 FOR a = 1 TO 30\r
95 SOUND 0, 1\r
96 NEXT a\r
97 \r
98 IF cha = 0 THEN\r
99 DIM buf2(1000)\r
100 GET (79, 138)-(241, 140), buf2\r
101 FOR a = 1 TO 40\r
102 PUT (79, 138 + a), buf2, PSET\r
103 SOUND 0, .5\r
104 NEXT a\r
105 \r
106 LOCATE 19, 14\r
107 COLOR 12\r
108 PRINT "SYSTEM HALTED"\r
109 LOCATE 21, 14\r
110 PRINT "SUCESSFULLY!!"\r
111 3\r
112 GOTO 3\r
113 END IF\r
114 \r
115 \r
116 PUT (79, 80), buf(1), PSET\r
117 \r
118 \r
119 END SUB\r
120 \r
121 DEFINT A-Z\r
122 SUB mkv (s, C)\r
123 FOR x = 160 TO 319 STEP s\r
124 LINE (x, 0)-(x, 199), C\r
125 LINE (320 - x, 0)-(320 - x, 199), C\r
126 NEXT x\r
127 \r
128 FOR y = 100 TO 199 STEP s\r
129 LINE (0, y)-(319, y), C\r
130 LINE (0, 200 - y)-(319, 200 - y), C\r
131 NEXT y\r
132 \r
133 END SUB\r
134 \r
135 DEFSNG A-Z\r
136 SUB start\r
137 \r
138 OPEN "passw.dat" FOR INPUT AS #1\r
139 LINE INPUT #1, pwd$\r
140 CLOSE #1\r
141 \r
142 SCREEN 13\r
143 \r
144 cha = 3\r
145 \r
146 s = 2\r
147 FOR C = 16 TO 31\r
148 s = s * 1.4\r
149 mkv INT(s), INT(C)\r
150 NEXT C\r
151 mkv INT(s), 0\r
152 \r
153 \r
154 box 70, 20, 270, 90\r
155 \r
156 COLOR 5\r
157 LOCATE 8, 10\r
158 PRINT "           stack dump:"\r
159 LOCATE 9, 10\r
160 PRINT "010010010010010010010100"\r
161 \r
162 LOCATE 10, 10\r
163 PRINT "Running rocket ground"\r
164 LOCATE 11, 10\r
165 PRINT "control system..."\r
166 \r
167 box 9, 9, 101, 61\r
168 \r
169 box 20, 130, 300, 190\r
170 \r
171 LOCATE 18, 5\r
172 PRINT "ENTER PASSWORD:"\r
173 \r
174 END SUB\r
175 \r