home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
basic
/
baswiz18.zip
/
BW$BAS.ZIP
/
TCSEND.BAS
< prev
next >
Wrap
BASIC Source File
|
1992-08-29
|
6KB
|
192 lines
' +----------------------------------------------------------------------+
' | |
' | BASWIZ Copyright (c) 1990-1992 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