Upgraded

DECLARE FUNCTION D2S$ (D AS DOUBLE)
DECLARE FUNCTION S2D# (S AS STRING)
DECLARE SUB SecureEncryptAndWrite (Game$, zkey#, pB#, pW#, Who%)
DECLARE SUB SecureReadAndDecrypt (Game$, zkey#, pB#, pW#, Who%)
DECLARE FUNCTION Q% (n%)
DECLARE FUNCTION ksgDecrypt$ (k#, Encrypted$)
DECLARE FUNCTION ksgEncrypt$ (k#, Clear$)
CLS
PRINT "DM4BAC-InputOutput"
PRINT "---------------"
PRINT "This consists of 1) a driver which can be used to debug"
PRINT "the IO routines and 2) Simulated IO routines

'------------------------------ Ensure same randomize on second pass
RANDOMIZE TIMER
OPEN "DM4BAC.DAT" FOR OUTPUT AS #1
WRITE #1, RND * 9999999
CLOSE
1 :
OPEN "DM4BAC.DAT" FOR INPUT AS #1
INPUT #1, r#
CLOSE
r# = RND(-r#)
'------------------------------
PRINT ""
DEFSTR A-Z ' Debugging
DIM MyErr AS INTEGER: ' Debugging

' ####### Set up some sample data #######
DIM SHARED debugW AS STRING * 15
DIM SHARED debugB AS STRING * 15
DIM i AS INTEGER
IF RND > .5 THEN
  FOR i = 1 TO 15: MID$(debugW, i, 1) = RIGHT$(STR$(INT(RND * 10)), 1): NEXT i
ELSE
  debugW = SPACE$(15): 'Sample no value
END IF
IF RND > .5 THEN
  FOR i = 1 TO 15: MID$(debugB, i, 1) = RIGHT$(STR$(INT(RND * 10)), 1): NEXT i
ELSE
  debugB = SPACE$(15): 'Sample no value
END IF
DIM SHARED debugP AS STRING
FOR i = 1 TO 1 + INT(RND * 8)
  debugP = debugP + CHR$(65 + INT(RND * 25))
NEXT i
DIM SHARED debug123 AS DOUBLE: debug123 = FIX(999999 * RND)
DIM SHARED debug456 AS DOUBLE: debug456 = 999999 * RND
DIM SHARED debug789 AS DOUBLE: debug789 = 999999 * RND
'=============================================
DIM SHARED Board(8, 8) AS INTEGER' column, row
DIM SHARED WBoard(8, 8) AS INTEGER' column, row
DIM SHARED BBoard(8, 8) AS INTEGER' column, row
DIM SHARED pwW AS STRING * 15, pwB AS STRING * 15
'=============================================
DIM j AS INTEGER, c AS INTEGER
MyErr = 0: ON ERROR GOTO GetMyErr
OPEN debugP + ".ksg" FOR INPUT AS #1: CLOSE
ON ERROR GOTO 0
IF MyErr = 0 THEN GOTO Test2

Test1:
LSET pwW = debugW: RSET pwB = debugB
FOR i = 1 TO 8: FOR j = 1 TO 8
  c% = c% + 3: 'just test numbers - garbage
  Board(i, j) = Q(c): WBoard(i, j) = Q(c + 1): BBoard(i, j) = Q(c + 2)
NEXT j: NEXT i
CALL SecureEncryptAndWrite(debugP, debug123, debug456, debug789, 3)
RUN 1

Test2:
CALL SecureReadAndDecrypt(debugP, debug123, pB#, pW#, Who%)
IF pB# <> debug456 THEN STOP: 'bug
IF pW# <> debug789 THEN STOP: 'bug
IF Who% <> 3 THEN STOP: 'bug
FOR i = 1 TO 8: FOR j = 1 TO 8
  c% = c% + 3: 'just test numbers - garbage
  IF Board(i, j) <> Q(c) THEN STOP: 'bug
  IF WBoard(i, j) <> Q(c + 1) THEN STOP: 'bug
  IF BBoard(i, j) <> Q(c + 2) THEN STOP: 'bug
NEXT j: NEXT i
Test$ = pwW: LSET Test$ = debugW: IF Test$ <> pwW THEN STOP: 'bug
Test$ = pwB: RSET Test$ = debugB: IF Test$ <> pwB THEN STOP: 'bug
PRINT "Success at "; TIME$;
PRINT " Press Enter with NOTHING ELSE to run again"
LINE INPUT "Enter some stuff to exit: "; e$
KILL debugP + ".ksg"
IF e$ = "" THEN RUN
SYSTEM

GetMyErr:
MyErr = ERR
RESUME NEXT

FUNCTION D2S$ (D AS DOUBLE)
DIM W AS STRING, S AS STRING, i AS INTEGER
W = MKD$(D)
FOR i = 1 TO 8
  c% = ASC(MID$(W, i, 1))
  S = S + CHR$((c% AND 15) + 65) + CHR$(((c% AND 240) / 16) + 65)
NEXT i
D2S$ = S
END FUNCTION

FUNCTION ksgDecrypt$ (k#, Encrypted$)
DIM ktest AS STRING * 10
LSET ktest = STR$(k#)
IF LEFT$(Encrypted$, 10) <> ktest THEN STOP: 'bug
ksgDecrypt$ = RIGHT$(Encrypted$, LEN(Encrypted$) - 10)
END FUNCTION

FUNCTION ksgEncrypt$ (k#, Clear$)
DIM ktest AS STRING * 10
LSET ktest = STR$(k#)
ksgEncrypt$ = ktest + Clear$
END FUNCTION

FUNCTION Q% (n%)
RANDOMIZE n%
'Ensure there are plenty of zeros to test packing
IF RND < .8 THEN Q% = 0: EXIT FUNCTION
'Otherwise, just put some pieces in range
IF RND < .5 THEN
  Q% = -1 - INT(8 * RND)
ELSE
  Q% = 1 + INT(8 * RND)
END IF
END FUNCTION

FUNCTION S2D# (S AS STRING)
DIM W AS STRING, i AS INTEGER
FOR i = 1 TO 16 STEP 2
  W = W + CHR$(((ASC(MID$(S, i, 1))) - 65) + (((ASC(MID$(S, i + 1, 1))) - 65) * 16))
NEXT i
S2D# = CVD(W)
END FUNCTION

SUB SecureEncryptAndWrite (Game$, zkey#, pB#, pW#, Who%)
IF Who% < 0 THEN STOP
IF Who% > 9 THEN STOP
DIM m AS STRING
m = ""
DIM i AS INTEGER, j AS INTEGER
FOR i = 1 TO 8: FOR j = 1 TO 8
    IF Board(i, j) <> 0 THEN
      m = m + CHR$(33 + ((i - 1) * 8) + (j - 1))
      m = m + CHR$(Board(i, j) + 44)
    END IF
    IF WBoard(i, j) <> 0 THEN
      m = m + CHR$(33 + ((i - 1) * 8) + (j - 1))
      m = m + CHR$(WBoard(i, j) + 63)
    END IF
    IF BBoard(i, j) <> 0 THEN
      m = m + CHR$(33 + ((i - 1) * 8) + (j - 1))
      m = m + CHR$(BBoard(i, j) + 82)
    END IF
NEXT j: NEXT i
m = D2S(pB#) + D2S(pW#) + CHR$(Who% + 70) + m
IF LEFT$(pwW, 1) = " " THEN
  m = m + "."
  FOR i = 1 TO 14: m = m + CHR$(48 + INT(RND * 10)): NEXT i
ELSE
  m = m + pwW
END IF
IF LEFT$(pwB, 1) = " " THEN
  m = m + "."
  FOR i = 1 TO 14: m = m + CHR$(48 + INT(RND * 10)): NEXT i
ELSE
  m = m + pwB
END IF
W$ = ksgEncrypt(zkey#, m)
DIM ff AS INTEGER: ff = FREEFILE
OPEN Game$ + ".ksg" FOR OUTPUT AS #ff
PRINT #ff, W$
CLOSE #ff
END SUB

SUB SecureReadAndDecrypt (Game$, zkey#, pB#, pW#, Who%)
DIM ff AS INTEGER: ff = FREEFILE
OPEN Game$ + ".ksg" FOR INPUT AS #ff
DIM m AS STRING
LINE INPUT #ff, l$
CLOSE #ff
DIM y AS INTEGER
m = ksgDecrypt(zkey#, l$)
pwW = MID$(m, LEN(m) - 29, 15)
IF LEFT$(pwW, 1) = "." THEN LSET pwW = ""
pwB = RIGHT$(m, 15)
IF LEFT$(pwB, 1) = "." THEN LSET pwB = ""
m = LEFT$(m, LEN(m) - 30)
pB# = S2D(LEFT$(m, 16)): m = RIGHT$(m, LEN(m) - 16)
pW# = S2D(LEFT$(m, 16)): m = RIGHT$(m, LEN(m) - 16)
Who% = ASC(LEFT$(m, 1)) - 70: m = RIGHT$(m, LEN(m) - 1)
DIM i AS INTEGER
FOR i = 1 TO LEN(m) - 1 STEP 2
  n% = ASC(MID$(m, i, 1)): ' location i,j
  n% = n% - 33: IF n% > 64 THEN PRINT n%: STOP
  ni% = 1 + (n% \ 8)
  nj% = n% + 1 - (8 * (n% \ 8))
  o% = ASC(MID$(m, i + 1, 1)): ' Content
  SELECT CASE o%
  CASE IS < 35: STOP
  CASE IS < 54: o% = o% - 44: Board(ni%, nj%) = o%
  CASE IS < 73: o% = o% - 63: WBoard(ni%, nj%) = o%
  CASE IS < 92: o% = o% - 82: BBoard(ni%, nj%) = o%
  CASE ELSE: STOP
  END SELECT
NEXT i
END SUB