' SerTrans: Sendeteil

' Optionen für Compiler: Kein Fenster
REM $STATIC
REM $NOWINDOW
REM $NOADDICON

' Um bestmögliche Performance zu erhalten, werden sämtliche RangeChecks
' und Sicherheiten deaktiviert
REM $NOBREAK
REM $NOEVENT
REM $NOOVERFLOW
REM $NOVARCHECKS
REM $NOAUTODIM
REM $NOADDICON
REM $NOARRAY
REM $NOSTACK

DECLARE SUB ErzeugeCRCTab
DECLARE FUNCTION crc$(fr$)

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

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

INPUT "Datei, die gesendet werden soll"; d$
INPUT "Geschwindigkeit (bps)"; g$
INPUT "Lesegrösse"; bs%
OPEN d$ FOR INPUT AS 1
OPEN "COM1:"+g$+",N,8,1,X,H" FOR RANDOM AS 2
Seq% = 0
Quot% = 0
TransBuf$=""
l% = 1
lBuff$=""
WHILE NOT EOF(1) ' AND LEN(lBuff$) > 127
  IF LEN(lBuff$) < 127 THEN
    lBuff$ = lBuff$ + INPUT$(bs%,1)
  END IF
  dat$=CHR$(126)+LEFT$(lBuff$,127)
  lBuff$=MID$(lBuff$,128)
  GOSUB Senden
WEND
' Restlicher Puffer senden
dat$=CHR$(LEN(lBuff$)-1)+lBuff$
GOSUB Senden
' Restliche Daten
IF TransBuf$<>"" THEN
  GOSUB Uebermitteln
END IF
' EOT (End Of Transmission): Paket mit Länge 0
TransBuf$=""
GOSUB Uebermitteln
CLOSE 2
CLOSE 1
END	

Senden:
IF LEN(TransBuf$)+LEN(dat$)>255 THEN
  GOSUB Uebermitteln
  TransBuf$=dat$
ELSE
  TransBuf$=TransBuf$+dat$
END IF
RETURN

Uebermitteln:
f1$=CHR$(Seq%)+TransBuf$+CHR$(LEN(TransBuf$))
f1crc$=f1$+crc$(f1$+MKI$(0))
Seq% = Seq% + 1 AND 255

' Telegramm zusammensetzen
Tel$=""
FOR i%=1 TO LEN(f1crc$)
  Tel$=Tel$+QuotTab$(ASC(MID$(f1crc$,i%,1)))
NEXT i%
Tel$=Tel$+CHR$(3)

DO
  ' Verschicken
  PRINT#2,Tel$;

  ' Quittung abwarten
  RcvBuf$ = ""
  Ok%=0
  Drinb%=-1
  tout! = TIMER + 3!
  WHILE Drinb%
    a%=LOC(2)
    IF a%=0 THEN
      IF TIMER > tout! THEN
        Drinb% = 0    ' Retransmit wegen Timeout
      END IF
    ELSE
			zz$=INPUT$(a%,2)
			FOR ii%=1 TO a%
			  z$=MID$(zz$, ii%, 1)
		    SELECT CASE z$
		 	  CASE CHR$(27)
		   	  IF Quot% THEN
		     	  Drinb% = 0    ' NAK (Retransmit) - bereits im Quoting-Modus
		   	  ELSE
		     	  Quot% = -1
		  	  END IF
			  CASE CHR$(3)
		      ' Quittungs-Datenpaket abgeschlossen => verarbeiten
		      Drinb% = 0
		      ' Quittungslänge = immer 3, Quoting-Mods abgeschlossen
		      IF NOT Quot% AND LEN(RcvBuf$) = 3 THEN
		        ' Prüfe CRC
		        IF CVI(crc$(RcvBuf$)) = 0 THEN
		          Drinb% = 0
		          IF ASC(LEFT$(RcvBuf$, 1)) = Seq% THEN
		            Ok% = -1
		          END IF
		        END IF
		      END IF 
		    CASE ELSE
		      IF Quot% THEN
		        IF z$ >= "@" AND z$ < "`" THEN
		          RcvBuf$ = RcvBuf$ + CHR$(ASC(z$) - 64)
		        ELSE
		          Drinb% = 0  ' NAK (Retransmit) - Falsches Spezialzeichen
		        END IF
		        Quot% = 0
		      ELSE
		        RcvBuf$ = RcvBuf$ + z$
		      END IF
		    END SELECT
		  NEXT ii%
		  tout! = TIMER + 3!
		END IF
  WEND
LOOP UNTIL Ok%
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
  CONST 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 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%
    h$ = MKL$(w1&)
    ' Motorola-Reihenfolge drehen
    crcTab%(i%) = CVI(RIGHT$(h$,1)+MID$(h$,3,1))
  NEXT i%
END SUB