POINT Software Programming/PPROG1.ISO/basic/baswiz19/examples/tcsend.bas

BASIC Source File | 1993-01-29 | 5.5 KB | 192 lines

'   +----------------------------------------------------------------------+
'   |                                                                      |
'   |        BASWIZ  Copyright (c) 1990-1993  Thomas G. Hanlin III         |
'   |                                                                      |
'   |                      The BASIC Wizard's Library                      |
'   |                                                                      |
'   +----------------------------------------------------------------------+

   DECLARE FUNCTION FGetError% (BYVAL Handle%)
   DECLARE FUNCTION FGetLocate& (BYVAL Handle%)
   DECLARE FUNCTION FGetSize& (BYVAL Handle%)
   DECLARE FUNCTION FRead$ (BYVAL Handle%, BYVAL Bytes%)
   DECLARE FUNCTION TCInkey$ ()
   DECLARE FUNCTION TCInStat% ()
   DECLARE SUB FLocate (BYVAL Handle%, Posn&)
   DECLARE SUB TCFlushIn ()
   DECLARE SUB TCWrite (St$)

   DECLARE FUNCTION CheckSum0$ (St$)
   DECLARE FUNCTION CRC0$ (St$)
   DECLARE FUNCTION TimeTick% (BYVAL Count%)

   DEFINT A-Z

SUB StartXmodemSend (Handle, Protocol$, Baud$, MaxRec, Record, EstTime$, ErrCode)
   SOH$ = CHR$(1)     ' start of 128b record
   STX$ = CHR$(2)     ' start of 1K record
   ACK$ = CHR$(6)     ' acknowledge block
   NAK$ = CHR$(21)    ' request retransmission
   CNK$ = "C"         ' request CRC transmission
   CAN$ = CHR$(24)    ' cancel transfer
   EOT$ = CHR$(4)     ' end of transfer
   ESC$ = CHR$(27)    ' keyboard cancel transfer

   Record = 1
   ErrCode = 0

   IF LEN(Protocol$) = 6 THEN
      BlockLen = 128
   ELSE
      BlockLen = 1024
   END IF

   MaxRec = CINT(FGetSize&(Handle) / BlockLen + .499)

   Tim& = CSNG(VAL(LEFT$(Baud$, LEN(Baud$) - 1))) * .8
   IF Tim& > 0& THEN
      Tim& = CLNG(MaxRec * BlockLen) \ Tim&
   ELSE
      Tim& = 0&
   END IF
   Tim1& = Tim& \ 60&
   EstTime1$ = RIGHT$("0" + MID$(STR$(Tim& - Tim1& * 60&), 2), 2)
   EstTime$ = ":" + EstTime1$
   Tim& = Tim1&
   Tim1& = Tim& \ 60&
   IF Tim1& > 0& THEN
      EstTime1$ = RIGHT$("0" + MID$(STR$(Tim& - Tim1& * 60&), 2), 2)
      EstTime$ = ":" + EstTime1$ + EstTime$
      Tim& = Tim1&
   END IF
   EstTime$ = MID$(STR$(Tim&), 2) + EstTime$

   IF MaxRec = 0 THEN
      Protocol$ = Protocol$ + " CHK"
   ELSE
      Retries = 10
      DO
         WaitTime = TimeTick(109)
         DO
            Ch$ = INKEY$
         LOOP UNTIL TCInStat OR (WaitTime = TimeTick(0)) OR (Ch$ = ESC$)
         RxCh$ = TCInkey$
         TCFlushIn
         Retries = Retries - 1
      LOOP UNTIL RxCh$ = CNK$ OR RxCh$ = NAK$ OR Retries = 0 OR Ch$ = ESC$
      IF Ch$ = ESC$ THEN
         ErrCode = -11
         TCWrite CAN$ + CAN$
      ELSEIF RxCh$ = NAK$ THEN
         Protocol$ = Protocol$ + " CHK"
      ELSEIF RxCh$ = CNK$ THEN
         Protocol$ = Protocol$ + " CRC"
      ELSE
         ErrCode = -1
      END IF
   END IF
END SUB



SUB XmodemSend (Handle, Protocol$, MaxRec, Record, ErrCount, ErrCode)
   SOH$ = CHR$(1)     ' start of 128b record
   STX$ = CHR$(2)     ' start of 1K record
   ACK$ = CHR$(6)     ' acknowledge block
   NAK$ = CHR$(21)    ' request retransmission
   CNK$ = "C"         ' request CRC transmission
   CAN$ = CHR$(24)    ' cancel transfer
   EOT$ = CHR$(4)     ' end of transfer
   ESC$ = CHR$(27)    ' keyboard cancel transfer

   ErrCode = 0

   IF Record > MaxRec THEN
      TCWrite EOT$
      Tim = TimeTick(18)
      DO
         RxCh$ = TCInkey$
      LOOP UNTIL RxCh$ = ACK$ OR Tim = TimeTick(0)
      IF RxCh$ <> ACK$ THEN TCWrite EOT$
      ErrCode = -10
      EXIT SUB
   END IF

   IF ErrCode = 0 THEN
      IF MID$(Protocol$, 7, 1) = " " THEN
         BlockLen = 128
      ELSE
         BlockLen = 1024
      END IF
      CRC = (RIGHT$(Protocol$, 3) = "CRC")
      IF BlockLen = 128 THEN
         SendRec$ = FRead$(Handle, 128)
      ELSE
         SendRec$ = ""
         FOR tmp = 1 TO 8
            IF FGetError(Handle) = 0 THEN
              SendRec$ = SendRec$ + FRead$(Handle, 128)
            END IF
         NEXT
      END IF
      ErrCode = FGetError(Handle)
   END IF

   IF ErrCode = 0 THEN
      IF LEN(SendRec$) < BlockLen THEN
         SendRec$ = SendRec$ + STRING$(BlockLen - LEN(SendRec$), 26)
      END IF
      IF CRC THEN
         SendRec$ = SendRec$ + CRC0$(SendRec$ + STRING$(2, 0))
      ELSE
         SendRec$ = SendRec$ + CheckSum0$(SendRec$)
      END IF
      tmp = (Record AND 255)
      SendRec$ = CHR$(tmp) + CHR$(tmp XOR 255) + SendRec$
      IF BlockLen = 1024 THEN
         SendRec$ = STX$ + SendRec$
      ELSE
         SendRec$ = SOH$ + SendRec$
      END IF
   END IF

   TCFlushIn
   TCWrite SendRec$
   Count = 10
   DO
      Tim = TimeTick(109)
      DO
         IF INKEY$ = ESC$ THEN
            RxCh$ = CAN$
         ELSE
            RxCh$ = TCInkey$
         END IF
      LOOP UNTIL LEN(RxCh$) OR (Tim = TimeTick(0))
      IF RxCh$ <> ACK$ AND RxCh$ <> NAK$ AND RxCh$ <> CAN$ THEN RxCh$ = ""
      Count = Count - 1
   LOOP UNTIL LEN(RxCh$) OR (Count = 0)
   IF RxCh$ = CAN$ THEN
      ErrCode = -11
   ELSEIF RxCh$ = NAK$ THEN
      ErrCode = -5
   ELSEIF RxCh$ <> ACK$ THEN
      ErrCode = -1
   END IF

   IF ErrCode = -1 OR ErrCode = -5 THEN
      ErrCount = ErrCount + 1
      IF ErrCount <= 10 THEN
         FLocate Handle, FGetLocate&(Handle) - CLNG(BlockLen)
      ELSE
         ErrCode = -12
      END IF
   END IF
   IF ErrCode < -10 OR ErrCode > 0 THEN
      TCFlushIn
      TCWrite CAN$ + CAN$
   ELSEIF ErrCode = 0 THEN
      Record = Record + 1
      ErrCount = 0
   END IF
END SUB