home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / PRO98SRC.ZIP / XMODEMIN.BAS < prev    next >
BASIC Source File  |  1994-01-08  |  3KB  |  128 lines
  1. SUB XmodemIn (filename$, success%)
  2. $IF NOT %NOXMODEM
  3.   DIM bdta AS STRING * 128
  4.   false% = 0
  5.   true% = 1
  6.   CRCSend% = 99
  7.   success% = false%
  8.   FirstOk% = false%
  9.   BlockHi% = 0
  10.   PrevBlock% = 0
  11.   NAK$ = CHR$(5)
  12.   ACK$ = CHR$(6)
  13.   SOH$ = CHR$(1)
  14.   EOT$ = CHR$(4)
  15.   CAN$ = CHR$(24)
  16.   CPM$ = CHR$(26)
  17.   Filenum = FREEFILE
  18.   PROZOPRINT "Xmodem receive.  Begin Transfer now..." + CrLf$
  19.   If ComLine=0 THEN PROZOPRINT "Not connected"+CrLf$: Exit Sub
  20.   OPEN filename$ FOR RANDOM AS #Filenum LEN = 128
  21.  
  22.  
  23.   FOR y = 1 TO 5
  24.     Tm! = TIMER
  25.     LOCALPRINT "<C>": COMPRINT "C"
  26.     WHILE ComChars%=0 AND TIMER - Tm! <= 3: WEND
  27.     IF ComChars% THEN EXIT FOR
  28.   NEXT y
  29.   IF y = 5 THEN LOCALPRINT "Too Many Tries!": GOTO XmodemReceiveAbort
  30.   LOCALPRINT "<OK>"
  31.   DO
  32.     Retries% = 0
  33.     DO
  34.       Retries% = Retries% + 1
  35.       r$ = ""
  36.       x% = 10
  37.       LOCALPRINT "?"
  38.       DO
  39.     CALL GetXChar(Ch$, toolong%, x%)
  40.     'IF Instat THEN
  41.       'k$ = INKEY$
  42.       'IF k$ = CHR$(27) THEN r$ = CAN$
  43.     'END IF
  44.     IF NOT toolong% THEN r$ = r$ + Ch$
  45.     x% = 2
  46.       LOOP UNTIL toolong% OR LEN(r$) = 133
  47.       IF FirstOk% = false% THEN
  48.     IF LEN(r$) = 132 THEN CRCSend% = false%
  49.     IF LEN(r$) = 133 THEN CRCSend% = 1 ELSE LOCALPRINT "!133"
  50.       END IF
  51.       Ok% = 0
  52.       Start$ = LEFT$(r$, 1)
  53.       IF LEN(r$) < 133 THEN LOCALPRINT "<LEN?>": GOTO NotOK
  54.       Block% = ASC(MID$(r$, 2, 1))
  55.       BlkCk% = 255 - ASC(MID$(r$, 3, 1))
  56.       dta$ = MID$(r$, 4, 128)
  57.       Chk$ = MID$(r$, 132, 3)
  58.       IF Start$ <> SOH$ THEN LOCALPRINT "<BAD SOH>": GOTO NotOK
  59.       IF LEN(dta$) <> 128 THEN LOCALPRINT "<LEN?>": GOTO NotOK
  60.       IF Block% <> BlkCk% THEN LOCALPRINT "<BAD BLK#>": GOTO NotOK
  61. D$ = dta$ '+ CHR$(0) + CHR$(0)
  62. CRC.Hi% = 0: CRC.Low% = 0: ChkSum% = 0
  63. CALL CRC16(D$, CRC.Hi%, CRC.Low%)
  64. ChkSum% = CheckSum%(D$)
  65.  
  66.  
  67. IF CRCSend% THEN
  68.     IF Chk$ <> CHR$(CRC.Hi%) + CHR$(CRC.Low%) THEN LOCALPRINT "<BAD CRC>": GOTO NotOK
  69.       ELSE
  70.     IF Chk$ <> CHR$(ChkSum%) THEN LOCALPRINT "<BAD CKS>": GOTO NotOK
  71.       END IF
  72.       Ok% = 1: LOCALPRINT "="
  73. NotOK:
  74.       IF Ok% = 0 THEN COMPRINT NAK$ : LOCALPRINT "<"
  75.     LOOP UNTIL Ok% OR Retries% > 10 OR Start$ = CAN$ OR Start$ = EOT$
  76.  
  77.     IF Start$ = SOH$ AND Ok% THEN
  78.       LOCALPRINT ">"
  79. $IF NOT %NOTASKS
  80. CALL TASKMAN
  81. $ENDIF
  82. REM FORK WENT HERE
  83.       IF Block% = 0 AND PrevBlock% = 255 THEN BlockHi% = BlockHi% + 1
  84.       bdta = dta$
  85.       PUT #Filenum, Block% + (BlockHi% * 256), bdta$
  86.       PrevBlock% = Block%
  87.       FirstOk% = true%
  88.  
  89.       COMPRINT ACK$
  90.     END IF
  91.  
  92.   LOOP UNTIL Start$ = CAN$ OR Start$ = EOT$ OR Retries% > 10
  93.  
  94.   IF Start$ <> EOT$ THEN GOTO XmodemReceiveAbort
  95.  
  96.   Retries% = 0
  97.   DO
  98.     Retries% = Retries% + 1
  99.     COMPRINT ACK$
  100.     CALL GetXChar(Ch$, toolong%, x%)
  101.     'IF Instat THEN
  102.     '  k$ = INKEY$
  103.     '  IF k$ = CHR$(27) THEN Ch$ = CAN$
  104.     'END IF
  105.   LOOP UNTIL Ch$ <> EOT$ OR Retries% > 10
  106.  
  107.   IF Retries% < 11 AND Ch$ <> CAN$ THEN
  108.     success% = true%
  109.     GOTO XmodemReceiveExit
  110.   END IF
  111.  
  112. XmodemReceiveAbort:
  113.   COMPRINT STRING$(5, CAN$) + STRING$(5, 8)
  114.  
  115. XmodemReceiveExit:
  116.   CLOSE #Filenum
  117.   IF success% = false% THEN KILL filename$
  118. END SUB 'XmodemReceive
  119.  
  120. SUB LOCALPRINT(Oput$)
  121. For i%=1 to len(Oput$)
  122.     Reg 1,&h200
  123.     Reg 4,asc(Mid$(OPut$,i%,1))
  124.     CALL INTERRUPT &H21
  125. Next i%
  126. $ENDIF
  127. END SUB
  128.