' SerTrans: Sendeteil ' Version 3 ohne Kompression und ohne Quoting-Umwandlung ' 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 SUB Pause(t!) DECLARE FUNCTION crc$(fr$) DIM SHARED CRCkonst&, crcTab%(255) ErzeugeCRCTab INPUT "Datei, die gesendet werden soll"; d$ INPUT "Geschwindigkeit (bps)"; g$ INPUT "Lesegrösse"; bs% INPUT "Puffergrösse"; bs1% OPEN d$ FOR INPUT AS 1 LEN=bs1% Seq% = 0 lBuff$="" ON ERROR GOTO Fehler Oeffnen: 10 OPEN "COM1:"+g$+",N,8,1,X,H" AS 2 LEN=bs1% WHILE NOT EOF(1) 20 lBuff$=lBuff$+INPUT$(bs%,1) WHILE LEN(lBuff$) >= 255 dat$=LEFT$(lBuff$,255) GOSUB Uebermitteln lBuff$=MID$(lBuff$,256) WEND WEND Fertig: ON ERROR GOTO 0 ' Restlicher Pffer senden dat$=lBuff$ GOSUB Uebermitteln CLOSE 2 CLOSE 1 END Fehler: ON ERROR GOTO Fehler e%=ERL SELECT CASE e% CASE 10 PRINT "Ö";MID$(STR$(ERR),2); Pause 1! RESUME Oeffnen CASE 20 IF ERR=62 THEN PRINT "Dateiende nicht exakt erreicht - möglicherweise fehlt Schluss" ELSE PRINT "Unbekannter Fehler beim PIPE-Lesen:";ERR END IF RESUME Fertig CASE 30 PRINT "T";MID$(STR$(ERR),2); Pause 1! RESUME NeuSenden CASE 40 PRINT "R";MID$(STR$(ERR),2); Pause 1! RESUME WeiterLesen CASE 50 PRINT "D";MID$(STR$(ERR),2); Pause 1! RESUME WeiterDummy END SELECT PRINT PRINT "Ein echter Fehler";ERR;"in Zeile";ERL;"trat auf." STOP Uebermitteln: f1$=CHR$(Seq%)+CHR$(LEN(dat$))+dat$+SPACE$(255-LEN(dat$)) Tel$=CHR$(2)+f1$+crc$(f1$+MKI$(0))+CHR$(3) Seq%=Seq%+1 AND 255 DO ' Verschicken NeuSenden: 30 PRINT#2, Tel$; ' Quittung abwarten RcvBuf$ = "" Ok%=0 Drinb%=-1 tout! = TIMER + 2! WHILE Drinb% a%=LOC(2) IF a%=0 THEN IF TIMER > tout! THEN Drinb% = 0 ' Retransmit wegen Timeout PRINT "T"; END IF ELSE 40 RcvBuf$=RcvBuf$+INPUT$(a%,2) WeiterLesen: IF LEN(RcvBuf$) >= 5 THEN Drinb% = 0 IF LEN(RcvBuf$) = 5 THEN IF LEFT$(RcvBuf$, 1)=CHR$(2) AND RIGHT$(RcvBuf$, 1)=CHR$(3) THEN IF CVI(crc$(MID$(RcvBuf$, 2, 3))) = 0 THEN IF ASC(MID$(RcvBuf$, 2, 1)) = Seq% THEN Ok% = -1 ELSE PRINT "?"; END IF ELSE PRINT "!"; END IF ELSE PRINT "F"; END IF ELSE PRINT "M"; END IF END IF tout! = TIMER + 2! END IF WEND IF NOT Ok% THEN ' Pause machen, um Müll-Rückkoppelung zu vermeiden tout! = TIMER + .9! WHILE TIMER < tout! a% = LOC(2) IF a% > 0 50 Dummy$ = INPUT$(a%, 2) ' synchronisieren WeiterDummy: END IF IF ABS(TIMER-tout!)>1! THEN tout! = 1! END IF IF INKEY$<>"" THEN END ' Benutzer-Abbruch ermöglichen END IF WEND END IF 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 SUB Pause(t!) t1!=TIMER+t! WHILE TIMERt!+1! THEN t1!=1! END IF WEND END SUB