'===========================================================================
' Subject: DOCUMENT CODER/DECODER             Date: 11-25-96 (13:37)       
'  Author: Martijn van de Streek              Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: TEXT.ABC
'===========================================================================
'I've finished translating and editing the coding program. There was a little 
'bug in the program after I had altered the coding mechanism, so it took a bit 
'longer than it had to. 
'Here's the code: 
 
'=============== Begin of program 
DECLARE SUB LOOKFILE (ARG$) 
DECLARE FUNCTION DECode$ (Variabele$) 
DECLARE FUNCTION Code$ (Variabele$) 
ON ERROR GOTO Errhand 
 
' === Program Header === 
PRINT 
COLOR 15, 0: PRINT DECode$("epD"); : COLOR 7, 0: PRINT DECode$("xqgnu") 
COLOR 15, 0: PRINT DECode$("hrE! "); : COLOR 7, 0: 
PRINT DECode$("=:=*wwpywiy" + CHR$(34) + "se"); 
PRINT 
 
'== Reading parameters... == 
CoMMa$ = LTRIM$(RTRIM$(COMMAND$)) + " " 
FOR Temp = 1 TO LEN(CoMMa$) 
  IF MID$(CoMMa$, Temp, 1) = " " THEN Cmds% = Cmds% + 1 
NEXT Temp 
'More or less than 3 parameters? 
IF Cmds% < 3 THEN GOTO UserHelp 
IF Cmds% > 3 THEN GOTO UserHelp 
IF MID$(CoMMa$, 1, 1) = "C" THEN Add% = 1 'If first parameter is C, then 
                                          'Code the file. 
 
IF MID$(CoMMa$, 1, 1) = "D" THEN Re% = 1  'If first parameter is D, then 
                                          'Decode the file. 
IF Add% + Re% = 0 THEN GOTO UserHelp      'If first parameter <> C OR D then 
                                          'display some help 
'find begin of first filename 
FOR Temp = 3 TO LEN(CoMMa$) 
  IF MID$(CoMMa$, Temp, 1) = " " THEN EXIT FOR 
NEXT Temp 
FOR B1% = Temp + 1 TO LEN(CoMMa$) 
  IF MID$(CoMMa$, B1%, 1) = " " THEN EXIT FOR 
NEXT B1% 
File1$ = MID$(CoMMa$, 3, Temp - 3) 
File2$ = MID$(CoMMa$, Temp + 1, B1% - Temp - 1) 
IF Add% = 1 THEN GOTO Add 
IF Re% = 1 THEN GOTO ReWrite 
GOTO UserHelp 
 
Add: 
'=== Code-a-file === 
IF NOT File1$ <> File2$ THEN PRINT "Can't read from "; File1$; " and write to"; PRINT "Secure with pasword? (Y/N)" 
passWord$ = "" 
PasYN$ = INPUT$(1) 
IF UCASE$(PasYN$) = "Y" THEN 
  PRINT "Typ het paswoord in:"; : COLOR 0, 0 
  INPUT "", passWord$: COLOR 7, 0 
  IF passWord$ = "" THEN PRINT "ERROR: Invalid pasword": END 
  PRINT "Retype password:"; : COLOR 0, 0 
  INPUT "", PasswordControl$: COLOR 7, 0 
  IF PasswordControl$ <> passWord$ THEN 
     PRINT "ERROR: Pasword check failed": END 
  END IF 
END IF 
PassWrd$ = passWord$ + SPACE$(80 - LEN(passWord$)) 
OPEN File1$ FOR INPUT AS #1        'This file comes the information from 
OPEN File2$ FOR OUTPUT AS #2       'and this file is where the information 
                                   'goes to... 
  PRINT #2, Code$("Coded file by DOCOD.")' give file initialisation code for 
                                         ' decoding... 
  PRINT #2, Code$(PassWrd$) 
regnr% = 0 
PRINT 
Rownr% = CSRLIN - 1 
DO WHILE NOT EOF(1) 
  LINE INPUT #1, Rec$              'Read, 
  PRINT #2, Code$(Rec$)            'Code and write 
  regnr% = regnr% + 1 
  LOCATE Rownr%, 1: 
  PRINT "Coding line:"; regnr% 
LOOP 
CLOSE #1 
CLOSE #2 
PRINT "Done." 
END 
 
ReWrite: 
'=== DECode-a-file === 
IF NOT File1$ <> File2$ THEN PRINT "Can't read file "; File1$; " and write to file."
OPEN File1$ FOR INPUT AS #1        'This is where the info comes from . . .
LINE INPUT #1, Rec$                'Read and check for right file format... 
IF Rec$ <> Code$("Coded file by DOCOD.") THEN PRINT "ERROR: Not a DOCOD File.":  
LINE INPUT #1, Rec$                'Read a line . . . 
IF Rec$ <> "" THEN 
  PRINT "Password:"; : COLOR 0, 0 
  INPUT "", passWord$: COLOR 7, 0 
  IF passWord$ <> LTRIM$(RTRIM$(DECode$(Rec$))) THEN PRINT "ERROR: Wrong password
END IF
OPEN File2$ FOR OUTPUT AS #2       'And this is where it goes 
regnr% = 0 
Rownr% = CSRLIN 
PRINT 
Rownr% = Rownr% - 1 
DO WHILE NOT EOF(1) 
  LINE INPUT #1, Rec$              'Reading... 
  PRINT #2, DECode$(Rec$)          'DECoding, and rewriting... 
  regnr% = regnr% + 1 
  LOCATE Rownr%, 1: 
  PRINT "Uncoding line:"; regnr%    'show the line number... 
LOOP 
CLOSE #1 
CLOSE #2 
PRINT "Done." 
END 
 
UserHelp: 
PRINT "Usage:   CODOC.EXE c source.ext target.ext       -> Codes text files." 
PRINT "         CODOC.EXE d source.ext target.ext       -> Decodes text files."
PRINT : PRINT "Only use CoDoc on TEXT-files, not binary ones !! (it corrupts the file)"
END
 
Errhand: 
IF ERR = 53 THEN PRINT "ERROR: File not found": END 
IF ERR = 64 THEN PRINT "ERROR: Invalid filename": END 
CLS 
PRINT "Error:"; ERR 
END 
 
 
FUNCTION Code$ (Variabele$) 
FOR Temp = 1 TO LEN(Variabele$)

  NewCh$ = CHR$((ASC(MID$(Variabele$, Temp, 1)) + Temp) - 1) 
  Newvar$ = Newvar$ + NewCh$ 
NEXT Temp 
FOR Temp = LEN(Newvar$) TO 1 STEP -1 
  NewCh$ = MID$(Newvar$, Temp, 1) 
  NewVar2$ = NewVar2$ + NewCh$ 
NEXT Temp 
 
Code$ = NewVar2$ 
END FUNCTION 
 
FUNCTION DECode$ (Variabele$) 
FOR Temp = LEN(Variabele$) TO 1 STEP -1 
  NewCh$ = MID$(Variabele$, Temp, 1) 
  NewVar2$ = NewVar2$ + NewCh$ 
NEXT Temp 
FOR Temp = 1 TO LEN(NewVar2$) 
  NewCh$ = CHR$(1 + (ASC(MID$(NewVar2$, Temp, 1)) - Temp)) 
  Newvar$ = Newvar$ + NewCh$ 
NEXT Temp 
DECode$ = Newvar$ 
END FUNCTION 
'================ End of program