' SerTrans: Empfangsteil

DECLARE SUB ErzeugeCRCTab ()
DECLARE FUNCTION crc$ (fr$)

DIM crcTab%(255), QuotTab$(255)
SHARED CRCkonst&, crcTab%()

ErzeugeCRCTab
FOR i% = 0 TO 255
  SELECT CASE i%
  CASE 3, 17, 19, 26, 27
    QuotTab$(i%) = CHR$(27) + CHR$(i% + 64)
  CASE ELSE
    QuotTab$(i%) = CHR$(i%)
  END SELECT
NEXT i%

INPUT "Datei, wo empfangen werden soll"; d$
INPUT "COM-Schnittstelle:Geschwindigkeit (bps), z.B. 2:38400"; g$
OPEN "COM" + g$ + ",N,8,1,CD0,CS0,DS0" AS 1 LEN=1024
OPEN d$ FOR OUTPUT AS 2
Seq% = 0
Quot% = 0
RcvBuf$ = ""
l% = 1
tout! = 90000!
WHILE l% > 0
  a% = LOC(1)
  IF a% = 0 THEN
    IF TIMER > tout! THEN
      GOSUB Quittung   ' Partner anstossen
      COLOR 14
      PRINT "X";
      COLOR 7
      tout! = tout! + 3!
    END IF
  ELSE
    zz$ = INPUT$(a%, 1)
    FOR ii% = 1 TO a%
      z$ = MID$(zz$, ii%, 1)
      ' (Testcode: Schlechte Leitung simulieren)
      ' IF RND < .002 AND z$ <> CHR$(3) THEN
      '   z$ = CHR$(ASC(z$) XOR 32)
      ' END IF
      SELECT CASE z$
      CASE CHR$(27)
        IF Quot% THEN
          GOSUB Quittung  ' NAK - bereits im Quoting-Modus
          COLOR 1
          PRINT "Q";
          COLOR 7
        ELSE
          Quot% = -1
        END IF
      CASE CHR$(3)
        ' Datenpaket abgeschlossen => verarbeiten
        IF Quot% THEN
          GOSUB Quittung  ' NAK - zuletzt sollte kein Quoting-Zeichen offen sein
          COLOR 1
          PRINT "e";
          COLOR 7
        ELSEIF LEN(RcvBuf$) >= 4 THEN
          ' (Testcode: Schlechte Leitung)
          ' IF RND < .95 THEN
          '   MID$(RcvBuf$, 4) = CHR$(ASC(MID$(RcvBuf$, 4, 1)) XOR 64)
          ' END IF
          ' Pr�fe CRC
          IF CVI(crc$(RcvBuf$)) = 0 THEN
            l% = ASC(MID$(RcvBuf$, LEN(RcvBuf$) - 2, 1))
            IF ASC(LEFT$(RcvBuf$, 1)) = Seq% AND l% = LEN(RcvBuf$) - 4 THEN
              p1% = 2
              p2% = l% + 2
              WHILE p1% < p2%
                SteuBy% = ASC(MID$(RcvBuf$, p1%, 1))
                IF SteuBy% < 128 THEN
                  ' PRINT "Block>"; MID$(RcvBuf$, p1% + 1, SteuBy% + 1); "<"
                  PRINT #2, MID$(RcvBuf$, p1% + 1, SteuBy% + 1);
                  p1% = p1% + 2 + SteuBy%
                ELSE
                  ' PRINT 257 - SteuBy%; "x"; MID$(RcvBuf$, p1% + 1, 1);
                  PRINT #2, STRING$(257 - SteuBy%, MID$(RcvBuf$, p1% + 1, 1));
                  p1% = p1% + 2
                END IF
              WEND
              IF p1% <> p2% THEN
                ' Sollte nie vorkommen!!
                PRINT "FATALER Fehler: falsche Zusammenstellung"
                STOP
              ELSE
                Seq% = Seq% + 1 AND 255
                GOSUB Quittung ' ACK - n�chstes Paket anfordern
                PRINT "*";
              END IF
            ELSE
              GOSUB Quittung ' NAK - falscher Paketaufbau
              COLOR 12
              PRINT "?";
              COLOR 7
            END IF
          ELSE
            GOSUB Quittung ' NAK - CRC-Fehler
            COLOR 12
            PRINT "!";
            COLOR 7
          END IF
        ELSE
          GOSUB Quittung ' NAK - Paket zu kurz
          COLOR 9
          PRINT "L"
          COLOR 7
        END IF
      CASE ELSE
        IF Quot% THEN
          IF z$ >= "@" AND z$ < "`" THEN
            RcvBuf$ = RcvBuf$ + CHR$(ASC(z$) - 64)
          ELSE
            GOSUB Quittung  ' NAK
            COLOR 9
            PRINT "q";
            COLOR 7
          END IF
          Quot% = 0
        ELSE
          RcvBuf$ = RcvBuf$ + z$
        END IF
      END SELECT
    NEXT ii%
    tout! = TIMER + 3!
  END IF
WEND
CLOSE 2
CLOSE 1
END

Quittung:
q$ = CHR$(Seq%) + crc$(CHR$(Seq%) + MKI$(0))
Tel$ = ""
FOR i% = 1 TO 3
  Tel$ = Tel$ + QuotTab$(ASC(MID$(q$, i%, 1)))
NEXT i%
Tel$ = Tel$ + CHR$(3)
PRINT #1, Tel$;
RcvBuf$ = ""
RETURN

FUNCTION crc$ (fr$)
  f1$ = fr$
  FOR i% = 2 TO LEN(fr$) - 1
    MID$(f1$, i%) = MKI$(CVI(MID$(f1$, i%, 2)) XOR crcTab%(ASC(MID$(f1$, i% - 1, 1))))
  NEXT i%
  crc$ = RIGHT$(f1$, 2)
END FUNCTION

SUB ErzeugeCRCTab
  CRCPoly% = &H1021     ' entspricht X.25-Standard
  CRCkonst& = CLNG(CRCPoly%) + 65536
  w& = 0&
  FOR i% = 0 TO 255
    c% = i%
    FOR j% = 1 TO 8
      w& = 2& * w& + (c% AND 1)
      c% = c% \ 2
    NEXT j%
    w& = 256& * w&
    FOR j% = 1 TO 8
      w& = 2& * w&
      IF (w& AND 65536) <> 0 THEN
        w& = w& XOR CRCkonst&
      END IF
    NEXT j%
    w1& = 0&
    FOR j% = 1 TO 16
      w1& = 2& * w1& + (w& AND 1&)
      w& = w& \ 2&
    NEXT j%
    crcTab%(i%) = CVI(LEFT$(MKL$(w1&), 2))
  NEXT i%
END SUB