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 '; : 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 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, 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