home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 35.dms / 35.adf / xmodem.bas < prev   
Encoding:
BASIC Source File  |  1988-05-22  |  4.2 KB  |  108 lines
  1. 100   scnclr: print "Xterm v3.1 by K.L. Colclasure (11/16/85)"
  2. 110   print: print "Commercial distribution prohibited without"
  3. 120   print "express written permission of author ..."
  4. 130   'RS232 drivers derived from UART.BAS by John Hodgson
  5. 150   size% = 5: timeout% = 500: baud% = 300
  6. 290   gosub 900: goto 500
  7. 300   key% = asc(key$): poke_w out%, key% + 256
  8. 310   return
  9. 320   gflag% = 0: char% = peek_w(in%)
  10. 330   if (char% and 16384) = 0 then return else gflag% = -1
  11. 340   char% = char% and 127: poke intrq%, 8: return
  12. 350   t = 0: toflag% = 0
  13. 360   char% = peek_w(in%)
  14. 370   if (char% and 16384) = 0 then t = t + 1 else 400
  15. 380   if t > timeout% then toflag% = -1: return
  16. 390   goto 360
  17. 400   char% = char% and 255: poke intrq%, 8: return
  18. 410   cksum% = 0: for i = 1 to 131
  19. 420   cksum% = (cksum% + buf%(n,i)) and 255: next i
  20. 430   if cksum% = buf%(n,132) then 450
  21. 440   print "Cksum error in"; blk%: key$ = nak$: return
  22. 450   mblk% = blk% and 255
  23. 460   if mblk% = buf%(n,2) then 480
  24. 470   print "Sync error in"; blk%: key$ = nak$: return
  25. 480   blk% = blk% + 1: n = n + 1: key$ = ack$
  26. 490   print "  Recieved"; blk% - 1; chr$(13);: return
  27. 500   print: print "[Term: use HELP key for instructions]"
  28. 505   print: on error goto 0
  29. 510   get key$: if key$ = "" then 540
  30. 520   if key$ = chr$(155) then 800
  31. 530   gosub 300
  32. 540   gosub 320: if (gflag%) then print chr$(char%);
  33. 550   goto 510
  34. 600   print: print "Recieve, enter filename: ";
  35. 610   line input file$: if file$ = "" then 500
  36. 620   open "o",#1,file$: close #1
  37. 630   blk% = 1: n = 1: eotflag% = 0: key$ = nak$
  38. 650   gosub 300: for i = 1 to 132: gosub 350
  39. 651   if (toflag%) then key$ = nak$: goto 650
  40. 652   if (i = 1) and (char% = eot) then 660
  41. 653   buf%(n,i) = char%: next i: gosub 410
  42. 654   if n > top% then 670 else 650
  43. 660   eotflag% = -1
  44. 670   open "a",#1,file$
  45. 671   for x = 1 to (n - 1): for y = 4 to 131
  46. 672   print #1, chr$(buf%(x,y));
  47. 673   next y,x
  48. 674   close #1
  49. 680   if not (eotflag%) then n = 1: goto 650
  50. 685   gosub 300
  51. 690   print: print "Transfer complete ...": goto 500
  52. 700   print: print "Send, enter filename: ";
  53. 701   line input file$: if file$ = "" then 500
  54. 702   on error goto 2500
  55. 703   open "i",#1,file$
  56. 704   on error goto 0
  57. 710   n = lof(1): n = n / 128
  58. 711   if int(n) < n then n = int(n) + 1 else n = int(n)
  59. 712   print "File open,";n;"records."
  60. 720   n = 1: blk% = 1
  61. 730   buf%(n,1) = soh: buf%(n,2) = blk% and 255
  62. 731   buf%(n,3) = buf%(n,2) xor 255
  63. 740   for i = 4 to 131
  64. 741   if not eof(1) then get #1, char$ else char$ = eof$
  65. 742   buf%(n,i) = asc(char$): next i
  66. 743   gosub 770: gosub 780: print "  Sent block"; blk%; chr$(13);
  67. 744   if not eof(1) then blk% = blk% + 1: goto 730
  68. 750   close #1
  69. 760   key$ = chr$(eot): gosub 300
  70. 761   gosub 320: if not gflag% then 761
  71. 762   if char% = nak then 760
  72. 763   if char% = ack then 690 else 761
  73. 770   cksum% = 0: for i = 1 to 131
  74. 771   cksum% = (cksum% + buf%(n,i)) and 255: next i
  75. 772   buf%(n,132) = cksum%: return
  76. 780   if blk% = 1 then 783
  77. 781   for i = 1 to 132: key$ = chr$(buf%(n,i))
  78. 782   gosub 300: sleep 30000: next i
  79. 783   gosub 320: if not gflag% then 783
  80. 784   if char% = nak then 781
  81. 785   if char% = ack then return else 783
  82. 800   get key$: if key$ = "" then 510 else fkey% = asc(key$)
  83. 810   fkey% = fkey% - 47: get key$: if key$ <> chr$(126) then 510
  84. 820   if fkey% = 16 then 2000
  85. 830   on fkey% goto 1000,1000,1000,1000,1000,600,700,600,600,1500
  86. 900   option base 1: dim buf%(size%*8,132): top% = size% * 8
  87. 910   baudr% = &hdff032: out% = &hdff030
  88. 920   in% = &hdff018: intrq% = &hdff09c
  89. 930   poke_w baudr%, (1/baud%)/(.2794*1e-06)
  90. 940   ack$ = chr$(6): nak$ = chr$(21): eot$ = chr$(4)
  91. 950   ack = 6: nak = 21: eot = 4: soh = 1
  92. 960   eof$ = chr$(26)
  93. 990   return
  94. 1000  goto 2000
  95. 1500  key$ = chr$(3): gosub 300: goto 510
  96. 2000  print: print "Function key assignments ..."
  97. 2010  print
  98. 2020  print "[F1] thru [F5]: User definable. (Not implemented)"
  99. 2030  print "[F6]: Recieve file with Xmodem protocol."
  100. 2040  print "[F7]: Send file with Xmodem protocol."
  101. 2050  print "[F8] and [F9]: Reserved for future expansion."
  102. 2060  print "[F10]: Send Control-C to host system."
  103. 2070  print
  104. 2080  print "Typing a Control-C will terminate the program. Use [F10]"
  105. 2090  print "to send this character!"
  106. 2100  goto 500
  107. 2500  print "Unable to open file ...": resume 500
  108.