util/src25th.bas

   1 DECLARE SUB chl (a$, b$)\r
   2 DECLARE SUB getline (a$)\r
   3 DECLARE SUB start ()\r
   4 DIM SHARED byte AS STRING * 1\r
   5 DIM SHARED er\r
   6 \r
   7 \r
   8 start\r
   9 \r
  10 OPEN COMMAND$ + ".src" FOR INPUT AS #1\r
  11 IF er = 0 THEN KILL COMMAND$ + ".5th"\r
  12 OPEN COMMAND$ + ".5th" FOR BINARY AS #2\r
  13 \r
  14 1\r
  15 IF EOF(1) <> 0 THEN GOTO 2\r
  16 LINE INPUT #1, a$\r
  17 \r
  18 c$ = ""\r
  19 e$ = ""\r
  20 FOR b = 1 TO LEN(a$)\r
  21 d$ = RIGHT$(LEFT$(a$, b), 1)\r
  22 IF d$ = " " THEN chl e$, c$: c$ = c$ + CHR$(255): GOTO 3\r
  23 IF d$ = CHR$(9) THEN chl e$, c$: c$ = c$ + CHR$(253): GOTO 3\r
  24 e$ = e$ + d$\r
  25 3\r
  26 NEXT b\r
  27 chl e$, c$\r
  28 c$ = c$ + CHR$(254)\r
  29 FOR b = 1 TO LEN(c$)\r
  30   byte = RIGHT$(LEFT$(c$, b), 1)\r
  31   PUT #2, , byte\r
  32 NEXT b\r
  33 GOTO 1\r
  34 2\r
  35 \r
  36 CLOSE #2\r
  37 CLOSE #1\r
  38 \r
  39 SYSTEM\r
  40 \r
  41 \r
  42 SUB chl (a$, b$)\r
  43 \r
  44 e$ = ""\r
  45 FOR c = 1 TO LEN(a$)\r
  46 d = ASC(RIGHT$(LEFT$(a$, c), 1))\r
  47 IF (d >= 48) AND (d <= 57) THEN d = d - 48: GOTO 4\r
  48 IF (d >= 65) AND (d <= 70) THEN d = d - 55: GOTO 4\r
  49 IF (d = 45) AND (c = 1) THEN GOTO 4\r
  50 GOTO 5\r
  51 4\r
  52 e$ = e$ + CHR$(d)\r
  53 NEXT c\r
  54 a$ = e$\r
  55 5\r
  56 \r
  57 b$ = b$ + a$\r
  58 a$ = ""\r
  59 END SUB\r
  60 \r
  61 SUB start\r
  62 IF COMMAND$ = "" THEN END\r
  63 er = 0\r
  64 END SUB\r
  65 \r