home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / turbobas / tbxm10.arc / XMODEM.BAS < prev   
Encoding:
BASIC Source File  |  1987-10-13  |  11.0 KB  |  428 lines
  1.      '┌───────────────────────────────────────────────────────────┐
  2.      '│  TITLE: XMODEM.BAS                           Version 1.0  │
  3.      '│  DESC.: A sample Xmodem routine for Turbo Basic (R)       │
  4.      '│  DATE : October 13, 1987                                  │
  5.      '│  AUTH.: Joe Vest   (BIX & GEnie: JVEST - CIS: 74017,1672) │
  6.      '│         8051 E. Roper St., Long Beach, CA, 90808          │
  7.      '│                                                           │
  8.      '│  Placed in the public domain Oct. 13, 1987 by Joe Vest.   │
  9.      '│                                                           │
  10.      '│     ***** USE THESE ROUTINES AT YOUR OWN RISK *****       │
  11.      '│                                                           │
  12.      '│  The author makes no guarantee as to the accuracy or      │
  13.      '│  suitability for a purpose of these routines.  Your use   │
  14.      '│  of these routines signifies your acceptance of the       │
  15.      '│  complete responsibility for any and all outcomes as      │
  16.      '│  the result of said use.                                  │
  17.      '│                                                           │
  18.      '│  Isn't it sad that the inherent greed of certain people   │
  19.      '│  in our society compels me to put a statement like that   │
  20.      '│  in a document that is circulated without charge for      │
  21.      '│  informational purposes?  Just remember, TANSTAAFL!       │
  22.      '│                                                           │
  23.      '│ ═════════════════════════════════════════════════════════ │
  24.      '│                                                           │
  25.      '│  I would like to thank Peter Boswell for helping me to    │
  26.      '│  understand the Xmodem protocol through his XMODEM.DOC    │
  27.      '│  file. I would also like to thank Craig J. Kim for his    │
  28.      '│  sharing with us the CHKCRC.INL code that is used here    │
  29.      '│  to impliment the CRC checking. And, of course, we        │
  30.      '│  should all thank Ward Christensen for providing us       │
  31.      '│  with the original MODEM7 protocol.                       │
  32.      '│                                                           │
  33.      '│ ═════════════════════════════════════════════════════════ │
  34.      '│                                                           │
  35.      '│  Documentation:                                           │
  36.      '│                                                           │
  37.      '│  This program is a simple demonstration of the Comm port  │
  38.      '│  routines in Turbo Basic.  It contains a simple commun-   │
  39.      '│  cation program and some sample Xmodem routines.  These   │
  40.      '│  routines are meant to be a starting point for those      │
  41.      '│  programmers who wish to learn more about the Comm system │
  42.      '│  in Turbo Basic and the author requests that you do not   │
  43.      '│  use them, without major modifications, in any other      │
  44.      '│  program.                                                 │
  45.      '│                                                           │
  46.      '│  I'm not going to document this package much because you  │
  47.      '│  should get in there and figure it out for yourself if    │
  48.      '│  you expect to learn anything.                            │
  49.      '│                                                           │
  50.      '│      F1  -  Sends a Xmodem file                           │
  51.      '│      F2  -  Receives a Xmodem File                        │
  52.      '│      F3  -  Exits                                         │
  53.      '│                                                           │
  54.      '└───────────────────────────────────────────────────────────┘
  55.  
  56.  
  57.      '═════════════════════════════════════════════════════════════
  58.  
  59.  
  60. On key(1) gosub f1pressed
  61. On key(2) gosub f2pressed
  62. On key(3) gosub f3pressed
  63.  
  64. True%  = 0=0
  65. False% = not True%
  66. DevelSwitch% = False%
  67.  
  68. ComFileNum%  = 1
  69. ComNum%      = 1
  70. ComSettings$ = "1200,N,8,1"
  71. Call initcomm
  72.  
  73. Gosub KeysOn
  74.  
  75. do
  76.   Call ReceiveChar(60,ch$,TooLong%)
  77.   if TooLong% Then
  78.     if instat then
  79.       k$ = Inkey$
  80.       Call SendChar(k$)
  81.     Else
  82.       k$ = inkey$
  83.     End if
  84.   Else
  85.     Call Echo(ch$)
  86.   end if
  87. loop
  88.  
  89. stop
  90.  
  91. KeysOff:
  92.   Key(1) off
  93.   Key(2) off
  94.   Key(3) off
  95.   Return
  96.  
  97. KeysOn:
  98.   Key(1) on
  99.   Key(2) on
  100.   Key(3) on
  101.   Return
  102.  
  103. f1Pressed:
  104.   Gosub KeysOff
  105.   Line Input "File to send: ";SF$
  106.   If Sf$ = "" or Ucase$(Sf$)="STOP" Then Return
  107.   Call xmodemsend(SF$,2,x%)
  108.   if x% = true then
  109.     Print "SUCCESS!!!!!"
  110.   else
  111.     Print "Failed."
  112.   End if
  113.   Gosub KeysOn
  114.   Return
  115.  
  116. f2pressed:
  117.   Gosub KeysOff
  118.   Line Input "File to receive: ";RF$
  119.   If Rf$ = "" or Ucase$(rf$)="STOP" Then Return
  120.   Call xmodemReceive(RF$,2,x%)
  121.   If x% = True% then
  122.     Print "SUCCESS!!!!!"
  123.   Else
  124.     Print "Failed."
  125.   End if
  126.   Gosub KeysOn
  127.   return
  128.  
  129. f3pressed:
  130.   close
  131.   stop
  132.  
  133.  
  134.  
  135. $include "CHKCRC.INL"
  136.  
  137. Sub XmodemSend(Filename$,Filenum%,Success%)
  138.   Shared True%,False%
  139.  
  140.   CRCRecieve% = False%
  141.   Success%    = False%
  142.   FirstOK%    = False%
  143.   NAK$        = Chr$(5)
  144.   ACK$        = Chr$(6)
  145.   SOH$        = Chr$(1)
  146.   EOT$        = Chr$(4)
  147.   CAN$        = Chr$(24)
  148.   CPM$        = Chr$(26)
  149.  
  150.   Print "Attempting Xmodem send. Press <ESC> to abort."
  151.  
  152.   Open FileName$ for binary as # filenum%
  153.   CurBlock% = 1
  154.   LstBlock% = (Lof(Filenum%) +127) \ 128
  155.  
  156. XmodemSendCRCTest:
  157.   Do
  158.     Call ReceiveChar(60,ch$,TooLong%)
  159.     If ch$ = "C" then CRCReceive% = True%
  160.   Loop Until ch$="C" or ch$=NAK$ or TooLong%
  161.  
  162.   If Instat Then
  163.     K$ = Inkey$
  164.     If K$ = chr$(27) then AbortXmodemSend Else XmodemSendCRCTest
  165.   End if
  166.  
  167.   If TooLong% Then XmodemSendExit
  168.  
  169.   Do until CurBlock% > LstBlock%
  170.     Seek FileNum%, (CurBlock%-1)*128
  171.     Get$ FileNum%, 128, Dta$
  172.     If Len(Dta$) < 128 Then Dta$=Left$(Dta$+String$(128,CPM$),128)
  173.     Call ChkCRC(Dta$, ChkSum%, CRC%, CRC.Hi%, CRC.Low%)
  174.     Dta$ = SOH$ + Chr$(CurBlock% and 255) + Chr$(255-(CurBlock% and 255)) +Dta$
  175.     If CRCReceive% Then
  176.       Dta$ = Dta$ + Chr$(CRC.Hi%) + Chr$(CRC.Low%)
  177.     Else
  178.       Dta$ = Dta$ + Chr$(ChkSum%)
  179.     End if
  180.  
  181.     Retransmit% = 0
  182.     Do
  183.       Call SendString(Dta$)
  184.       Incr Retransmit%
  185.       Call ReceiveChar(60,ch$,TooLong%)
  186.       If Instat Then
  187.         K$ = Inkey$
  188.         If K$ = chr$(27) then ch$ = CAN$
  189.       End if
  190.       If ch$ = "C" and FirstOK% = False% Then
  191.         CRCReceive% = True%
  192.         Dta$ = Left$(Dta$,131) + CHr$(CRC.Hi%) + Chr$(CRC.Low%)
  193.         TooLong% = True%
  194.       End if
  195.     Loop Until ch$ = ACK$ or Retransmit% > 10% or ch$ = CAN$
  196.  
  197.     If Retransmit% > 10% Then
  198.       ch$ = CAN$
  199.     Else
  200.       FirstOk% = True%
  201.       Incr CurBlock%
  202.     End if
  203.  
  204.   Loop Until ch$ = CAN$
  205.  
  206.   If ch$ = CAN$ then AbortXmodemSend
  207.  
  208.   Retransmit% = 0
  209.   Do
  210.     Incr Retransmit%
  211.     Call SendChar(EOT$)
  212.     Call ReceiveChar(10,ch$,TooLong%)
  213.     If Instat Then
  214.       k$ = inkey$
  215.       if k$ = chr$(27) Then ch$ = CAN$
  216.     End if
  217.   Loop Until ch$ = ACK$ or ch$ = CAN$ or Retransmit% > 10
  218.  
  219.   If ch$ = ACK$ Then
  220.     Call SendChar(ACK$)
  221.     Success% = True%
  222.     Goto XmodemSendExit
  223.   End if
  224.  
  225. AbortXmodemSend:
  226.   Call SendString(String$(5,CAN$)+String$(5,8))
  227.  
  228. XmodemSendExit:
  229.   Close Filenum%
  230.  
  231. End Sub 'XmodemSend
  232.  
  233.  
  234.  
  235. Sub XmodemReceive(Filename$,Filenum%,Success%)
  236.   Shared True%,False%
  237.  
  238.   CRCSend%    = 99
  239.   Success%    = False%
  240.   FirstOK%    = False%
  241.   BlockHi%    = 0
  242.   PrevBlock%  = 0
  243.   NAK$        = "C"
  244.   ACK$        = Chr$(6)
  245.   SOH$        = Chr$(1)
  246.   EOT$        = Chr$(4)
  247.   CAN$        = Chr$(24)
  248.   CPM$        = Chr$(26)
  249.  
  250.   Print "Attemting Xmodem receive. Press <ESC> to abort."
  251.  
  252.   Open FileName$ for binary as # filenum%
  253.  
  254.   Call SendChar(nak$)
  255.  
  256.   Do
  257.     Retries% = 0
  258.     Do
  259.       Incr Retries%
  260.       R$ = ""
  261.       x% = 10
  262.       Do
  263.         Call ReceiveChar(x%,ch$,TooLong%)
  264.         If Instat Then
  265.           k$ = Inkey$
  266.           If k$ = chr$(27) then R$ = CAN$
  267.         End if
  268.         If not TooLong% Then r$ = r$ + ch$
  269.         x% = 1
  270.       Loop Until TooLong%
  271.       If FirstOk% = False% Then
  272.         If Len(r$) = 132 then CRCSend% = False%
  273.         If Len(r$) = 133 then CRCSend% = True%
  274.       End if
  275.       Ok% = False%
  276.       Start$ = Left$(r$,1)
  277.       If Len(R$)<132 Then NotOK
  278.       Block% = Asc(Mid$(r$,2,1))
  279.       BlkCk% = 255 - Asc(Mid$(r$,3,1))
  280.       Dta$   = Mid$(r$,4,128)
  281.       Chk$   = Mid$(r$,132,3)
  282.       If Start$ <> SOH$ then NotOK
  283.       If Len(dta$) <> 128 Then NotOK
  284.       If Block% <> BlkCk% Then NotOK
  285.       Call ChkCRC(Dta$, ChkSum%, CRC%, CRC.Hi%, CRC.Low%)
  286.       If CRCSend% Then
  287.         If chk$ <> Chr$(CRC.Hi%)+Chr$(CRC.Low%) Then NotOk
  288.       Else
  289.         If Chk$ <> Chr$(ChkSum%) Then NotOK
  290.       End if
  291.       Ok% = True%
  292. NotOk:
  293.       If Not ok% Then Call SendChar(NAK$)
  294.     Loop Until Ok% or Retries% > 10 or Start$ = CAN$ or Start$ = EOT$
  295.  
  296.     If Start$ = SOH$ and Ok% Then
  297.       Print "Save Block ";Block%
  298.       If Block% = 0 And PrevBlock% = 255 Then Incr BlockHi%
  299.       Seek FileNum%, ( (Block%+ BlockHi%*256)-1 ) * 128
  300.       Put$ FileNum%, Dta$
  301.       PrevBlock% = Block%
  302.       FirstOk% = True%
  303.       NAK$ = Chr$(5)
  304.       Call SendChar(ACK$)
  305.     End if
  306.  
  307.   Loop Until Start$ = CAN$ or Start$ = EOT$ or Retries% > 10
  308.  
  309.   If Start$ <> EOT$ Then XmodemReceiveAbort
  310.  
  311.   Retries% = 0
  312.   Do
  313.     Incr Retries%
  314.     Call SendChar$(ACK$)
  315.     Call ReceiveChar(10,ch$,TooLong%)
  316.     If Instat then
  317.       k$ = inkey$
  318.       if k$ = Chr$(27) then ch$=CAN$
  319.     End if
  320.   Loop Until ch$ <> EOT$ or Retries% > 10
  321.  
  322.   If Retries% < 11 and ch$ <> can$ then
  323.     Success% = True%
  324.     Goto XmodemReceiveExit
  325.   End if
  326.  
  327. XmodemReceiveAbort:
  328.   Call SendString(String$(5,CAN$)+String$(5,8))
  329.  
  330. XmodemReceiveExit:
  331.   Close Filenum%
  332.   if success% = false% then kill filename$
  333.  
  334. End Sub 'XmodemReceive
  335.  
  336.  
  337. Sub BS
  338.   If Pos(0)>1 then
  339.     Locate ,Pos(0)-1,1
  340.     Print " ";
  341.     Locate ,Pos(0)-1,1
  342.   end if
  343.  
  344. End Sub 'Bs
  345.  
  346.  
  347. Sub Echo(ch$)
  348.  
  349. EchoAgain:
  350.  
  351.   Select Case Asc(Ch$)
  352.   Case 8
  353.     Call Bs
  354.   Case 13
  355.     Print
  356.   Case 0 to 31
  357.     Exit select
  358.   Case 128 to 255
  359.     ch$ = chr$(asc(ch$)-128)
  360.     Goto EchoAgain
  361.   Case Else
  362.     Print Ch$;
  363.   End Select
  364.  
  365. End Sub
  366.  
  367.  
  368. Sub SendChar(c$)
  369.   shared DevelSwitch%,ComFileNum%
  370.  
  371.   if DevelSwitch% then print "{";c$;"}";
  372.   Print #ComFileNum%,C$;
  373.  
  374. End Sub 'SendChar
  375.  
  376.  
  377. Sub SendString(s$)
  378.   Local I%
  379.  
  380.   For I% = 1 to Len(s$)
  381.     Delay .1
  382.     Call SendChar(Mid$(s$,I%,1))
  383.   Next I%
  384.  
  385. End Sub 'SendString
  386.  
  387.  
  388. Sub ReceiveChar(TimeLimit%,NextChar$,TooLong%)
  389.   Shared True%,False%,ComFileNum%
  390.   Local Tstart!,a$
  391.  
  392.   TooLong%=True%
  393.   NextChar$=Chr$(0)
  394.   Tstart!=Timer
  395.  
  396. 11111
  397.   On Error Goto 0
  398.  
  399.   While Eof(ComFileNum%) and Timer-Tstart! =< TimeLimit%
  400.     If Instat then Exit Sub
  401.     Wend
  402.  
  403.   If Not Eof(ComFileNum%) then
  404.     On Error Goto 22222
  405.     NextChar$=Input$(1,#ComFileNum%)
  406.     TooLong%=False%
  407.     End if
  408.  
  409.   On Error Goto 0
  410.   Exit Sub
  411.  
  412. 22222
  413.   Call InitComm
  414.   If DevelSwitch% then ?"***Comm error***"
  415.   resume 11111
  416.  
  417. End Sub 'ReceiveChar
  418.  
  419.  
  420. Sub InitComm
  421.   Shared ComNum%,ComSettings$,ComFileNum%
  422.  
  423.   Close ComFileNum%
  424.   Open "COM"+Chr$(ComNum%+48)+":"+ComSettings$ as ComFileNum%
  425.  
  426. End Sub
  427.  
  428.