home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QB_IPX_1.ZIP / IPXR.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-08-03  |  7.2 KB  |  286 lines
  1. '--------------------------------------------------------------------'
  2. '             IPX Send And Receive in QuickBASIC 4.0                 '
  3. '                          By David Rice                             '
  4. '--------------------------------------------------------------------'
  5. '
  6. DECLARE SUB SocketListen ()
  7. DECLARE SUB CloseSocket (Socket%)
  8. DECLARE SUB SendPacket (CompleteCode%, InUseFlag%)
  9. DECLARE SUB OpenSocket (Socket%, Status%, SocketNumberReturned%)
  10. DECLARE SUB GetMyAddress (MyNetwork$, MyNode$, MyNetworkHex$, MyNodeHex$)
  11. DECLARE FUNCTION SplitWordLo% (TheWord%)
  12. DECLARE FUNCTION SplitWordHi% (TheWord%)
  13. DECLARE FUNCTION IPXInstalled% ()
  14. DECLARE FUNCTION TurnToHex$ (Variable$)
  15. DEFINT A-Z
  16. '
  17. '           Choose the socket number to use. You MUST pick one
  18. '        that no other program is using! Call Novell to see which
  19. '        socket you may use.
  20. '
  21. CONST Socket = &H5555
  22. CLS
  23. '
  24. '           Define the DOS Interrupt registers.
  25. '
  26. TYPE RegTypeX
  27.     AX    AS INTEGER
  28.     BX    AS INTEGER
  29.     CX    AS INTEGER
  30.     DX    AS INTEGER
  31.     BP    AS INTEGER
  32.     SI    AS INTEGER
  33.     DI    AS INTEGER
  34.     FLAGS AS INTEGER
  35.     DS    AS INTEGER
  36.     ES    AS INTEGER
  37. END TYPE
  38. '                                         
  39. '              This is the Event Control Block Structure.
  40. '
  41. TYPE ECBStructure
  42.     LinkAddressOff AS INTEGER
  43.     LinkAddressSeg AS INTEGER
  44.     ESRAddressOff  AS INTEGER
  45.     ESRAddressSeg  AS INTEGER
  46.     InUse       AS STRING * 1
  47.     CompCode    AS STRING * 1
  48.     SockNum     AS INTEGER
  49.     IPXWorkSpc  AS SINGLE
  50.     DrvWorkSpc  AS STRING * 12
  51.     ImmAdd      AS STRING * 6
  52.     FragCount   AS INTEGER
  53.     FragAddOfs  AS INTEGER
  54.     FragAddSeg  AS INTEGER
  55.     FragSize    AS INTEGER
  56. END TYPE
  57. '
  58. '              This is the IPX Packet Structure.
  59. '
  60. TYPE IPXHeader
  61.     Checksum    AS INTEGER
  62.     Length      AS INTEGER
  63.     Control     AS STRING * 1
  64.     PacketType  AS STRING * 1
  65.     DestNet     AS STRING * 4
  66.     DestNode    AS STRING * 6
  67.     DestSocket  AS STRING * 2
  68.     SourNet     AS STRING * 4
  69.     SourNode    AS STRING * 6
  70.     SourSock    AS STRING * 2
  71.     'Sequence    AS SINGLE
  72.     DataGram    AS STRING * 546
  73.     'DataGram    AS STRING * 542
  74. END TYPE
  75. '
  76. TYPE FullNetAddress
  77.     Network     AS STRING * 4
  78.     Node        AS STRING * 6
  79. END TYPE
  80. '
  81. '              Define the Send and Receive buffers.
  82. '
  83. DIM SHARED IPXS AS IPXHeader, IPXR AS IPXHeader
  84. DIM SHARED ECBS AS ECBStructure, ECBR AS ECBStructure
  85. DIM SHARED InReg AS RegTypeX, OutReg AS RegTypeX
  86. DIM SHARED GetMyAdd AS FullNetAddress
  87. '
  88. IF IPXInstalled = 0 THEN
  89.     PRINT "IPX.COM is not installed."
  90.     END
  91. END IF
  92. '
  93. ECBR.LinkAddressOff = 0
  94. ECBR.LinkAddressSeg = 0
  95. ECBR.ESRAddressOff = 0
  96. ECBR.ESRAddressSeg = 0
  97. ECBR.SockNum = Socket
  98. ECBR.FragCount = &H1
  99. ECBR.FragAddOfs = VARPTR(IPXR)
  100. ECBR.FragAddSeg = VARSEG(IPXR)
  101. ECBR.FragSize = LEN(IPXR)
  102. '
  103. '
  104. CALL GetMyAddress(MyNetwork$, MyNode$, MyNetworkHex$, MyNodeHex$)
  105. '
  106. PRINT "My network address is: "; MyNetworkHex$, MyNodeHex$
  107. '              Open the socket number HEX(5555)
  108. '
  109. CALL OpenSocket(Socket, Status, SocketNumberReturned)
  110. '
  111. '              Ask IPX.COM to listen for a packet.
  112. '
  113. CALL SocketListen
  114. '
  115. '              Wait for the packet to arrive.
  116. '
  117. PRINT "Listening. Hit Any Key To Stop."
  118. PRINT
  119. DO
  120.     CompleteCode = ASC(ECBR.CompCode)
  121.     InUseFlag = ASC(ECBR.InUse)
  122.     IF INKEY$ <> "" THEN EXIT DO
  123. LOOP UNTIL InUseFlag = 0
  124. '
  125. SNet$ = TurnToHex$(IPXR.SourNet)
  126. SNode$ = TurnToHex$(IPXR.SourNode)
  127. SSoc$ = TurnToHex$(IPXR.SourSock)
  128. '
  129. PRINT "Complete Code: "; HEX$(CompleteCode)
  130. PRINT "In Use Flag: "; HEX$(InUseFlag)
  131. PRINT "Source Network: "; SNet$
  132. PRINT "Source Node: "; SNode$
  133. PRINT "Source Socket: "; SSoc$
  134. PRINT "Data: "; IPXR.DataGram
  135. '
  136. '           Now send a confirmation packet.
  137. '
  138. IPXS.Checksum = 0
  139. IPXS.Length = LEN(IPXS)
  140. IPXS.Control = CHR$(0)
  141. IPXS.PacketType = CHR$(0)
  142. IPXS.DestNet = IPXR.SourNet
  143. IPXS.DestNode = IPXR.SourNode
  144. IPXS.DestSocket = MKI$(Socket)
  145. IPXS.SourSock = MKI$(&H740)
  146. IPXS.DataGram = "Hello there Back At You!"
  147. '
  148. ECBS.LinkAddressOff = 0
  149. ECBS.LinkAddressSeg = 0
  150. ECBS.ESRAddressOff = 0
  151. ECBS.ESRAddressSeg = 0
  152. ECBS.SockNum = Socket
  153. ECBS.ImmAdd = STRING$(6, &HFF)
  154. ECBS.FragCount = &H1
  155. ECBS.FragAddOfs = VARPTR(IPXS)
  156. ECBS.FragAddSeg = VARSEG(IPXS)
  157. ECBS.FragSize = LEN(IPXS)
  158. '
  159. CALL SendPacket(CompleteCode, InUseFlag)
  160. PRINT "Complete Code: "; HEX$(CompleteCode); " In Use Flag: "; HEX$(InUseFlag)
  161. '
  162. CALL CloseSocket(Socket)
  163.  
  164. SUB CloseSocket (Socket%)
  165.     InReg.BX = 1
  166.     InReg.AX = 0
  167.     InReg.DX = Socket
  168.     CALL InterruptX(&H7A, InReg, OutReg)
  169. END SUB
  170.  
  171. SUB GetMyAddress (MyNetwork$, MyNode$, MyNetworkHex$, MyNodeHex$)
  172.     InReg.BX = 9
  173.     InReg.ES = VARSEG(GetMyAdd)
  174.     InReg.SI = VARPTR(GetMyAdd)
  175.     CALL InterruptX(&H7A, InReg, OutReg)
  176.     MyNetwork$ = GetMyAdd.Network
  177.     MyNode$ = GetMyAdd.Node
  178.     MyNetworkHex$ = TurnToHex$(MyNetwork$)
  179.     MyNodeHex$ = TurnToHex$(MyNode$)
  180. END SUB
  181.  
  182. SUB IPXCancel (CompleteCode%)
  183.     InReg.BX = 6
  184.     InReg.ES = VARSEG(ECBS)
  185.     InReg.SI = VARPTR(ECBS)
  186.     CALL InterruptX(&H7A, InReg, OutReg)
  187.     CompleteCode = SplitWordLo%(OutReg.AX)
  188. END SUB
  189.  
  190. FUNCTION IPXInstalled%
  191. InReg.AX = &H7A00
  192.     CALL InterruptX(&H2F, InReg, OutReg)
  193.     AL = SplitWordLo(OutReg.AX)
  194.     IF AL = &HFF THEN IPXInstalled = 1 ELSE IPXInstalled = 0
  195. END FUNCTION
  196.  
  197. SUB IPXMarker (Interval%)
  198.     InReg.BX = 8
  199.     CALL InterruptX(&H7A, InReg, OutReg)
  200.     Interval = OutReg.AX
  201. END SUB
  202.  
  203. SUB IPXSchedule (DelayTicks%)
  204.     InReg.AX = DelayTicks%
  205.     InReg.BX = 5
  206.     InReg.ES = VARSEG(ECBS)
  207.     InReg.SI = VARPTR(ECBS)
  208.     CALL InterruptX(&H7A, InReg, OutReg)
  209.     CompleteCode = ASC(ECBS.CompCode)
  210.     InUseFlag = ASC(ECBS.InUse)
  211. END SUB
  212.  
  213. SUB OpenSocket (Socket%, Status%, SocketNumberReturned%)
  214.     InReg.BX = 0
  215.     InReg.AX = 0
  216.     InReg.DX = Socket
  217.     CALL InterruptX(&H7A, InReg, OutReg)
  218.     Status = SplitWordLo(OutReg.AX)
  219.     SocketNumberReturned = OutReg.DX
  220.     '
  221.     '           Completion status
  222.     '                    00 successful
  223.     '                    FF open already
  224.     '                    FE socket table is full
  225. END SUB
  226.  
  227. SUB RelenquishControl
  228.     DEFINT A-Z
  229.     InReg.AX = 0
  230.     InReg.BX = &HA
  231.     CALL InterruptX(&H7A, InReg, OutReg)
  232. END SUB
  233.  
  234. SUB SendPacket (CompleteCode%, InUseFlag%)
  235.     InReg.BX = 3
  236.     InReg.ES = VARSEG(ECBS)
  237.     InReg.SI = VARPTR(ECBS)
  238.     CALL InterruptX(&H7A, InReg, OutReg)
  239.     CompleteCode = ASC(ECBS.CompCode)
  240.     InUseFlag = ASC(ECBS.InUse)
  241.     '
  242.     '        Error codes:
  243.     '              00    sent
  244.     '              FC    canceled
  245.     '              FD    malformed packet
  246.     '              FE    no listener (undelivered)
  247.     '              FF    hardware failure
  248. END SUB
  249.  
  250. SUB SocketListen
  251.     InReg.BX = 4
  252.     InReg.ES = VARSEG(ECBR)
  253.     InReg.SI = VARPTR(ECBR)
  254.     CALL InterruptX(&H7A, InReg, OutReg)
  255.     CompleteCode = ASC(ECBR.CompCode)
  256.     InUseFlag = ASC(ECBR.InUse)
  257.     '
  258.     '        Completion codes:
  259.     '              00    received
  260.     '              FC    canceled
  261.     '              FD    packet overflow
  262.     '              FF    socket was closed
  263. END SUB
  264.  
  265. FUNCTION SplitWordHi (TheWord%)
  266.     SplitWordHi = (TheWord% AND &HFF00) / 256
  267. END FUNCTION
  268.  
  269. FUNCTION SplitWordLo (TheWord%)
  270.     SplitWordLo = (TheWord% AND &HFF)
  271. END FUNCTION
  272.  
  273. FUNCTION TurnToHex$ (Variable$)
  274.     Temp$ = ""
  275.     FOR Byte = 1 TO LEN(Variable$)
  276.         Value! = ASC(MID$(Variable$, Byte, 1))
  277.         IF Value! < 15 THEN
  278.             Temp$ = Temp$ + "0" + HEX$(Value!)
  279.         ELSE
  280.             Temp$ = Temp$ + HEX$(Value!)
  281.         END IF
  282.     NEXT
  283.     TurnToHex$ = Temp$
  284. END FUNCTION
  285.  
  286.