'DISCODE.BAS - written Setting Orange, the 40th of Chaos, YOLD 3162 ' 'Converts easily-decipherable DOS text files into indecipherable text files 'using the DISCORDIAN SOCIETY SUPER SECRET CRYPTOGRAPHIC CYPHER CODE ' 'Rev. Father Pope SiGRiD Fenderson V, KSC : gregb@bconnex.net ' DECLARE SUB ProcessComLine () DECLARE SUB Encrypt () DIM SHARED cline(10) AS STRING PRINT "Discordian Text Encoder (k) 40th Chaos 3162" PRINT "Written by Rev. Father POPE SiGRiD Fenderson V, KSC etc." PRINT ProcessComLine IF cline$(1) = "" OR cline$(2) = "" THEN PRINT "Usage: DISCODE infile outfile" PRINT PRINT "infile - Input file" PRINT "outfile - Output file" PRINT PRINT "This program is provided AS IS by SiGRiDWARE SYSTEMS. SiGRiDWARE is not" PRINT "liable for any damage to software or hardware resulting from use of this" PRINT "program. For instance, if DISCODE suddenly reformats your hard drive, we" PRINT "aren't responsible..." ELSE Encrypt END IF END SUB Encrypt () 'Create array for sortin' numbers DIM sa(1 TO 255) AS SINGLE 'Error-Trapping for stupid users... ON LOCAL ERROR GOTO ScrewedUpFileName 'RANDOMIZE things with the TIMER, even... RANDOMIZE TIMER 'Open files OPEN cline$(1) FOR INPUT AS #1 LEN = 32000 OPEN cline$(2) FOR OUTPUT AS #2 LEN = 32000 DO WHILE NOT EOF(1) LINE INPUT #1, a$ t = t + 1 LOOP SEEK #1, 1 'Show cheesy progress indicator... PRINT "Working... "; DO WHILE NOT EOF(1) q = q + 1 LOCATE CSRLIN, 12: PRINT USING "####"; q / t * 100; : PRINT "%"; 'Read line from input file & convert to upper case... LINE INPUT #1, l$ l$ = UCASE$(l$) 'Remove spaces & put vowels at the end of each line... x = 1 DO x = INSTR(x, l$, " ") IF x = 0 THEN EXIT DO ELSE l$ = LTRIM$(RTRIM$(LEFT$(l$, x - 1) + RIGHT$(l$, LEN(l$) - x))) LOOP x = 1 l$ = l$ + "ÿ" DO SELECT CASE MID$(l$, x, 1) CASE "A", "E", "I", "O", "U" l$ = LEFT$(l$, x - 1) + RIGHT$(l$, LEN(l$) - x) + MID$(l$, x, 1) CASE "ÿ" l$ = LEFT$(l$, x - 1) + RIGHT$(l$, LEN(l$) - x) EXIT DO CASE ELSE x = x + 1 END SELECT LOOP 'Sort array numerically using a really cheesy bubblesort, on accounta 'I'm too lazy to code a quick sort. Hey, mebbe I could go work for 'Microsoft... FOR x = 1 TO LEN(l$) FOR y = 1 TO LEN(l$) - 1 a$ = MID$(l$, y, 1): b$ = MID$(l$, y + 1, 1) IF a$ > b$ THEN SWAP a$, b$ MID$(l$, y, 1) = a$: MID$(l$, y + 1, 1) = b$ NEXT y NEXT x 'Write string to output file... PRINT #2, l$ 'Check for quit... IF INKEY$ <> "" THEN EXIT DO LOOP CLOSE EXIT SUB 'Routine to handle stupid users... ScrewedUpFileName: PRINT PRINT ERROR$ + ". Nice try, Gumbyfish!" END RETURN END SUB SUB ProcessComLine () start = 1 c$ = COMMAND$ + " " IF LEN(c$) = 0 THEN EXIT SUB FOR x = 1 TO 10 sp = INSTR(MID$(c$, start, LEN(c$) - start + 1), " ") IF sp <> 0 THEN cline$(x) = MID$(c$, start, sp - 1) start = start + sp ELSE EXIT FOR END IF NEXT x END SUB