home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / bas / pcl4b42 / xypacket.bas < prev    next >
BASIC Source File  |  1994-09-03  |  8KB  |  310 lines
  1. ' -- XYPACKET.BAS --
  2. '
  3. ' This program is donated to the Public
  4. ' Domain by MarshallSoft Computing, Inc.
  5. ' It is provided as an example of the use
  6. ' of the Personal Communications Library.
  7. '
  8. ' LONG (4-byte) variables are used for checksums
  9. ' because Visual Basic doesn't support unsigned
  10. ' integers. The string Buffer$ is used because
  11. '
  12. '
  13.  
  14. DEFINT A-Z
  15.  
  16. '$INCLUDE: 'DEFINES.BI'
  17. '$INCLUDE: 'TIMING.BI'
  18. '$INCLUDE: 'PCL4B.BI'
  19. '$INCLUDE: 'TERM_IO.BI'
  20. '$INCLUDE: 'CRC.BI'
  21. '$INCLUDE: 'XYPACKET.BI'
  22.  
  23. DECLARE FUNCTION HIGH (BYVAL Word)
  24.  
  25. CONST xyBufferSize = 1024
  26. CONST MAXTRY = 3, LIMIT = 20
  27. CONST SOH = 1, STX = 2, EOT = 4
  28. CONST ACK = 6, NAK = 21, CAN = 24
  29. CONST FALSE = 0, TRUE = NOT FALSE
  30.  
  31. FUNCTION RxPacket (BYVAL Port, BYVAL PacketNbr, Buffer$, PacketSize, BYVAL NCGbyte, EOTflag)
  32.   'Port      : Port # [0..3)
  33.   'PacketNbr : Packet # [0,1,2,...)
  34.   'PacketSize: Packet size [128,1024) {returned}
  35.   'NCGbyte   : NAK, "C", or "G"
  36.   'EOTflag   : EOT was received       {returned}
  37.   '
  38.   PacketNbr = PacketNbr AND 255
  39.   FOR Attempt = 1 TO MAXTRY
  40.     'wait FOR SOH / STX
  41.     Code = SioGetc(Port, LONG_WAIT * ONE_SECOND)
  42.     IF Code = -1 THEN
  43.       PRINT "Timed out waiting FOR sender"
  44.       RxPacket = FALSE
  45.       EXIT FUNCTION
  46.     END IF
  47.     SELECT CASE Code
  48.       CASE SOH
  49.         '128 byte buffer incoming
  50.         PacketType = SOH
  51.         PacketSize = 128
  52.       CASE STX
  53.         '1024 byte buffer incoming
  54.         PacketType = STX
  55.         PacketSize = 1024
  56.       CASE EOT
  57.         'all packets have been sent
  58.         Code = SioPutc(Port, ACK)
  59.         EOTflag = TRUE
  60.         RxPacket = TRUE
  61.         EXIT FUNCTION
  62.       CASE CAN
  63.         'sender has canceled !
  64.         PRINT "Canceled by remote"
  65.         RxPacket = FALSE
  66.       CASE ELSE
  67.         'error !
  68.         PRINT "Expecting SOH/STX/EOT/CAN not "; Code
  69.         RxPacket = FALSE
  70.     END SELECT
  71.     'receive packet #
  72.     Code = SioGetc(Port, ONE_SECOND)
  73.     IF Code = -1 THEN
  74.       PRINT "Timed out waiting for packet #"
  75.       EXIT FUNCTION
  76.     END IF
  77.     RxPacketNbr = Code AND 255
  78.     'receive 1's complement
  79.     Code = SioGetc(Port, ONE_SECOND)
  80.     IF Code = -1 THEN
  81.       PRINT "Timed out waiting for complement of packet #"
  82.       RxPacket = FALSE
  83.       EXIT FUNCTION
  84.     END IF
  85.     RxPacketNbrC = Code AND 255
  86.     'receive data
  87.     CheckSum& = 0
  88.     Buffer$ = ""
  89.     Buffer$ = STRING$(PacketSize, 0)
  90.     FOR I = 1 TO PacketSize
  91.       Code = SioGetc(Port, ONE_SECOND)
  92.       IF Code = -1 THEN
  93.         PRINT "Timed out waiting for data for packet #"
  94.         RxPacket = FALSE
  95.         EXIT FUNCTION
  96.       END IF
  97.       MID$(Buffer$, I, 1) = CHR$(Code)
  98.       'compute CRC or checksum
  99.       IF NCGbyte <> NAK THEN
  100.         CheckSum& = UpdateCRC&(CheckSum&, Code)
  101.       ELSE
  102.         CheckSum& = (CheckSum& + Code) AND 255
  103.       END IF
  104.     NEXT I
  105.     'receive CRC/checksum
  106.     IF NCGbyte <> NAK THEN
  107.       'receive 2 byte CRC
  108.       Code = SioGetc(Port, ONE_SECOND)
  109.       IF Code = -1 THEN
  110.         PRINT "Timed out waiting for 1st CRC byte"
  111.         EXIT FUNCTION
  112.       END IF
  113.       RxCheckSum1& = Code AND 255
  114.       Code = SioGetc(Port, ONE_SECOND)
  115.       IF Code = -1 THEN
  116.         PRINT "Timed out waiting for 2nd CRC byte"
  117.         RxPacket = FALSE
  118.         EXIT FUNCTION
  119.       END IF
  120.       RxCheckSum2& = Code AND 255
  121.       RxCheckSum& = (256 * RxCheckSum1&) OR RxCheckSum2&
  122.     ELSE
  123.       'receive one byte checksum
  124.       Code = SioGetc(Port, ONE_SECOND)
  125.       IF Code = -1 THEN
  126.         PRINT "Timed out waiting for checksum"
  127.         RxPacket = FALSE
  128.         EXIT FUNCTION
  129.       END IF
  130.       RxCheckSum& = Code AND 255
  131.     END IF
  132.     'don't send ACK IF "G"
  133.     IF NCGbyte = ASC("G") THEN
  134.       RxPacket = TRUE
  135.       EXIT FUNCTION
  136.     END IF
  137.     'packet # and checksum OK ?
  138.     IF (RxCheckSum& = CheckSum&) AND (RxPacketNbr = PacketNbr) THEN
  139.       'ACK the packet
  140.       Code = SioPutc(Port, ACK)
  141.       RxPacket = TRUE
  142.       EXIT FUNCTION
  143.     END IF
  144.     'bad packet
  145.     IF RxCheckSum& = CheckSum& THEN
  146.       PRINT "Bad Packet. Received "; RxPacketNbr; ", expected "; PacketNbr
  147.     ELSE
  148.       PRINT "Bad Checksum. Received "; RxCheckSum&; ", expected "; CheckSum&
  149.     END IF
  150.     Code = SioPutc(Port, NAK)
  151.   NEXT Attempt
  152.   'can't receive packet
  153.   PRINT "RX packet timeout"
  154.   RxPacket = FALSE
  155. END FUNCTION
  156.  
  157. FUNCTION RxStartup (BYVAL Port, BYVAL NCGbyte)
  158.   'clear Rx buffer
  159.   Code = SioRxFlush(Port)
  160.   'Send NAKs or "C"s
  161.   FOR I = 1 TO LIMIT
  162.     AnyKey$ = INKEY$
  163.     IF AnyKey$ <> "" THEN
  164.       PRINT "Canceled by user"
  165.       RxStartup = FALSE
  166.       EXIT FUNCTION
  167.     END IF
  168.     'stop attempting CRC after 1st 4 tries
  169.     IF (NCGbyte <> NAK) AND (I = 5) THEN NCGbyte = NAK
  170.     'tell sender that I am ready to receive
  171.     Code = SioPutc(Port, NCGbyte)
  172.     Byte = SioGetc(Port, SHORT_WAIT * ONE_SECOND)
  173.     IF Byte <> -1 THEN
  174.       'no error -- must be incoming byte -- push byte back onto queue !
  175.       Code = SioUnGetc(Port, Byte)
  176.       RxStartup = TRUE
  177.       EXIT FUNCTION
  178.     END IF
  179.   NEXT I
  180.   'no response
  181.   PRINT "No response from sender"
  182.   RxStartup = FALSE
  183. END FUNCTION
  184.  
  185. FUNCTION TxEOT (BYVAL Port)
  186.   FOR I = 0 TO 10
  187.     Code = SioPutc(Port, EOT)
  188.     'await response
  189.     Code = SioGetc(Port, SHORT_WAIT * ONE_SECOND)
  190.     IF Code = ACK THEN
  191.       TxEOT = TRUE
  192.       EXIT FUNCTION
  193.     END IF
  194.   NEXT I
  195.   TxEOT = FALSE
  196.   END FUNCTION
  197.  
  198. FUNCTION TxPacket (BYVAL Port, BYVAL PacketNbr, Buffer$, BYVAL PacketSize, BYVAL NCGbyte)
  199.   'Port      : Port # [0..3)
  200.   'PacketNbr : Packet # [0,1,2,...)
  201.   'PacketSize: Packet size [128,1024)
  202.   'NCGbyte   : NAK, "C", or "G"
  203.   '
  204.   'better be 128 or 1024 packet length
  205.  
  206. '''PRINT "TxP: Port=";Port;"Packet#=";PacketNbr;"LEN=";LEN(Buffer$);"PacketSize=";PacketSize;",NCGbyte=";CHR$(NCGbyte)
  207.  
  208.   IF PacketSize = 1024 THEN
  209.     PacketType = STX
  210.   ELSE
  211.     PacketType = SOH
  212.   END IF
  213.   PacketNbr = PacketNbr AND 255
  214.   'make up to MAXTRY attempts to send this packet
  215.   FOR Attempt = 1 TO MAXTRY
  216.     'send SOH/STX
  217.     Code = SioPutc(Port, PacketType)
  218.     'send packet #
  219.     Code = SioPutc(Port, PacketNbr)
  220.     'send 1's complement of packet
  221.     Code = SioPutc(Port, 255 - PacketNbr)
  222.     'send data
  223.     CheckSum& = 0
  224.     FOR I = 1 TO PacketSize
  225.       Byte = ASC(MID$(Buffer$, I, 1))
  226.       Code = SioPutc(Port, Byte)
  227.       'update checksum
  228.       IF NCGbyte <> NAK THEN
  229.         CheckSum& = UpdateCRC&(CheckSum&, Byte)
  230.       ELSE
  231.         CheckSum& = CheckSum& + Byte
  232.       END IF
  233.     NEXT I
  234.     'send checksum
  235.     IF NCGbyte <> NAK THEN
  236.       'send 2 byte CRC
  237.       CS = (CheckSum& \ 256)
  238.       Code = SioPutc(Port, CS)
  239.       CS = (CheckSum& AND 255)
  240.       Code = SioPutc(Port, CS)
  241.     ELSE
  242.       'send one byte checksum
  243.       CS = CheckSum&
  244.       Code = SioPutc(Port, CS)
  245.     END IF
  246.     'don't wait for ACK if "G"
  247.     IF NCGbyte = ASC("G") THEN
  248.       IF PacketNbr = 0 THEN Code = SioDelay(SHORT_WAIT * ONE_SECOND / 2)
  249.       TxPacket = TRUE
  250.       EXIT FUNCTION
  251.     END IF
  252.     'wait for receivers ACK
  253.     Code = SioGetc(Port, LONG_WAIT * ONE_SECOND)
  254.     IF Code = CAN THEN
  255.       PRINT "Canceled by remote"
  256.       TxPacket = FALSE
  257.       EXIT FUNCTION
  258.     END IF
  259.     IF Code = ACK THEN
  260.       TxPacket = TRUE
  261.       EXIT FUNCTION
  262.     END IF
  263.     IF Code <> NAK THEN
  264.       PRINT "Out of sync. Expect ACK or NAK, not"; Code
  265.       TxPacket = FALSE
  266.       EXIT FUNCTION
  267.     END IF
  268.   NEXT Attempt
  269.   'can't send packet !
  270.   PRINT 'Packet timeout for port ';Port
  271.   TxPacket = FALSE
  272. END FUNCTION
  273.  
  274. FUNCTION TxStartup (BYVAL Port, NCGbyte)
  275.   'clear Rx buffer
  276.   Code = SioRxFlush(Port)
  277.   'wait for receivers start up NAK or "C"
  278.   FOR I = 1 TO LIMIT
  279.     AnyKey$ = INKEY$
  280.     IF AnyKey$ <> "" THEN
  281.       PRINT "Aborted by user"
  282.       TxStartup = FALSE
  283.       EXIT FUNCTION
  284.     END IF
  285.     Code = SioGetc(Port, SHORT_WAIT * ONE_SECOND)
  286.     IF Code <> -1 THEN
  287.       'received a byte
  288.       IF Code = NAK THEN
  289.         NCGbyte = NAK
  290.         TxStartup = TRUE
  291.         EXIT FUNCTION
  292.       END IF
  293.       IF Code = ASC("C") THEN
  294.         NCGbyte = ASC("C")
  295.         TxStartup = TRUE
  296.         EXIT FUNCTION
  297.       END IF
  298.       IF Code = ASC("G") THEN
  299.         NCGbyte = ASC("G")
  300.         TxStartup = TRUE
  301.         EXIT FUNCTION
  302.       END IF
  303.     END IF
  304.   NEXT I
  305.   'no response
  306.   PRINT "no response from receiver"
  307.   TxStartup = FALSE
  308. END FUNCTION
  309.  
  310.