home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lan / basnet / pipes.bas < prev    next >
BASIC Source File  |  1987-04-21  |  10KB  |  253 lines
  1. 1  '       pipes
  2. 2  '
  3. 3  ' demonstates the creation of a communication
  4. 4  ' pipeline using NetWare Function E1h(04,05,06,07 and 08)
  5. 5  '
  6. 10   GOSUB 10000
  7. 100  CLS
  8. 110  PRINT "******************** MENU *******************"
  9. 120  PRINT " 1. Generate station list
  10. 130  PRINT " 2. Open pipe with station list
  11. 140  PRINT " 3. Send messages to station list
  12. 150  PRINT " 4. Retrieve message from pipe message queue
  13. 160  PRINT " 5. Check pipe status with station list
  14. 170  PRINT " 6. Close pipes with station list
  15. 172  PRINT
  16. 175  PRINT " 7. Send broadcast to station list
  17. 178  PRINT " 8. Set broadcast mode
  18. 180  PRINT "*********************************************"
  19. 190  PRINT
  20. 200  INPUT "Select: ",V$
  21. 210  IF V$ = "" THEN 9999
  22. 220  V% = VAL(V$)
  23. 230  ON V% GOTO 300,1000,2000,3000,4000,5000,6000,7000
  24. 240  GOTO 100
  25.  
  26. 300 '
  27. 310 ' GENERATE A STATION LIST TO OPEN PIPES TO
  28. 320 ' AND LOAD THE NUMSTATIONS$ PARAMETER
  29. 330  CLS
  30. 336  DEF SEG = LIBSEG
  31. 340  PRINT "LIST OF ACTIVE STATIONS
  32. 345  PRINT "Station #    UserName"
  33. 350  FOR I% = 1 TO 100
  34. 360    REQ$ = CHR$(2)+CHR$(0) + CHR$(22) + CHR$(I%)
  35. 365    REP$ = CHR$(62)+CHR$(0) + STRING$(62,0)
  36. 370    CALL SYSLOG(ERRCODE%,REQ$,REP$)
  37. 380    IF ASC(MID$(REP$,8,1)) = 1 THEN LOCATE ,5: PRINT USING "###";I%;: PRINT SPC(6)MID$(REP$,9,48)
  38. 390  NEXT I%
  39. 400  DEF SEG
  40. 530  PRINT "Enter the station number(s), one at a time, you wish "
  41. 540  PRINT "to establish communications with (just <enter> when done):"
  42. 550  STNCALL% = 1
  43. 554  STATIONLIST$ = ""
  44. 560  WHILE STNCALL% <> 0
  45. 562    INPUT; "=> ",TALKTO$: print " ";
  46. 564    STNCALL% = VAL(TALKTO$)
  47. 566    IF STNCALL% <> 0 THEN STATIONLIST$ = STATIONLIST$ + CHR$(STNCALL%)
  48. 568  WEND
  49. 570  NUMSTATIONS$ = CHR$(LEN(STATIONLIST$)): NUMSTN% = ASC(NUMSTATIONS$)
  50. 580  GOTO 100
  51.  
  52. 1000  ' OPEN A PIPE
  53. 1010  FUNCTION$ = CHR$(6)  ' function 6 - open pipe
  54. 1020  GOSUB 9000 ' make the request and reply buffers and the call
  55. 1050  IF ERRCODE% <> 0 THEN INPUT "Function incomplete <enter> ",V$: GOTO 100
  56. 1055  GOSUB 8000
  57. 1060  PRINT "(0 = pipe complete, 254 = one side complete, 255 = station not in use)
  58. 1070  INPUT " <enter> ",V$: GOTO 100
  59.  
  60. 2000 ' ROUTINE TO SEND A MESSAGE
  61. 2010 PRINT
  62. 2015 LINE INPUT;"Enter a message to send (max. 126 chars): "; MSG$
  63. 2020 IF MSG$ = "" THEN GOTO 100
  64. 2035 FUNC$ = CHR$(4)
  65. 2060 MESSAGELEN$ = CHR$(LEN(MSG$))
  66. 2070 REQUEST$ = FUNC$ + NUMSTATIONS$ + STATIONLIST$ + MESSAGELEN$ + MSG$
  67. 2075 REQUEST$ = CHR$(LEN(REQUEST$)) + CHR$(0) + REQUEST$
  68. 2080 REPLY$ = CHR$(101)+CHR$(0) + STRING$(101,0)
  69. 2090 DEF SEG = LIBSEG
  70. 2100 CALL PIPREQ(ERRCODE%, REQUEST$, REPLY$)
  71. 2110 DEF SEG
  72. 2115 PRINT
  73. 2120 IF ERRCODE% <> 0 THEN PRINT "<Unable to send message.>": GOTO 2010
  74. 2122 GOSUB 8000
  75. 2124 PRINT "(0 = Sent, 252 = Pipe full, 253 = invalid station, 255 = pipe not active)": GOTO 2010
  76.  
  77. 3000 ' GET A MESSAGE FROM THE PIPE QUEUE
  78. 3010 REQUEST$ = CHR$(1) + CHR$(0) + CHR$(5): MSGLNGTH% = 1
  79. 3015 DEF SEG = LIBSEG
  80. 3020 WHILE MSGLNGTH% <> 0
  81. 3030    REPLY$ = CHR$(130) + STRING$(131,0)
  82. 3040    CALL PIPREQ(ERRCODE%, REQUEST$, REPLY$)
  83. 3050    IF ERRCODE% <> 0 THEN PRINT "Error --> ",ERRCODE%
  84. 3060    STN% = ASC(MID$(REPLY$,3,1))
  85. 3065    MSGLNGTH% = ASC(MID$(REPLY$,4,1))
  86. 3070    MSG$ = MID$(REPLY$,5,MSGLNGTH%)
  87. 3080    IF MSGLNGTH% <> 0 THEN PRINT "from "STN%"- "MSG$
  88. 3090 WEND
  89. 3095 DEF SEG
  90. 3100 INPUT "No more messages. <enter> ",V$: GOTO 100
  91.  
  92. 4000 ' CHECK IF PIPES TO STATIONLIST ARE OPEN
  93. 4010 PRINT
  94. 4045 FUNCTION$ = CHR$(8)
  95. 4046 GOSUB 9000
  96. 4050 GOSUB 8000
  97. 4120 INPUT "(255 = pipe incomplete, 0 = pipe open at both ends) <enter>",V$: GOTO 100
  98.  
  99. 5000 'close the pipe and exit
  100. 5045 FUNCTION$ = CHR$(7)
  101. 5046 GOSUB 9000
  102. 5110 GOSUB 8000
  103. 5120 INPUT "(253 = Invalid station, 0 = Pipe closed) <enter>",V$: GOTO 100
  104.  
  105. 6000 ' SEND A BROADCAST TO STATIONLIST
  106. 6010 PRINT
  107. 6020 INPUT "Message to broadcast (max. 60 chars): ",MESSAGE$
  108. 6030 IF MESSAGE$ = "" THEN GOTO 100
  109. 6034 FUNC$ = CHR$(0)
  110. 6036 MESSAGELEN$ = CHR$(LEN(MESSAGE$))
  111. 6040 REQUEST$ = FUNC$ + NUMSTATIONS$ + STATIONLIST$ + MESSAGELEN$ + MESSAGE$
  112. 6050 REQUEST$ = CHR$(LEN(REQUEST$)) + CHR$(0) + REQUEST$
  113. 6060 REPLY$ = CHR$(101)+CHR$(0) + STRING$(101,0)
  114. 6070 DEF SEG = LIBSEG
  115. 6080 CALL PIPREQ(RETCODE%, REQUEST$, REPLY$)
  116. 6090 DEF SEG
  117. 6100 IF RETCODE% <> 0 THEN PRINT "Unable to send successfully.": goto 6000
  118. 6110 GOSUB 8000
  119. 6120 PRINT "(0 = logged for forwarding, 252 = broadcast queue in use, 255 = not logged) ": goto 6000
  120.  
  121. 7000 'SET BROADCAST MODE AND RETRIEVE MESSAGES SAVED
  122. 7010 PRINT: INPUT "'R'etreive a message, 'S'elect mode, or 'E'xit: ",BUF$
  123. 7011 IF ASC(BUF$) > 90 THEN BUF$ = CHR$(ASC(BUF$) - 32)
  124. 7013 IF BUF$ = "S" THEN GOTO 7200
  125. 7015 IF BUF$ <> "R" THEN GOTO 100
  126. 7030    REQUEST$ = CHR$(1) + CHR$(0) + CHR$(1)
  127. 7040    REPLY$ = CHR$(61) + CHR$(0) + STRING$(61,CHR$(0))
  128. 7050    DEF SEG = LIBSEG
  129. 7060    CALL PIPREQ(ERRCODE%, REQUEST$, REPLY$)
  130. 7070    DEF SEG
  131. 7080    IF MID$(REPLY$,3,1) = CHR$(0) THEN GOTO 7010
  132. 7082    PRINT "Message retrieved: "MID$(REPLY$,4,ASC(MID$(REPLY$,3,1)))
  133. 7090 GOTO 7010
  134. 7200 ' select broadcast mode
  135. 7220 PRINT: INPUT "Select broadcast receive mode:(0=all,1=console,2=none,3=store) ",MODE$
  136. 7230 MODE% = VAL(MODE$)
  137. 7250 DEF SEG = LIBSEG
  138. 7260 CALL BCSMODE(MODE%)
  139. 7270 DEF SEG
  140. 7280 PRINT "new mode is "mode%
  141. 7285 GOTO 7010
  142.  
  143. 8000 'PRINT OUT THE STATIONLIST AND STATUS
  144. 8015 PRINT "Stationlist: ";
  145. 8020 FOR I% = 1 TO NUMSTN%
  146. 8030    PRINT USING "### ";ASC(MID$(STATIONLIST$,I%,1));
  147. 8040 NEXT I%
  148. 8041 PRINT: PRINT "Status:      ";
  149. 8080 FOR I% = 1 TO NUMSTN%
  150. 8090    PRINT USING "### ";ASC(MID$(REPLY$,I%+3,1));
  151. 8100 NEXT I%
  152. 8110 PRINT
  153. 8120 RETURN
  154.  
  155. 9000 '
  156. 9010 ' make request buffer and reply buffer
  157. 9020 '
  158. 9030  REQUEST$ = FUNCTION$ + NUMSTATIONS$ + STATIONLIST$
  159. 9100  REQUEST$ = CHR$(LEN(REQUEST$)) + CHR$(0) + REQUEST$
  160. 9110  REPLY$ = CHR$(101)+CHR$(0) + STRING$(101,0)
  161. 9112  DEF SEG = LIBSEG
  162. 9114    CALL PIPREQ(ERRCODE%, REQUEST$, REPLY$)
  163. 9116  DEF SEG
  164. 9120  RETURN
  165.  
  166. 9999  SYSTEM
  167.  
  168. 10000 '
  169. 10010 ' routines for network use
  170. 10020 '
  171. 10100 '  This section contains the routine names and
  172. 10101 '  offsets for the BASNET library
  173. 10102 ' the return is after everything is set up for NetWare calls
  174. 10110 XTNDOPN  =   0   'xtndopn(Mode%, Filename$, Handle%, ErrCode%)
  175. 10111 SETATTR  =   3   'setattr(Func%, Filename$, Attribute%, ErrCode%)
  176. 10112 EOJSTAT  =   6   'eojstat(Flag%)
  177. 10113 PRLH.LOG =   9   'PRLH.Log(FileHandle%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
  178. 10114 PRLH.REL =  12   'PRLH.Rel(FileHandle%,HiByteOffset%,LoByteOffset%,ErrCode%)
  179. 10115 PRLH.CLR =  15   'PRLH.Clr(FileHandle%,HiByteOffset%,LoByteOffset%,Errcode%)
  180. 10116 PRLF.LOG =  18   'PRLF.Log(fcb%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
  181. 10117 PRLF.REL =  21   'PRLF.Rel(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
  182. 10118 PRLF.CLR =  24   'PRLF.Clr(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
  183. 10119 PRLS.LCK =  27   'PRLS.Lck(Flags%,TimeOut%,ErrCode%)
  184. 10120 PRLS.REL =  30   'PRLS.Rel(ErrCode%)
  185. 10121 PRLS.CLR =  33   'PRLS.Clr(ErrCode%)
  186. 10122 OPENSEM  =  36   'OpenSem(Sema4$,SemaValu%,HiHandle%,LoHandle%,OpenCnt%,RetCode%)
  187. 10123 EXAMSEM  =  39   'ExamSem(HiHandle%,LoHandle%,SemaValu%,OpenCnt%,RetCode%)
  188. 10124 WAITSEM  =  42   'WaitSem(HiHandle%,LoHandle%,TimeOut%,RetCode%)
  189. 10125 SIGSEM   =  45   'SigSem(HiHandle%,LoHandle%,RetCode%)
  190. 10126 CLOSSEM  =  48   'ClosSem(HiHandle%,LoHandle%,RetCode%)
  191. 10127 SETLCK   =  51   'setlck(Func%,Mode%)
  192. 10128 BAKOUTS  =  54   'Bakouts(Func%,RetCode%)
  193. 10129 BTRANS   =  57   'btran(ReturnCode%, Mode%)
  194. 10130 ETRANS   =  60   'etrans(ReturnCode%)
  195. 10131 EXCLOG   =  63   'exclog(ReturnCode%, FcbAddr)
  196. 10132 EXCLCKS  =  66   'exclcks(ReturnCode%, Mode%)
  197. 10133 EXCULKF  =  69   'exculkf(ReturnCode%, FcbAddr)
  198. 10134 EXCULKS  =  72   'exculks(ReturnCode%)
  199. 10135 EXCCLRF  =  75   'excclrf(ReturnCode%, FcbAddr)
  200. 10136 EXCCLRS  =  78   'excclrs(ReturnCode%)
  201. 10137 RECLOG   =  81   'reclog(ReturnCode%, String$)
  202. 10138 RECLCK   =  84   'reclck(ReturnCode%, Mode%)
  203. 10139 RECULK   =  87   'reculk(ReturnCode%, Semaphore$)
  204. 10140 RECULKS  =  90   'reculks(ReturnCode%)
  205. 10141 RECCLR   =  93   'recclr(ReturnCode%, Semaphore$)
  206. 10142 RECCLRS  =  96   'recclrs(ReturnCode%)
  207. 10143 EOJ      =  99   'eoj(ReturnCode%)
  208. 10144 SYSOUT   = 102   'sysout(ReturnCode%)
  209. 10145 ALLOCR   = 105   'allocr(ReturnCode%, Resource%)
  210. 10146 DALLOCR  = 108   'dallocr(ReturnCode%, Resource%)
  211. 10147 VOLSTAT  = 111   'volstat(volume%, reply$)
  212. 10148 LOCDRV   = 114   'locdrv(NumDisks%)
  213. 10149 WSID     = 117   'wsid(ThisStationNum%)
  214. 10150 ERRMODE  = 120   'errmode(mode%)
  215. 10151 BCSMODE  = 123   'bcsmode(mode%)
  216. 10152 CTLSPL   = 126   'ctlspl(mode%)
  217. 10153 SPLREQ   = 129   'splreq(ErrCode%, RequestBlock$, Reply$)
  218. 10154 PIPREQ   = 132   'pipreq(ErrCode%, RequestBlock$, Reply$)
  219. 10155 DPATH    = 135   'dpath(ReturnCode%, RequestBlock$, Reply$)
  220. 10156 SYSLOG   = 138   'syslog(ReturnCode%, RequestBlock$, Reply$)
  221. 10157 FATTR    = 141   'fattr(ReturnCode%, FcbAddr, Attribute%)
  222. 10158 UPDFCB   = 144   'updfcb(RetCode%,FcbAddr)
  223. 10159 CPYFILE  = 147   'cpyfile(ReturnCode%, FcbSource, FcbDest, CountLow, CountHigh)
  224. 10160 NETTOD   = 150   'nettod(time$)
  225. 10161 CLSMODE  = 153   'clsmode(mode%)
  226. 10162 DRVMAP   = 156   'drvmap(ReturnFlags%, drive%)
  227. 10163 RETSHL   = 159   'retshl(RetCode%, Mode%)
  228. 10164 ASCLOG   = 162   'asclog(RetCode%, Asciiz$)
  229. 10165 ASCULKF  = 165   'asculkf(RetCode%, Asciiz$)
  230. 10166 ASCCLRF  = 168   'ascclrf(RetCode%, Asciiz$)
  231. 10167 GETPSN   = 171   'Get_PSN(StationNo%)
  232. 10168 GETSTA   = 174   'Get_STA(Mode%,Segment%,Offset%)
  233. 10169 SETSERV  = 177   'SetServ(Mode%,NewServ%,CurrServ%)
  234. 10170 MODSERV  = 180   'ModServ(Mode%,NewServ%,RetCode%)
  235. 10180 GETDRV   = 183   'GetDrv(Drive%)
  236. 10200     '
  237. 10210     ' Assign the segment address for the library to the variable LibSeg
  238. 10220     '
  239. 10230     DEF SEG = 0
  240. 10240     SUBOFF = PEEK(&H4F0)+(256*PEEK(&H4F1))
  241. 10250     SUBSEG = PEEK(&H4F2)+(256*PEEK(&H4F3))
  242. 10260     LIBSEG = SUBSEG
  243. 10270     DEF SEG
  244. 10280     ' be sure the resident module is in place so we don't blow up
  245. 10290     IF LIBSEG = 0 OR SUBOFF <> 0 THEN input "The resident library is not loaded <enter> ",v$
  246. 10300     '
  247. 10310     ' set the error mode so its more informative
  248. 10320     DEF SEG = LIBSEG
  249. 10330     NEWMODE% = 1
  250. 10340     CALL ERRMODE(NEWMODE%)
  251. 10350     DEF SEG
  252. 10999 RETURN
  253.