1 REM Ins{nd av J|rgen Westman <5074>    1989-03-06 18.10.47 (KERMIT)
100 REM +++++++++++++++++++++++++++++++
102 REM ! Program ....   KORTKOD
104 REM ! Utg}va  1.1    89-03-05
106 REM ! av J|rgen Westman <5074>
108 REM !
110 REM ! Minne 16-32 Kbytes
112 REM ! Flexskiva kr{vs
114 REM ! DES skall vara installerad
116 REM +++++++++++++++++++++++++++++++
118 REM 
120 DIM K1$=122,K2$=122,L$=122
122 F$=CHR$(159%,141%) : REM Felkoder
124 H$='0123456789ABCDEF'
126 C%=PEEK(65052%)+256%*PEEK(65053%)-3%
128 IF PEEK(C%)<>195% ; 'Des ej installerad !' : STOP 
130 REM 
132 E%=0% : ; CHR$(12%,7%)CUR(8%,0%)
134 ; 'L{gga till koder              < K >'
136 ; 'L{sa koder                    < L >'
138 ; 'Radera koder                  < R >'
140 ; '[ndra L|senord                < [ >'
142 ; 'Initiera L|senord             < I >'
144 ; 'Sluta                         < S >'
146 ; 
148 ; CUR(22%,0%)'                                  >'
150 ; CUR(22%,0%)'V{lj enligt ovan              < ';
152 GET Q$ : ; Q$
154 ON (INSTR(1%,'kKlL{[sSiIrR',Q$)+3%)/2% GOTO 150,158,180,230,270,252,202
156 REM 
158 REM L{gga till koder
160 REM 
162 ; CHR$(12%,7%)CUR(2%,0%)'L|senord: ';
164 GOSUB 470 : REM L{s L|senord 
166 IF E% THEN 264
168 GOSUB 520 : REM Kontrollera L|senord
170 IF E% THEN 264
172 GOSUB 354 : REM L{gg till kodad text
174 IF E% THEN 264
176 GOSUB 274 : GOTO 132
178 REM 
180 REM L{sa Koder
182 REM 
184 ; CHR$(12%,7%)CUR(2%,0%)'L|senord: ';
186 GOSUB 470 : REM L{s L|senord
188 IF E% THEN 264
190 GOSUB 520 : REM Kontrollera L|senord
192 IF E% THEN 264
194 R%=0% : GOSUB 404 : REM L{s kodad text
196 IF E% THEN 264
198 GOSUB 274 : GOTO 132
200 REM 
202 REM Radera Koder
204 REM 
206 ; CHR$(12%,7%)CUR(2%,0%)'L|senord: ';
208 GOSUB 470 : REM L{s L|senord 
210 IF E% THEN 264
212 GOSUB 520 : REM Kontrollera L|senord
214 IF E% THEN 264
216 R%=-1% : GOSUB 404 : REM L{s kodad text
218 IF E% THEN 264
220 IF R%=0% THEN 226
222 GOSUB 602 : REM Ta bort koden
224 IF E% THEN 264
226 GOSUB 274 : GOTO 132
228 REM 
230 REM [ndra L|senord
232 REM 
234 ; CHR$(12%,7%)CUR(2%,0%)'Gammalt L|senord: ';
236 GOSUB 470 : REM L{s L|senord
238 IF E% THEN 264
240 GOSUB 520 : REM Kontrollera L|senord
242 IF E% THEN 264
244 GOSUB 282 : REM [ndra L|senord
246 IF E% THEN 264
248 GOSUB 274 : GOTO 132
250 REM 
252 REM Initiera L|senord
254 REM 
256 GOSUB 332
258 IF E% THEN 264
260 GOSUB 274 : GOTO 132
262 REM 
264 REM Avslut vid fel
266 REM 
268 ; CUR(22%,0%)SPACE$(40%)CHR$(7%)CUR(22%,0%)'Fel, f|rs|k igen '; : GET Q$ : GOTO 132
270 END 
272 REM 
274 REM Godk{nd avslutning
276 REM 
278 ; CHR$(7%)CUR(22%,0%)'Klar tryck <CR> '; : GET Q$ : RETURN 
280 REM 
282 REM [ndra password
284 REM 
286 ONERRORGOTO 328
288 PREPARE 'des.tmp' ASFILE 2
290 OPEN 'des.qrp' ASFILE 1 : INPUTLINE #1,K2$ : REM L|senord
292 ONERRORGOTO 302
294 INPUTLINE #1,L$ : K1$=LEFT$(L$,LEN(L$)-2%) : REM kodad text
296 INPUTLINE #1,L$ : K1$=K1$+LEFT$(L$,LEN(L$)-2%)
298 GOSUB 574 : REM Avkoda
300 ; #2,C$ : GOTO 292
302 IF ERRCODE<>34% THEN 328
304 CLOSE 1 : CLOSE 2
306 GOSUB 332 : IF E% THEN RETURN 
308 ONERRORGOTO 326
310 PREPARE 'des.qrp' ASFILE 1 : ; #1,K1$
312 OPEN 'des.tmp' ASFILE 2
314 ONERRORGOTO 322
316 INPUTLINE #2,C$ : C$=LEFT$(C$,LEN(C$)-2%)
318 GOSUB 542 : REM Koda
320 L%=LEN(K1$)/2% : ; #1,LEFT$(K1$,L%) : ; #1,RIGHT$(K1$,L%+1%) : GOTO 314
322 IF ERRCODE<>34% THEN 326
324 CLOSE 1 : CLOSE 2 : KILL 'des.tmp' : RETURN 
326 CLOSE 1 : CLOSE 2 : E%=-1% : RETURN 
328 CLOSE 1 : CLOSE 2 : KILL 'des.tmp' : E%=-1% : RETURN 
330 REM 
332 REM Initiera Nytt < L|senord >
334 REM 
336 REM Utdata des.qrp, k1$
338 REM 
340 ; CHR$(12%,7%)CUR(2%,0%)'Nytt L|senord: ';
342 GOSUB 470 : IF E% THEN RETURN 
344 ; CHR$(12%,7%)CUR(2%,0%)'Verifiera L|senord: ';
346 GOSUB 496 : IF E% THEN RETURN 
348 ONERRORGOTO 352
350 PREPARE 'des.qrp' ASFILE 1 : ; #1,K1$ : CLOSE 1 : RETURN 
352 E%=-1% : RETURN 
354 REM 
356 REM L{gg till text
358 REM 
360 ; CHR$(12%,7%)CUR(2%,0%)'Ge text att koda ( max 58 tecken )'
362 ; CUR(4%,0%)'> '; : INPUTLINE C$ : L%=LEN(C$)-2%
364 IF L%>58% THEN E%=-1% : RETURN 
366 C$=LEFT$(C$,L%)
368 GOSUB 542 : REM Koda
370 ONERRORGOTO 400
372 PREPARE 'des.tmp' ASFILE 2
374 ONERRORGOTO 396
376 OPEN 'des.qrp' ASFILE 1
378 ONERRORGOTO 382
380 INPUTLINE #1,L$ : ; #2,LEFT$(L$,LEN(L$)-2%) : GOTO 380
382 CLOSE 1 : IF ERRCODE<>34% THEN 400
384 L%=LEN(K1$)/2% : ; #2,LEFT$(K1$,L%) : ; #2,RIGHT$(K1$,L%+1%)
386 CLOSE 2 : ONERRORGOTO 394
388 PREPARE 'des.qrp' ASFILE 1
390 OPEN 'des.tmp' ASFILE 2
392 INPUTLINE #2,L$ : L$=LEFT$(L$,LEN(L$)-2%) : ; #1,L$ : GOTO 392
394 CLOSE 1 : CLOSE 2 : IF ERRCODE=34% THEN 398
396 E%=-1% : RETURN 
398 KILL 'des.tmp' : RETURN 
400 CLOSE 2 : E%=-1% : RETURN 
402 REM 
404 REM L{s kodad text
406 REM 
408 GOSUB 442
410 ONERRORGOTO 440
412 OPEN 'des.qrp' ASFILE 1 : INPUTLINE #1,K2$ : REM L|senord
414 ONERRORGOTO 434
416 INPUTLINE #1,L$ : K1$=LEFT$(L$,LEN(L$)-2%) : REM kodad text
418 INPUTLINE #1,L$ : K1$=K1$+LEFT$(L$,LEN(L$)-2%) : S%=S%+1%
420 GOSUB 574 : REM Avkoda
422 IF R% THEN ; LEFT$('<'+NUM$(S%)+'   ',5%)+'> ';
424 ; C$
426 IF S%<15% THEN 414
428 IF R%=0% THEN ; CHR$(7%)CUR(22%,0%)'Tryck <CR> f|r n{sta sida '; : GET Q$ : GOSUB 442 : GOTO 414
430 GOSUB 444 : IF L%=0% THEN GOSUB 442 : GOTO 414
432 CLOSE 1 : RETURN 
434 CLOSE 1 : IF ERRCODE<>34% THEN 440
436 IF R% AND S% THEN GOSUB 444 : IF L%=0% THEN R%=0%
438 RETURN 
440 E%=-1% : RETURN 
442 S%=0% : ; CHR$(12%)CUR(2%,0%)STRING$(12%,61%)' AVKODAD TEXT 'STRING$(12%,61%)CUR(4%,0%); : RETURN 
444 ; CHR$(7%)CUR(22%,0%)'Ange den kod som skall raderas, <CR> f|r n{sta sida, eller slut '; : INPUTLINE Q$
446 ; CUR(22%,0%)SPACE$(70%);
448 IF R%=-1% THEN R%=0%
450 L%=LEN(Q$)-2% : IF L%=0% THEN R%=R%+S% : RETURN 
452 Q$=LEFT$(Q$,L%)
454 FOR I%=1% TO L%
456 IF INSTR(1%,' 0123456789',MID$(Q$,I%,1%))=0% THEN 444
458 NEXT I%
460 L%=VAL(Q$)
462 IF L%=0% OR L%>S% THEN 444
464 R%=R%+L%
466 RETURN 
468 REM 
470 REM L{s, Koda, Initiera < L|senord >
472 REM 
474 REM Utdata K1$ : Kodat password
476 REM 
478 K$=''
480 GET Q$ : S%=ASC(Q$) : IF S%=13% THEN 486
482 IF S%<95% AND S%>63% THEN Q$=CHR$(S% OR 32%)
484 K$=K$+Q$ : GOTO 480
486 K$=LEFT$(K$+SPACE$(8%),8%) : C$=K$
488 Z%=CALL(C%,1%) : REM Initiera nycklarna
490 GOSUB 542 : REM Koda password
492 RETURN 
494 REM 
496 REM L{s, Koda < L|senord >
498 REM 
500 REM Utdata K1$ : Kodat password
502 REM 
504 C$=''
506 GET Q$ : S%=ASC(Q$) : IF S%=13% THEN 512
508 IF S%<95% AND S%>63% THEN Q$=CHR$(S% OR 32%)
510 C$=C$+Q$ : GOTO 506
512 C$=LEFT$(C$+SPACE$(8%),8%)
514 GOSUB 542 : REM Koda password
516 RETURN 
518 REM 
520 REM Kontrollera < L|senord >
522 REM 
524 REM Indata K1$
526 REM 
528 ONERRORGOTO 538
530 OPEN 'des.qrp' ASFILE 1 : INPUTLINE #1,K2$ : CLOSE 1
532 K2$=LEFT$(K2$,LEN(K2$)-2%)
534 IF K2$<>K1$ THEN ; CHR$(7%)CUR(22%,0%)'Felaktigt L|senord '; : GET Q$ : E%=-1%
536 RETURN 
538 E%=-1% : RETURN 
540 REM 
542 REM Koda < Klartexten >
544 REM 
546 REM Indata C$
548 REM Utdata K1$
550 REM 
552 L%=LEN(C$) : L%=((L%/8%)+1%)*8%-L% : IF L%=8% THEN L%=0%
554 C$=C$+SPACE$(L%)
556 Z%=CALL(C%,2%) : REM Koda C$
558 L%=LEN(C$)
560 K1$=''
562 FOR I%=1% TO L%
564 Z%=ASC(RIGHT$(C$,I%))
566 K1$=K1$+MID$(H$,((Z%/16%) AND 15%)+1%,1%)+MID$(H$,(Z% AND 15%)+1%,1%)
568 NEXT I%
570 RETURN 
572 REM 
574 REM Avkoda < Kodtexten >
576 REM 
578 REM Indata K1$
580 REM Utdata C$
582 REM 
584 C$=''
586 L%=LEN(K1$)
588 FOR I%=1% TO L% STEP 2%
590 Z%=INSTR(1%,H$,MID$(K1$,I%+1%,1%))-1%+16%*(INSTR(1%,H$,MID$(K1$,I%,1%))-1%)
592 C$=C$+CHR$(Z%)
594 NEXT I%
596 Z%=CALL(C%,3%) : REM Avkoda C$
598 RETURN 
600 REM 
602 REM Ta bort en kod
604 REM 
606 REM Indata R%
608 REM Utdata des.qrp
610 REM 
612 S%=0%
614 ONERRORGOTO 646
616 OPEN 'des.qrp' ASFILE 1
618 PREPARE 'des.tmp' ASFILE 2
620 INPUTLINE #1,K2$ : REM L|senord
622 ONERRORGOTO 636
624 ; #2,K2$;
626 ONERRORGOTO 636
628 INPUTLINE #1,L$ : K1$=LEFT$(L$,LEN(L$)-2%) : REM kodad text
630 INPUTLINE #1,L$ : K2$=LEFT$(L$,LEN(L$)-2%) : S%=S%+1%
632 IF S%=R% THEN 626
634 ; #2,K1$ : ; #2,K2$ : GOTO 626
636 IF ERRCODE<>34% THEN 646
638 CLOSE 2 : CLOSE 1 : ONERRORGOTO 646
640 KILL 'des.qrp'
642 NAME 'des.tmp' AS 'des.qrp'
644 RETURN 
646 CLOSE 2 : CLOSE 1 : E%=-1% : RETURN