home *** CD-ROM | disk | FTP | other *** search
/ Shareware Supreme Volume 6 #1 / swsii.zip / swsii / 178 / JRXMODEM.ZIP / JRXMODEM.BAS next >
BASIC Source File  |  1985-12-20  |  13KB  |  432 lines
  1. 10 REM *******************************************
  2. 12 REM *   PCJR XMODEM COMMUNICATIONS PROGRAM
  3. 15 REM *   FOR IBM INTERNAL MODEM AT 300 BAUD
  4. 20 REM *
  5. 25 REM *   JRXMODEM.BAS
  6. 30 REM *
  7. 35 REM *   BY DAVID W. CARROLL
  8. 40 REM *   COPYRIGHT 1984
  9. 45 REM *   ALL RIGHTS RESERVED
  10. 50 REM *   VERSION XMODEM X38A
  11. 55 REM *   11/07/84   3:18 pm
  12. 60 REM *   FROM
  13. 65 REM *   "TELECOMMUNICATIONS WITH THE PCJR"
  14. 70 REM *   BY DAVID W. CARROLL
  15. 75 REM *   MICRO TEXT/PRENTICE HALL - 1984
  16. 80 REM *
  17. 85 REM *   USE BASICA /C:8192 TO RUN THIS
  18. 90 REM *   PROGRAM
  19. 95 REM *******************************************
  20. 100 CLS
  21. 110 DEFINT A-Z
  22. 120 SCREEN 0,0
  23. 130 WIDTH 80
  24. 140 CLOSE
  25. 150 ON ERROR GOTO 7000
  26. 160 KEY OFF
  27. 170 GOSUB 1490
  28. 180 DIM A(4096)
  29. 190 DIM B$(4)
  30. 200 DISK =0
  31. 210 TER$="TERMINAL"+SPACE$(7)
  32. 220 MO$=TER$
  33. 230 FE$="LF-"
  34. 240 SEND =0
  35. 250 PAUSE1=0
  36. 260 ONLINE=-1
  37. 270 PAUSE=0
  38. 280 HALF=0
  39. 290 DU$="FULL DUPLEX"
  40. 300 ST$="ON LINE"
  41. 310 PRINT "Please wait....."
  42. 320 LOCATE,,1
  43. 330 N$=CHR$(14)
  44. 340 XON$=CHR$(17):XOFF$=CHR$(19)
  45. 350 ACK$=CHR$(6):NAK$=CHR$(21)
  46. 360 SOH$=CHR$(1):EOT$=CHR$(4):CAN$=CHR$(24)
  47. 370 BK$=CHR$(29)+CHR$(32)+CHR$(29)
  48. 380 BK1$=CHR$(32)+CHR$(29)
  49. 390 FEED=0
  50. 400 LF$=CHR$(10)
  51. 410 OPEN "COM1:300,N,8,1" AS 1
  52. 420 REM **** PUT DEFAULT TELEPHONE NUMBER IN NEXT LINE ****
  53. 430 NUM$="254-3408":REM A.B.Dick / PCMODEM NUMBER
  54. 440 PRINT #1,N$;"I "
  55. 450 PRINT "INITIALIZING MODEM..."
  56. 460 FOR I=1 TO 7000:NEXT I
  57. 470 GOSUB 1700
  58. 480 PRINT
  59. 490 PRINT "Enter phone number to call or <Enter> for default - ";
  60. 500 INPUT NX$
  61. 510 IF NX$=""THEN GOTO 540
  62. 520 NUM$=NX$
  63. 530 GOSUB 1700
  64. 540 PRINT
  65. 550 PRINT "Hit <Enter> to place call, <Esc> to quit - ";
  66. 560 X$=INKEY$:IF X$="" THEN 560
  67. 570 IF X$=CHR$(27) THEN 1440
  68. 580 GOSUB 1570
  69. 590 ON KEY(1) GOSUB 1890
  70. 600 ON KEY(2) GOSUB 1930
  71. 610 ON KEY(3) GOSUB 3000
  72. 620 ON KEY(4) GOSUB 4000
  73. 630 ON KEY(5) GOSUB 8000
  74. 640 ON KEY(6) GOSUB 6000
  75. 650 ON KEY(7) GOSUB 1200
  76. 660 ON KEY(8) GOSUB 1310
  77. 670 ON KEY(9) GOSUB 1380
  78. 680 ON KEY(10) GOSUB 1440
  79. 690 ON KEY(11) GOSUB 1570
  80. 700 PRINT #1,N$;"F 4"
  81. 710 FOR I=1 TO 500:NEXT I
  82. 720 PRINT #1,N$;"C 3"
  83. 730 FOR I=1 TO 500:NEXT I
  84. 740 PRINT #1,N$;"D ";NUM$
  85. 750 PRINT "DIALING - "
  86. 760 GOSUB 780
  87. 770 GOTO 900
  88. 780 KEY(1) ON
  89. 790 KEY(2) ON
  90. 800 KEY(3) ON
  91. 810 KEY(4) ON
  92. 820 KEY(5) ON
  93. 830 KEY(6) ON
  94. 840 KEY(7) ON
  95. 850 KEY(8) ON
  96. 860 KEY(9) ON
  97. 870 KEY(10) ON
  98. 880 KEY(11) ON
  99. 890 RETURN
  100. 900 IF EOF(1) THEN 1030
  101. 910 IF LOC(1) = 255 AND PAUSE1 = 0 THEN PRINT#1,XOFF$;:PAUSE1=-1
  102. 920 I$=INPUT$(1,1)
  103. 930 I$=CHR$(ASC(I$) AND 127)
  104. 940 IF I$>CHR$(31) THEN 1010
  105. 950 IF I$="" OR I$=CHR$(10) OR I$=CHR$(0) THEN 1030
  106. 970 IF I$<>CHR$(8) THEN 1010
  107. 980 IF POS(0)=1 THEN 1000
  108. 990 PRINT BK$;:GOTO 1020
  109. 1000 PRINT BK1$;:GOTO 1020
  110. 1010 PRINT I$;
  111. 1020 IF DISK THEN GOSUB 1120
  112. 1030 IF EOF(1) AND PAUSE1 THEN PRINT #1,XON$;:PAUSE1=0
  113. 1040 IF SEND THEN RETURN
  114. 1050 K$=INKEY$:IF K$<>"" THEN PRINT #1,K$;:IF HALF THEN GOSUB 1080
  115. 1060 IF FEED AND K$=CHR$(13) THEN PRINT #1,LF$;
  116. 1070 GOTO 900
  117. 1080 IF K$<>CHR$(8) THEN 1110
  118. 1090 IF POS(0) > 1 THEN PRINT BK$;:RETURN
  119. 1100 IF POS(0) = 1 THEN PRINT BK1$;:RETURN
  120. 1110 PRINT K$;:RETURN
  121. 1120 A(I1)=ASC(I$):I1=I1+1
  122. 1130 IF (EOF(1) AND I1>128) OR I1>512 THEN GOSUB 1150
  123. 1140 RETURN
  124. 1150 GOSUB 5000:PAUSE1=-1
  125. 1160 FOR I2=1 TO 300:NEXT I2
  126. 1170 FOR J1=0 TO I1:PRINT #3,CHR$(A(J1));:NEXT J1:I1=0
  127. 1180 GOSUB 5000:PAUSE1=0
  128. 1190 RETURN
  129. 1200 REM * FN 7
  130. 1210 GOSUB 1570
  131. 1220 PRINT "Enter new number - ";
  132. 1230 INPUT NX$
  133. 1240 IF NX$="" THEN 1270
  134. 1250 NUM$=NX$
  135. 1260 GOSUB 1700
  136. 1270 PRINT #1,N$;"D ";NUM$
  137. 1280 GOSUB 1570
  138. 1290 PRINT "DIALING -"
  139. 1300 RETURN
  140. 1310 REM * FN 8
  141. 1320 PRINT #1,N$
  142. 1330 FOR I=1 TO 500:NEXT I
  143. 1340 PRINT #1,N$;"R "
  144. 1350 PRINT
  145. 1360 PRINT "REDIALING -"
  146. 1370 RETURN
  147. 1380 REM * FN 9
  148. 1390 PRINT
  149. 1400 PRINT #1,N$;"H "
  150. 1410 PRINT "HANGING UP..."
  151. 1420 FOR I=1 TO 1000:NEXT I
  152. 1430 RETURN
  153. 1440 REM * FN 0
  154. 1450 PRINT "BACK TO BASIC NOW..."
  155. 1460 CLOSE
  156. 1470 CLS
  157. 1480 END
  158. 1490 REM * TITLE SCREEN
  159. 1500 CLS
  160. 1510 PRINT TAB(20);"IBM PCjr TERMINAL COMMUNICATIONS PROGRAM"
  161. 1520 PRINT TAB(20);"       for the IBM Internal Modem"
  162. 1530 PRINT TAB(20);"          Copyright  (c) 1984"
  163. 1540 PRINT TAB(20);"          by David W. Carroll"
  164. 1550 PRINT
  165. 1560 RETURN
  166. 1570 REM * WORK SCREEN
  167. 1580 CLS
  168. 1590 PRINT TAB(20);"IBM PCjr TERMINAL COMMUNICATIONS PROGRAM"
  169. 1610 PRINT TAB(20);"Fn 1 = Auto Line Feed  Fn 2 = Echo On/Off"
  170. 1620 PRINT TAB(20);"Fn 3 = ASCII File XMT  Fn 4 = ASCII File Capture ON/OFF"
  171. 1630 PRINT TAB(20);"Fn 5 = XMODEM File XMT Fn 6 = XMODEM File Recv"
  172. 1640 PRINT TAB(20);"Fn 7 = New Number      Fn 8 = Start redial"
  173. 1650 PRINT TAB(20);"Fn 9 = Hang up phone   Fn 0 = Quit to BASIC"
  174. 1660 PRINT TAB(20);CHR$(24);" = Display Menu"
  175. 1670 PRINT TAB(20);"<Esc> to cancel operation in progress."
  176. 1680 PRINT :PRINT
  177. 1690 MO$=TER$
  178. 1700 REM * PRINT STATUS LINE
  179. 1710 COL=POS(0)
  180. 1720 LN=CSRLIN
  181. 1730 COLOR 0,7
  182. 1740 LOCATE 25,1
  183. 1750 PRINT SPACE$(79);
  184. 1760 LOCATE 25,1
  185. 1770 PRINT "STAT: ";ST$;
  186. 1780 LOCATE 25,16
  187. 1790 PRINT FE$;
  188. 1800 LOCATE 25,20
  189. 1810 PRINT "MODE: ";MO$;
  190. 1820 LOCATE 25,45
  191. 1830 PRINT "TELE # ";NUM$;
  192. 1840 LOCATE 25,68
  193. 1850 PRINT DU$;
  194. 1860 LOCATE LN,COL,1
  195. 1870 COLOR 7,0
  196. 1880 RETURN
  197. 1890 FEED = NOT FEED
  198. 1900 IF NOT FEED THEN 1920
  199. 1910 FE$="LF+":GOSUB 1700:RETURN
  200. 1920 FE$="LF-":GOSUB 1700:RETURN
  201. 1930 HALF=NOT HALF : IF NOT HALF THEN 1950
  202. 1940 DU$="HALF DUPLEX":GOSUB 1700:RETURN
  203. 1950 DU$="FULL DUPLEX":GOSUB 1700:RETURN
  204. 3000 REM * SEND ASCII FILE
  205. 3010 MS$="DISK --> MODEM":GOSUB 1700
  206. 3020 PAUSE = 0
  207. 3030 PRINT
  208. 3040 PRINT "Send ASCII File":PRINT
  209. 3050 PRINT
  210. 3060 PRINT "Enter SEND file name: ";
  211. 3070 INPUT F$
  212. 3080 IF F$="" THEN 3320
  213. 3090 OPEN "I",#3,F$
  214. 3100 PRINT "Transmit file ";F$;
  215. 3110 INPUT "(Y/N) ";X$
  216. 3120 X$=LEFT$(X$,1)
  217. 3130 IF X$<>"Y" AND X$<>"y" THEN 3320
  218. 3140 SEND=NOT SEND
  219. 3150 WHILE NOT EOF(3) AND K$<>CHR$(27)
  220. 3160   IF PAUSE THEN 3210
  221. 3170   LINE INPUT #3,TX$
  222. 3180   PRINT #1,TX$
  223. 3190   IF FEED THEN PRINT 1,LF$;
  224. 3200   FOR I=1 TO 500:NEXT I
  225. 3210   WHILE NOT EOF(1)
  226. 3220     GOSUB 920
  227. 3230     IF I$=XOFF$ THEN PAUSE=-1
  228. 3240     IF I$=XON$ THEN PAUSE = 0
  229. 3250   WEND
  230. 3260   K$=INKEY$
  231. 3270 WEND
  232. 3280 SEND=NOT SEND
  233. 3290 CLOSE 3:DISK = 0: PRINT "File closed" : GOSUB 1690
  234. 3300 PRINT
  235. 3310 RETURN
  236. 3320 PRINT "Aborted"
  237. 3330 PRINT
  238. 3340 GOSUB 1690
  239. 3350 IF NOT ONLINE THEN GOSUB 5000
  240. 3360 DISK = 0
  241. 3370 RETURN
  242. 4000 REM * RECEIVE ASCII FILE
  243. 4010 DISK = NOT DISK
  244. 4020 IF DISK THEN 4080
  245. 4030 GOSUB 1150
  246. 4040 CLOSE 3
  247. 4050 PRINT :PRINT "File closed"
  248. 4060 GOSUB 1690
  249. 4070 RETURN
  250. 4080 I1 = 0
  251. 4090 MO$= "MODEM -->DISK ":GOSUB 1700
  252. 4100 PRINT
  253. 4110 PRINT "Capture ASCII File":PRINT
  254. 4120 GOSUB 5000
  255. 4130 INPUT "Enter RECEIVE Filename: ",F$: IF F$="" THEN 4210
  256. 4140 CLOSE 3:OPEN "I",#3,F$
  257. 4150 PRINT "File ";F$;:INPUT "Exists - Erase? (Y/N) ", X$
  258. 4160 PRINT
  259. 4170 PRINT
  260. 4180 IF LEFT$(X$,1)="Y" OR LEFT$(X$,1)="y" THEN 4200
  261. 4190 GOTO 4130
  262. 4200 CLOSE 3:OPEN "O",#3,F$:GOSUB 5000:RETURN
  263. 4210 PRINT "Aborted"
  264. 4220 PRINT
  265. 4230 CLOSE 3
  266. 4240 GOSUB 5000
  267. 4250 DISK=0
  268. 4260 RETURN
  269. 4270 REM * GET A CHARACTER - XMODEM
  270. 4280 FOR J=1 TO T:IF NOT EOF(1) THEN W$=INPUT$(1,1):RETURN
  271. 4290 NEXT J:W$="":RETURN
  272. 4300 REM * MULTI-TRY
  273. 4310 T=T1*10
  274. 4320 FOR B=1 TO 10
  275. 4330 GOSUB 4270
  276. 4340 K$=INKEY$:IF K$=CHR$(27) THEN 6450
  277. 4350 IF W$=SOH$ THEN RETURN
  278. 4360 IF W$=EOT$ THEN 6360
  279. 4370 IF W$=CAN$ THEN 6460
  280. 4380 IF W$<>""THEN GOSUB 6470 :PRINT #1,NAK$;:GOTO 4300
  281. 4390 PRINT "Timeout ";B
  282. 4400 BAD=BAD+1
  283. 4410 NEXT B
  284. 4420 GOSUB 6470
  285. 4430 GOTO 6450
  286. 5000 REM * SEND XOFF/XON
  287. 5010 ONLINE = NOT ONLINE : IF NOT ONLINE THEN 5030
  288. 5020 PRINT #1,XON$;:ST$="ON LINE ":GOSUB 1700:RETURN
  289. 5030 PRINT #1,XOFF$;:ST$="OFF LINE ":GOSUB 1700:RETURN
  290. 6000 REM * RECEIVE FILE WITH X MODEM PROTOCOL
  291. 6010 PRINT "Receive File With XMODEM Protocol":PRINT
  292. 6020 MO$="XMODEM --> DISK":GOSUB 1700
  293. 6030 GOSUB 4120
  294. 6040 V$="":SEC=1:BLK=1:BAD=0:N1=0:T1=240
  295. 6050 GOSUB 6470
  296. 6060 PRINT #1,NAK$;
  297. 6070 GOSUB 4300
  298. 6080 T=T1
  299. 6090 V$=V$+W$
  300. 6100 WHILE LEN(V$) <=131
  301. 6110   X1=0
  302. 6120   GOSUB 4270
  303. 6130   IF W$<>"" THEN 6160
  304. 6140     X1=X1+1:PRINT "Character Timeout ";X1 : BAD=BAD+1: IF X1>1 THEN 6180
  305. 6150     GOTO 6120
  306. 6160   V$=V$+W$
  307. 6170 WEND
  308. 6180 IF LEN(V$) = 132 THEN Z$=MID$(V$,4,128) :N=132:GOTO 6230
  309. 6190 IF V$=EOT$ THEN 6360
  310. 6200 IF V$=CAN$ THEN 6460
  311. 6210 GOTO 6380
  312. 6220 IF SEC=ASC(MID$(V$,2,1))+1 AND (SEC XOR 255)=ASC(MID$(V$,3,1)) THEN 6420
  313. 6230 IF SEC<> ASC(MID$(V$,2,1)) THEN 6410
  314. 6240 IF (SEC XOR 255) <> ASC(MID$(V$,3,1)) THEN 6430
  315. 6250 FOR Q=1 TO 128 : CK=CK+ASC(MID$(Z$,Q,1)):NEXT
  316. 6260 IF (CK AND 255) <> ASC(MID$(V$,N,1)) THEN 6400
  317. 6270 IF BAD = 0 THEN LOCATE CSRLIN-1,1
  318. 6280 PRINT "Received #";BLK : SEC=255 AND (SEC+1):BLK=BLK+1:BAD=0
  319. 6290 N1=N1+1:B$(N1)=Z$
  320. 6300 IF N1=4 THEN 6330
  321. 6310 PRINT #1,ACK$;
  322. 6320 V$="":CK=0:GOTO 6070
  323. 6330 PRINT #3,B$(1);B$(2);B$(3);B$(4);
  324. 6340 N1=0:GOTO 6310
  325. 6350 BAD = BAD + 1 : GOTO 6070
  326. 6360 IF N1=0 THEN 6440
  327. 6370 FOR I=1 TO N1:PRINT #3,B$(I);:NEXT I:GOTO 6440
  328. 6380 PRINT "Short Block in #"   ;BLK:PRINT #1,NAK$;:GOTO 6350
  329. 6390 PRINT "Long  Block in #"   ;BLK:PRINT #1,NAK$;:GOTO 6350
  330. 6400 PRINT "Checksum Error in #";BLK:PRINT #1,NAK$;:GOTO 6350
  331. 6410 PRINT "Block #  Error in #";BLK:PRINT #1,NAK$;:GOTO 6350
  332. 6420 PRINT "Block #  Repeated in #";BLK-1 :BAD=BAD+1:GOTO 6310
  333. 6430 PRINT "Complement Error in #";BLK:PRINT #1,NAK$:GOTO 6350
  334. 6440 PRINT "File Closed.":CLOSE 3:PRINT#1,ACK$;:GOTO 6490
  335. 6450 PRINT "Transfer Canceled":CLOSE #3:KILL F$:PRINT #1,CAN$;:GOTO 6490
  336. 6460 PRINT "Transfer Aborted at Receiver":CLOSE 3:KILL F$:GOTO 6490
  337. 6470 REM * PURGE BUFFER
  338. 6480 WHILE NOT EOF(1) :JUNK$=INPUT$(1,1):WEND:RETURN
  339. 6490 PRINT:GOSUB 1690:GOSUB 780:GOTO 900
  340. 7000 REM ERROR VECTOR TABLE
  341. 7010 PRINT
  342. 7020 IF ERR=24 THEN PRINT "Device Timeout":PRINT :RESUME 6490
  343. 7030 IF ERR=27 THEN PRINT "Printer"       :PRINT :RESUME 6490
  344. 7040 IF ERR=57 AND ERL=4280 THEN RESUME 4280
  345. 7050 IF ERR=57 AND ERL=920 THEN RESUME 900
  346. 7060 IF ERR=57 THEN PRINT "Device I/O Error":PRINT :RESUME 6490
  347. 7070 IF ERR=52 THEN PRINT "Bad Filename"          : GOTO 7170
  348. 7080 IF ERR=61 THEN PRINT "Disk Full"             : GOTO 7170
  349. 7090 IF ERR=67 THEN PRINT "Directory Full"        : GOTO 7170
  350. 7100 IF ERR=70 THEN PRINT "Disk Write Protected"  : GOTO 7170
  351. 7110 IF ERR=71 THEN PRINT "Drive Not Ready"       : GOTO 7170
  352. 7120 IF ERR=72 THEN PRINT "Disk Media Error"      : GOTO 7170
  353. 7130 IF ERR=53 AND ERL=4140 THEN RESUME 4200
  354. 7140 IF ERR=53 THEN PRINT "File Not Found" : PRINT : FILES: GOTO 7170
  355. 7150 IF ERR=58 THEN PRINT "File Already Exists": PRINT :FILES:GOTO 7170
  356. 7160 ON ERROR GOTO 0
  357. 7170 PRINT :DISK=0:CLOSE 3:IF NOT ONLINE THEN GOSUB 5000
  358. 7180 LOCATE ,,1:RESUME 6490
  359. 8000 REM * SEND FILE WITH XMODEM PROTOCOL
  360. 8010 PRINT
  361. 8020 PRINT "Send File With XMODEM Protocol":PRINT
  362. 8030 MO$="DISK --> XMODEM":GOSUB 1700
  363. 8040 IC%=INP(&H3FC)
  364. 8050 IZ%=IC% AND &HFB
  365. 8060 OUT &H3FC, IZ%
  366. 8070 PRINT #1,N$;"T 0"
  367. 8080 PRINT
  368. 8090 PRINT "Enter SEND file name: ";
  369. 8100 INPUT F$
  370. 8110 IF F$="" THEN 8200
  371. 8120 OPEN "I",#3,F$
  372. 8130 CLOSE 3
  373. 8140 OPEN F$ AS 3 LEN=128:FIELD #3,128 AS Z$
  374. 8150 PRINT "Transmit file ";F$;
  375. 8160 INPUT " (Y/N) ";X$
  376. 8170 X$=LEFT$(X$,1)
  377. 8180 IF X$<>"Y" AND X$<>"y" THEN 8200
  378. 8190 GOTO 8240
  379. 8200 PRINT
  380. 8210 IF NOT ONLINE THEN GOSUB 5000
  381. 8220 DISK = 0
  382. 8230 GOTO 8580
  383. 8240 SEC=0:GOSUB 6480
  384. 8250 EOT=0 :W$="":FL!=LOF(3):TBLK!=LOF(3)/128
  385. 8260 BKS=INT(TBLK!)
  386. 8270 IF LOF(3) MOD 128>0 THEN BKS=BKS+1
  387. 8280 PRINT "Total blocks to send: ";BKS
  388. 8290 PRINT :PRINT
  389. 8300 BLK=0:CT!=0:BAD=0
  390. 8310 WHILE NOT EOF(1)
  391. 8320    W$=INPUT$(1,1)
  392. 8330    IF W$=CAN$ THEN 8580
  393. 8340    IF W$=NAK$ THEN 8430
  394. 8350 WEND
  395. 8352 IF INKEY$=CHR$(27) THEN 8580
  396. 8354 GOTO 8310
  397. 8360 WHILE NOT EOF(1)
  398. 8370    W$=INPUT$(1,1)
  399. 8380    IF W$=ACK$ THEN CK=0 : W$="":GOTO 8420
  400. 8390    IF W$=NAK$ THEN BAD=BAD+1:GOSUB 6480:GOTO 8520
  401. 8400    IF W$=CAN$ THEN 8580
  402. 8410 WEND
  403. 8412 IF INKEY$=CHR$(27) THEN 8580
  404. 8414 GOTO 8360
  405. 8420 IF EOT THEN 8590
  406. 8430 CK=0:W$="":BLK=BLK+1:BAD=0
  407. 8440 CT!=CT!+128:GET#3,BLK
  408. 8450 IF CT!<=FL! THEN 8470
  409. 8460 Z$=MID$(Z$,1,128-(CT!-FL!))+STRING$(CT!-FL!,CHR$(0)):EOT=-1
  410. 8470 CK=0:FOR I=1 TO LEN(Z$) : CK=CK+ASC(MID$(Z$,I,1)):NEXT
  411. 8480 CK=(CK AND 255)
  412. 8490 IF CK>255 THEN CK=CK-256:GOTO 8490
  413. 8500 SEC=(255 AND BLK)
  414. 8510 A$=SOH$+CHR$(SEC)+CHR$(SEC XOR 255)+Z$+CHR$(CK)
  415. 8520 IF BAD > 9 THEN 8580
  416. 8530 PRINT #1,A$;
  417. 8540 IF BAD=0 THEN LOCATE CSRLIN-1,1
  418. 8550 PRINT "Sending #";BLK;" --- ";INT((BLK/BKS)*100);"% COMPLETE"
  419. 8560 K$=INKEY$:IF K$=CHR$(27) THEN 8580
  420. 8570 GOTO 8360
  421. 8580 PRINT "Transfer Aborted":CLOSE 3:PRINT #1,CAN$;:GOTO 8660
  422. 8590 PRINT "Transmission Ended.":CLOSE 3:PRINT #1,EOT$;
  423. 8660 IC%=INP(&H3FC)
  424. 8670 IZ%=IC% OR &H4
  425. 8680 OUT &H3FC, IZ%
  426. 8690 WHILE EOF(1)
  427. 8700 WEND
  428. 8710 I$=INPUT$(1,1)
  429. 8720 IF I$=ACK$ THEN PRINT "Transfer Acknowledged":PRINT :RETURN 900
  430. 8730 RETURN 930
  431. 8740 REM **** END OF PROGRAM ****
  432.