home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / txt / scram.ba < prev    next >
Text File  |  2006-10-19  |  2KB  |  36 lines
  1. 0 'Club 100 Library - 415/939-1246 BBS     937-5039 NEWSLETTER, 932-8856 VOICE
  2. 1 'SCRAM.100 (v1.1) - Bob Willard, 05-Jun-84    This fully-prompted program scrambles and unscrambles text (.DO) files
  3. 2 'in the Model 100.  An encoded file will be stored under the
  4. 3 'first 3 characters of its filename plus ENC.DO (for encrypted).
  5. 4 'The original file is killed when the encoding/decoding is completed.
  6. 5 'The value of N in line 10 may be varied from 1-4 for different
  7. 6 'encryption codes.  DO NOT EXCEED 4 FOR THE VALUE OF N.
  8. 7 'Most common errors will be trapped, and ENC.DO is needed for decoding.
  9. 8 'The program occupies 954 bytes without REM statements and
  10. 9 'needs 2x the file size to be encoded/decoded to run.
  11. 10 MAXFILES=2:DEFSTRA-M:DEFINTN-Z:N=4:A=CHR$(27):B=A+"p":C=A+"q":ONERRORGOTO50
  12. 11 D=".DO":E="ENC.DO":CLS:PRINT@52,B;" THE SCRAMBLER ";C:PRINT
  13. 12 PRINTTAB(10)B;"E";C;"ncode";TAB(25)B;"D";C;"ecode"
  14. 13 PRINT@240,"Enter your choice in caps <E/D>"
  15. 14 K=INKEY$:IFK<>"E"ANDK<>"D"THEN14
  16. 15 IFK="E"THEN20ELSE30
  17. 20 PRINT@277,D;:PRINT@240,"Enter filename for encoding: ";:INPUTF
  18. 21 CLS:F=F+D:IFRIGHT$(F,6)=ETHEN60
  19. 22 OPENFFORINPUTAS1:G=LEFT$(F,3)+E:OPENGFOROUTPUTAS2:GOSUB110
  20. 23 K=INPUT$(1,1):X=ASC(K)+N:IFX>255THENX=X-255
  21. 24 L=CHR$(X):PRINT#2,L;:IFEOF(1)THEN120ELSE23
  22. 30 PRINT@277,D;:PRINT@240,"Enter filename for decoding: ";:INPUTF
  23. 31 PRINT@271,"      ":PRINT@240,"Enter new (decoded) filename:";:INPUTG
  24. 32 CLS:F=F+D:IFRIGHT$(F,6)<>ETHEN70
  25. 33 OPENFFORINPUTAS1:G=G+D:OPENGFOROUTPUTAS2:GOSUB110
  26. 34 K=INPUT$(1,1):X=ASC(K)-N:IFX<0THENX=X+255
  27. 35 L=CHR$(X):PRINT#2,L;:IFEOF(1)THEN120ELSE34
  28. 50 IFERR=52THENPRINTB;" File Not Found ";C:FILES:RESUME100
  29. 55 CLS:PRINTB;" Error";ERR;"in line";ERL;C:CLOSE:STOP
  30. 60 GOSUB80:PRINTTAB(6)"This file is already encoded":GOTO100
  31. 70 GOSUB80:PRINTTAB(8)"This file is not encoded":GOTO100
  32. 80 PRINT@135,B;" WARNING ";C:RETURN
  33. 100 FORT=1TO5000:NEXT:GOTO11
  34. 110 PRINT@127,B;" CREATING ";G;" FILE ";C:RETURN
  35. 120 CLOSE:KILLF:MAXFILES=1:MENU
  36.