home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / modem / ibmxmo.bqs / IBMXMO.BAS
BASIC Source File  |  1994-03-04  |  16KB  |  357 lines
  1.  
  2. 50 ' THIS PROGRAM KINDA RE-WRITTEN BY CAPITAL PC USER GROUP PEOPLE.
  3. 55 ' ANY PROBLEMS PLEASE LET US KNOW.  301-949-8848 OR 703-560-0979
  4. 57 ' The help of BJ Reckman is appreciated.
  5. 58 ' You must change a lot of places if you use COM2: and your smartmodem
  6. 59 ' must be set up as line 86 so notes...    CPCUG SOFTSIG
  7. 60 ' set up as follows A>BASICA IBMODEM2/C:1024
  8. 70 '                 In order for the hang-up command to work,
  9. 80 '                 you MUST flip switch #1 on the modem UP.
  10. 85 '                      (You should have it up anyway.)
  11. 86 '                SWITCH SETTINGS ON SMARTMODEM UUDDDDDD
  12. 87 '
  13. 88 'This program probably will not work with an IN-BOARD modem ie HAYES 1200B
  14. 90 SCREEN 0,0,0,0 : LOCATE ,,1 : WIDTH 40 : KEY OFF : CLOSE
  15. 95 ON ERROR GOTO 1000
  16. 100             ' Set Variable Defaults ---------------------------------------
  17. 110 DEFINT A-Z                    ' All Variables Are Integers
  18. 120 ONLINE = -1                   ' Start On-Line
  19. 130 EVEN   =  0                   ' Even Parity, 7 Bit Word Structure
  20. 140 PRINTER=  0                   ' Printer Off
  21. 150 DISK   =  0                   ' Disk(s) Off
  22. 160 LOCAL  =  0 : HOST=0          ' Echoes  Off
  23. 170 BK$=CHR$(29)+CHR$(32)+CHR$(29)' Clean Backspace For Local PC
  24. 180 SOH$=CHR$(1)  :  EOT$=CHR$(4)  : ACK$=CHR$(6)
  25. 190 XON$=CHR$(17) : XOFF$=CHR$(19) : NAK$=CHR$(21) : CAN$=CHR$(24)
  26. 200             ' Define Funtion Keys -----------------------------------------
  27. 210 KEY(1)ON:ON KEY(1)GOSUB 3100
  28. 220 KEY(2)ON:ON KEY(2)GOSUB 3200
  29. 230 KEY(3)ON:ON KEY(3)GOSUB 3300
  30. 240 KEY(4)ON:ON KEY(4)GOSUB 3400
  31. 250 KEY(5)ON:ON KEY(5)GOSUB 3500
  32. 260 KEY(6)ON:ON KEY(6)GOSUB 3600
  33. 270 KEY(7)ON:ON KEY(7)GOSUB 3700
  34. 280 KEY(8)ON:ON KEY(8)GOSUB 3800
  35. 290 KEY(9)ON:ON KEY(9)GOSUB 3900
  36. 295 KEY(10)ON:ON KEY(10)GOSUB 4000
  37. 297 DEF SEG:POKE 106,0
  38. 300             ' Define I/O Channels -----------------------------------------
  39. 310 OPEN "R",#1,"COM1:300,N,8,,RS,CS,DS"          ' Modem ====> File #1
  40. 320 'OPEN "O",#2,"LPT1:"          ' Printer ==> File #2
  41. 330 'PRINT #1,"ATE1QTS11=50"      ' Initialize Modem
  42. 340 FOR X=1 TO 1000 : NEXT : GOSUB 25000 : GOSUB 800
  43. 400             ' Keyboard Driven Terminal Loop -------------------------------
  44. 410 WHILE ONLINE
  45. 420    X$=INKEY$:IF X$<>"" THEN LOCATE ,,1:PRINT #1,X$;:IF LOCAL THEN GOSUB 470
  46. 430    GOSUB 500
  47. 440 WEND
  48. 450 IF NOT ONLINE THEN 450  ' Off-Line Wait Loop
  49. 460 GOTO 410
  50. 470 IF POS(0)>1 AND X$=CHR$(8) THEN PRINT BK$; ELSE PRINT X$;
  51. 480 RETURN
  52. 500             ' Main Communication Loop -------------------------------------
  53. 510 WHILE NOT EOF(1)
  54. 520    X$=INKEY$ : IF X$<>"" THEN LOCATE ,,1 : PRINT #1,X$;
  55. 530    Y$=INPUT$(LOC(1),#1) : IF DISK THEN PRINT #3,Y$;
  56. 540    FOR I=1 TO LEN(Y$)
  57. 550       J=ASC(MID$(Y$,I,1)) : IF J=10 THEN 590 ELSE IF J=8 THEN 595
  58. 560       PRINT CHR$(J); : IF HOST THEN PRINT #1,CHR$(J);
  59. 570    NEXT : IF PRINTER THEN PRINT #2,Y$;
  60. 580 WEND : RETURN
  61. 590 MID$(Y$,I,1)=" " : GOTO 570
  62. 595 IF POS(0)>1 THEN PRINT BK$; : IF HOST THEN PRINT #1,CHR$(J);
  63. 597 GOTO 570
  64. 800             ' Function Key Display Menu -----------------------------------
  65. 810 CLS : PRINT TAB(15);"MENU FOR FUNCTION KEYS" : PRINT
  66. 820 PRINT TAB(10)"Key 1 . . . . . . To Toggle Modem Online/Offline
  67. 830 PRINT TAB(10)"Key 2 . . . . . . To Toggle On/Off LOCAL Echo
  68. 840 PRINT TAB(10)"Key 3 . . . . . . To Toggle On/Off HOST  Echo
  69. 850 PRINT TAB(10)"Key 4 . . . . . . To Dial A Number
  70. 860 PRINT TAB(10)"Key 5 . . . . . . To Display This Menu
  71. 870 PRINT TAB(10)"Key 6 . . . . . . To Toggle Printer On/Off
  72. 880 PRINT TAB(10)"Key 7 . . . . . . To Write To Disk From Modem
  73. 890 PRINT TAB(10)"Key 8 . . . . . . To Write To Modem From Disk
  74. 900 PRINT TAB(10)"Key 9 . . . . . . To Toggle Between E,7,1 and N,8,1 words
  75. 910 PRINT TAB(10)"Key 10. . . . . . To Return To Basic  Without Hanging-Up
  76. 920 PRINT
  77. 930 PRINT TAB(10)"Alt + Key 3 . . . To Change To 300 Baud
  78. 940 PRINT TAB(10)"Alt + Key 4 . . . To Continuously Dial A Number
  79. 950 PRINT TAB(10)"Alt + Key 5 . . . To Change To 450 Baud
  80. 960 PRINT TAB(10)"Alt + Key 6 . . . To Change To 600 Baud
  81. 970 PRINT TAB(10)"Alt + Key 7 . . . To Write To Disk With Xmodem Protocol
  82. 975 PRINT TAB(10)"Alt + Key 8 . . . To Write To Modem From Disk With Xmodem
  83. 980 PRINT TAB(10)"Alt + Key 10. . . To Hang-Up
  84. 985 LOCATE 25,1:PRINT "Help F-5";:IF PRINTER THEN PRINT " :Printer ON"; ELSE PRINT " :Printer OFF";:LOCATE 20,1,1
  85. 990 PRINT : RETURN
  86. 1000            ' Error Vector Table -----------------------------------------
  87. 1010 PRINT
  88. 1020 IF ERR=24 THEN PRINT "Device Timeout" : PRINT : RESUME 400
  89. 1030 IF ERR=27 THEN PRINT "Printer"        : PRINT : RESUME 400
  90. 1040 IF ERR=57 THEN PRINT "Device I/O"     : PRINT : RESUME 400
  91. 1050 IF ERR=52 THEN PRINT "Bad Filename"           : GOTO 1150
  92. 1060 IF ERR=61 THEN PRINT "Disk Full"              : GOTO 1150
  93. 1070 IF ERR=67 THEN PRINT "Directory Full"         : GOTO 1150
  94. 1080 IF ERR=70 THEN PRINT "Disk Write Protected"   : GOTO 1150
  95. 1090 IF ERR=71 THEN PRINT "Drive Not Ready"        : GOTO 1150
  96. 1100 IF ERR=72 THEN PRINT "Disk Media Error"       : GOTO 1150
  97. 1105 IF ERR=53 AND ERL=3770 THEN RESUME 3780
  98. 1110 IF ERR=53 THEN PRINT "File Not Found" : PRINT : FILES : GOTO 1150
  99. 1120 IF ERR=58 THEN PRINT "File Already Exists" : PRINT : FILES : GOTO 1150
  100. 1130 ON ERROR GOTO 0
  101. 1150 PRINT : DISK=0 : CLOSE #3 : IF NOT ONLINE THEN GOSUB 3120
  102. 1160 LOCATE ,,1 : RESUME 400
  103. 3100            ' Service Function Key #1 -------------------------------------
  104. 3110 GOSUB 5000 : KEY(1)ON : ON S GOTO 6100,7100,8100
  105. 3120 ONLINE=NOT ONLINE : IF NOT ONLINE THEN 3140
  106. 3130 PRINT #1, XON$ : PRINT "Status :  ON  Line" : RETURN
  107. 3140 PRINT #1, XOFF$: PRINT "Status :  OFF Line" : RETURN
  108. 3200            ' Service Function Key #2 -------------------------------------
  109. 3210 GOSUB 5000 : KEY(2) ON : ON S GOTO 6200,7200,8200
  110. 3220 LOCAL=NOT LOCAL
  111. 3230 PRINT "Local Echo "; : IF LOCAL THEN PRINT "ON" ELSE PRINT "OFF"
  112. 3240 RETURN
  113. 3300            ' Service Function Key #3 -------------------------------------
  114. 3310 GOSUB 5000 : KEY(3)ON : ON S GOTO 6300,7300,8300
  115. 3320 HOST=NOT HOST
  116. 3330 PRINT "Host Echo "; : IF HOST THEN PRINT "ON" ELSE PRINT "OFF"
  117. 3340 RETURN
  118. 3400            ' Service Function Key #4 -------------------------------------
  119. 3410 GOSUB 5000 : KEY(4)ON : ON S GOTO 6400,7400,8400
  120. 3420 GOSUB 10000 : PRINT
  121. 3430 'PRINT #1,"AT M1 D "+X$
  122. 3440 RETURN
  123. 3500            ' Service Function Key #5 -------------------------------------
  124. 3510 GOSUB 5000 : KEY(5)ON : ON S GOTO 6500,7500,8500
  125. 3520 GOTO 800
  126. 3600            ' Service Function Key #6  ------------------------------------
  127. 3610 GOSUB 5000 : KEY(6)ON : ON S GOTO 6600,7600,8600
  128. 3620 PRINTER=NOT PRINTER
  129. 3630 IF PRINTER THEN LOCATE 25,11:PRINT "Printer ON "  ELSE LOCATE 25,11:PRINT "Printer OFF"
  130. 3640 RETURN
  131. 3700            ' Service Function Key #7 -------------------------------------
  132. 3710 GOSUB 5000 : KEY(7)ON : ON S GOTO 22000,7700,8700
  133. 3720 DISK=NOT DISK
  134. 3730 IF NOT DISK THEN CLOSE #3 : PRINT "File Closed" : RETURN
  135. 3740 GOSUB 3120
  136. 3750 PRINT "Modem   ====>>   Disk" : PRINT
  137. 3760 INPUT "ENTER FILENAME  : ",X$ : IF X$="" THEN 3790
  138. 3770 CLOSE #3 : OPEN "I",#3,X$ : ERROR 58
  139. 3780 CLOSE #3 : OPEN "O",#3,X$ : GOSUB 3120 : RETURN
  140. 3790 PRINT "Aborted" : PRINT : CLOSE #3 : GOSUB 3120 : DISK=0 : RETURN
  141. 3800            ' Service Function Key #8 -------------------------------------
  142. 3810 GOSUB 5000 : KEY(8)ON : ON S GOTO 30000,7800,8800
  143. 3820 PRINT "Disk   ====>>   Modem" : PRINT
  144. 3830 INPUT "ENTER FILENAME  : ",X$ : IF X$="" THEN 3790
  145. 3835 IF XX THEN GOTO 3845 ' BJR073183
  146. 3840 OPEN "I",#3,X$ : GOTO 3850 ' BJR073183
  147. 3845 OPEN X$ AS 3 LEN=128 : FIELD #3, 128 AS Z$ ' BJR073183
  148. 3850 PRINT "Proceed With File  ";X$;
  149. 3860 INPUT "  (Y/N)  ";Y$ : Y$=LEFT$(Y$,1)
  150. 3870 IF Y$<>"Y" AND Y$<>"y" THEN 3896
  151. 3875 IF XX THEN XX=0 : RETURN 30040
  152. 3880 WHILE NOT EOF(3)
  153. 3885   LINE INPUT #3,X$
  154. 3890   PRINT #1,X$
  155. 3892   FOR I=1 TO 1500:NEXT
  156. 3894 WEND
  157. 3896 CLOSE #3 : DISK=0 : PRINT "File Closed" : PRINT : RETURN
  158. 3900            ' Service Function Key #9 -------------------------------------
  159. 3910 GOSUB 5000 : KEY(9)ON : ON S GOTO 6900,7900,8900
  160. 3920 EVEN=NOT EVEN : IF NOT EVEN THEN 3940
  161. 3930 PRINT "Changed to Even Parity, With 7 Data Bits"
  162. 3935 'OUT &H3FB,26 : RETURN ' E-7-1 Word Structure *********
  163. 3940 RETURN
  164. 3945        ' SET TO 8 BIT NO PARITY?
  165. 3948 'OUT &H3FB,&H3
  166. 3950 RETURN
  167. 4000        ' RETURN TO BASIC WITH/WITHOUT HANGING UP
  168. 4010 RETURN
  169. 5000        ' WHAT DOES THIS DO?
  170. 5010        ' WILL THIS WORK?
  171. 5020 DEF SEG=&H40:A=PEEK(&H17)
  172. 5030 IF (A AND 8)=8 THEN S=1 : DEF SEG : RETURN      'Alternate
  173. 5040 IF (A AND 2)=2 THEN S=2 : DEF SEG : RETURN      'Left Shift
  174. 5050 IF (A AND 4)=4 THEN S=3 : DEF SEG : RETURN      'Control
  175. 5060                     S=0 : DEF SEG : RETURN
  176. 6100 RETURN
  177. 6200 RETURN
  178. 6300 '-------------------------------------------------- Alt + F3 -------------
  179. 6310 PRINT "Switch to 300 Baud."
  180. 6320 ON ERROR GOTO 0
  181. 6330 R=INP(&H3FB)
  182. 6340 K=R OR 128
  183. 6350 OUT &H3FB,K
  184. 6360 OUT &H3F8,&H1
  185. 6370 OUT &H3F9,&H2
  186. 6380 OUT &H3FB,R
  187. 6390 ON ERROR GOTO 1000 : RETURN
  188. 6400 'Continuous Dialing ------------------------------- Alt + F4 -------------
  189. 6405 IF NOT EVEN THEN GOSUB 3940
  190. 6410 GOSUB 10000 : PRINT : PRINT "Continuously Dialing ";X$
  191. 6420 PRINT "Press ESC twice to abort."
  192. 6430 T=0 : PRINT : PRINT "Number of calls attempted so far : ";
  193. 6440 T=T+1 : LOCATE ,36 : PRINT T; : 'PRINT #1,"AT M1 D "+X$
  194. 6450 IF CHR$(27)=INKEY$ THEN 6497 ELSE WHILE NOT EOF(1)
  195. 6460 INPUT #1,Y$ : FOR X=1 TO 1000 : NEXT
  196. 6470 IF INSTR (Y$,"NO CARRIER") THEN 6440
  197. 6480 IF INSTR (Y$,"CONNECT") THEN 6490
  198. 6485 WEND  : GOTO 6450
  199. 6490 PRINT : PRINT "Connection Established."
  200. 6495 WHILE INKEY$="" : SOUND 1000,10 : SOUND 735,8 : WEND
  201. 6497 PRINT : RETURN
  202. 6500 '------------------------------------------------- Alt + F5 ------------
  203. 6510 PRINT "Switch to 450 Baud."
  204. 6520 ON ERROR GOTO 0
  205. 6530 R=INP(&H3FB)
  206. 6540 K=R OR 128
  207. 6550 OUT &H3FB,K
  208. 6560 OUT &H3F8,&H0
  209. 6570 OUT &H3F9,&H1
  210. 6580 OUT &H3FB,R
  211. 6590 ON ERROR GOTO 1000 : RETURN
  212. 6600 '-------------------------------------------------- Alt + F6 -------------
  213. 6610 PRINT "Switch to 600 Baud."
  214. 6620 ON ERROR GOTO 0
  215. 6630 R=INP(&H3FB)
  216. 6640 K=R OR 128
  217. 6650 OUT &H3FB,K
  218. 6660 OUT &H3F8,&H1
  219. 6670 OUT &H3F9,&H1
  220. 6680 OUT &H3FB,R
  221. 6690 ON ERROR GOTO 1000 : RETURN
  222. 6900 RETURN
  223. 7000 '-------------------------------------------------- Alt + F10 ------------
  224. 7010 PRINT "Hanging-Up" : RUN
  225. 7100 RETURN
  226. 7200 RETURN
  227. 7300 RETURN
  228. 7400 RETURN
  229. 7500 RETURN
  230. 7600 RETURN
  231. 7700 RETURN
  232. 7800 RETURN
  233. 7900 RETURN
  234. 8000 RETURN
  235. 8100 RETURN
  236. 8200 RETURN
  237. 8300 RETURN
  238. 8400 RETURN
  239. 8500 RETURN
  240. 8600 RETURN
  241. 8700 RETURN
  242. 8800 RETURN
  243. 8900 RETURN
  244. 9000 RETURN
  245. 10000           ' Directory  --------------------------------------------------
  246. 10010 PRINT "|------------- Directory --------------------|"
  247. 10020 PRINT ":  A>  560-0979    CAPITAL PC UG BBS         :" : D$(1)="560-0979"
  248. 10030 PRINT ":  B>  949-8848    CPSUG SOFTSIG     (IBMPC) :" : D$(2)="949-8848"
  249. 10040 PRINT ":  C>  251-6293    COMM SIG CPCUG            :" : D$(3)="251-6293"
  250. 10050 PRINT ":  D>  978-9592    BASIC HELP CPCUG   (IBMPC):" : D$(4)="978-9592"
  251. 10060 PRINT ":  E>  424-5817    MONITOR CPCUG      (IBMPC):" : D$(5)="424-5817"
  252. 10070 PRINT ":  F>  759-5049    TOM MACK'S RBBS           :" : D$(6)="759-5049"
  253. 10080 PRINT "|--------------------------------------------<"
  254. 10090 PRINT "   Enter the corresponding letter"
  255. 10100 PRINT "   or type in any phone number."         : PRINT
  256. 10110 LINE INPUT "Number to Dial ? ";X$
  257. 10120 IF LEN(X$)=1 AND X$=>"A" AND X$<="F" THEN X$=D$(ASC(X$)-64) : RETURN
  258. 10130 IF LEN(X$)=1 AND X$=>"a" AND X$<="f" THEN X$=D$(ASC(X$)-96) : RETURN
  259. 10140 IF LEN(X$)<7 THEN LOCATE ,,1 : RETURN 400 ELSE RETURN
  260. 20000           ' Get Character -----------------------------------------
  261. 20010 Y$=""
  262. 20020 FOR A=1 TO 420
  263. 20030 IF NOT EOF(1) THEN Y$=INPUT$(LOC(1),#1) : RETURN
  264. 20040 NEXT A : Y$="" : RETURN
  265. 21000           ' Timeout -----------------------------------------------
  266. 21010 FOR B = 1 TO 10
  267. 21020 GOSUB 20000
  268. 21030 IF MID$(Y$,1,1)=SOH$ THEN RETURN
  269. 21040 IF MID$(Y$,1,1)=EOT$ THEN 22350
  270. 21050 IF MID$(Y$,1,1)=CAN$ THEN 22360
  271. 21060 IF Y$<>"" THEN GOSUB 25000 : GOTO 21000
  272. 21070 NEXT B
  273. 21080 IF Y$="" THEN PRINT #1,NAK$;
  274. 21090 GOTO 21000
  275. 22000           ' Receive With Xmodem Protocol ---------------------------
  276. 22010 PRINT "Receive File With XMODEM Protocol" : PRINT
  277. 22020 IF EVEN THEN GOSUB 3945      ' Set Word Structure To 8-N-1
  278. 22030 GOSUB 3740                   ' Open File
  279. 22040 GOSUB 25000                  ' Purge Buffer
  280. 22050 X$="" : SEC=1
  281. 22060 PRINT #1,NAK$;
  282. 22070 GOSUB 21000                  ' Timeout
  283. 22080 GOSUB 20000                  ' Get Char
  284. 22090 IF Y$="" THEN PRINT "Timeout" : GOTO 22120
  285. 22100 X$=X$+Y$
  286. 22110 IF LEN(X$)<=131 THEN 22080
  287. 22120 IF LEN(X$)= 132 THEN Z$=MID$(X$,4,128) : N=132 : GOTO 22200
  288. 22130 IF LEN(X$)= 131 THEN Z$=MID$(X$,3,128) : N=131 : GOTO 22200
  289. 22140 IF LEN(X$)> 132 THEN 22310
  290. 22150 IF X$=EOT$      THEN 22350
  291. 22160 IF X$=CAN$      THEN 22360
  292. 22170 GOTO 22300
  293. 22180 IF SEC<> VAL(MID$(X$,2,1) THEN 22330
  294. 22190 IF (SEC XOR 255) <> VAL(MID$(X$,3,1) THEN 22340
  295. 22200 FOR Q=1 TO 128 : CK=CK+ASC(MID$(Z$,Q,1)) : NEXT
  296. 22210 IF (CK AND 255) <> (ASC(MID$(X$,N,1))) THEN 22320
  297. 22220 PRINT "Received #";SEC : SEC=255 AND (SEC+1)
  298. 22230 PRINT #3,Z$;
  299. 22240 PRINT #1,ACK$;
  300. 22250 X$="" : CK=0 : GOTO 22080
  301. 22300 PRINT "Short Block in #"   ;SEC : PRINT #1,NAK$; : GOTO 22250
  302. 22310 PRINT "Long  Block in #"   ;SEC : PRINT #1,NAK$; : GOTO 22250
  303. 22320 PRINT "Checksum Error in #";SEC : PRINT #1,NAK$; : GOTO 22250
  304. 22330 PRINT "Block #  Error in #";SEC : PRINT #1,NAK$; : GOTO 22250
  305. 22340 PRINT "Complement Error in #";SEC:PRINT #1,NAK$; : GOTO 22250
  306. 22350 PRINT "File Closed." : PRINT #1,ACK$; : CLOSE #3 : GOTO 22370
  307. 22360 PRINT "Transfer Aborted at Receiver"  : CLOSE #3
  308. 22370 IF EVEN THEN GOSUB 3935
  309. 22380 RETURN 400
  310. 25000           'Purge Buffer ------------------------------------------
  311. 25010 WHILE NOT EOF(1) : DUMMY$=INPUT$(LOC(1),#1) : WEND : RETURN
  312. 30000           ' Send with Xmodem Protocol -----------------------------------
  313. 30010 PRINT "Send File With XMODEM Protocol" : PRINT
  314. 30020 IF EVEN THEN GOSUB 3945 'Set To N-8-1 Word Structure ********************
  315. 30030 XX=-1 : GOSUB 3820          'Open File
  316. 30040 SEC=0 : GOSUB 25000         'Purge Buffer
  317. 30050 EOT=0 : Y$="" : X$="" : FLN!=LOF(3) : TBLK!=LOF(3)/128 'BJR073183
  318. 30055 PRINT "Total Blocks to Send =";TBLK!
  319. 30060 BLK=0 : CNT!=0 'BJR073183
  320. 30100 WHILE NOT EOF(1)            'Wait for NAK
  321. 30110    Y$=INPUT$(1,#1)
  322. 30120    IF Y$=CAN$ THEN 30510
  323. 30130    IF Y$=NAK$ THEN 30310
  324. 30140 WEND  : GOTO 30100
  325. 30150 '
  326. 30200 WHILE NOT EOF (1)           ' Wait for ACK
  327. 30210    Y$=INPUT$(1,#1)
  328. 30220    IF Y$=ACK$ THEN CK=0 : Y$="" : GOTO 30300 ' BJR073183
  329. 30230    IF Y$=NAK$ THEN PRINT "RESENDING BLOCK # ",BLK : GOTO 30460 'BJR073183
  330. 30240    IF Y$=CAN$ THEN 30510
  331. 30250 WEND : GOTO 30200
  332. 30260 '
  333. 30300 IF EOT THEN 30500           ' Build and Send Block
  334. 30310 CK=0 : Y$="" : BLK=BLK+1 : CNT!=CNT!+128 : GET #3,BLK : IF CNT!<=FLN! THEN 30330 'BJR073183
  335. 30320 Z$=MID$(Z$,1,128-(CNT!-FLN!))+STRING$(CNT!-FLN!,CHR$(0)) : EOT=-1 'BJR073183
  336. 30330 CK=0 : FOR I=1 TO LEN(Z$) : CK=CK+ASC(MID$(Z$,I,1)) : NEXT : CK = (CK AND 255) 'BJR073183
  337. 30340 IF CK>256 THEN CK=CK-256 : GOTO 30340 ' BJR073183
  338. 30345 ' BJR073183
  339. 30360 ' BJR073183
  340. 30365 ' BJR073183
  341. 30370 ' BJR073183
  342. 30380 ' BJR073183
  343. 30390 ' BJR073183
  344. 30400 ' BJR073183
  345. 30410 ' BJR073183
  346. 30420 ' BJR073183
  347. 30430 ' BJR073183
  348. 30440 SEC=(255 AND BLK) ' BJR073183
  349. 30450 A$=SOH$+CHR$(SEC)+CHR$(SEC XOR 255)+Z$+CHR$(CK) ' BJR073183
  350. 30460 PRINT "Send #";SEC
  351. 30470 PRINT #1,A$;
  352. 30480 GOTO 30200
  353. 30490 ' BJR073183
  354. 30500 PRINT "Transmission Ended." : PRINT #1,EOT$; : CLOSE #3
  355. 30510 IF EVEN THEN GOSUB 3935
  356. 30520 RETURN 400
  357.