home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lan / basnet / bdir.bas next >
BASIC Source File  |  1986-07-08  |  12KB  |  269 lines
  1. 1    '
  2. 2    ' Bdir.bas
  3. 3    '
  4. 4    ' a program to show the entries in the bindery of the selected
  5. 5    ' file server
  6. 6    '
  7. 100    ' Set up the Netware calls
  8. 110    '
  9. 120    gosub 10000
  10. 130    '
  11. 300    ' Set the constants
  12. 310    FIRSTTRY$ = CHR$(&HFF) + CHR$(&HFF) + CHR$(&HFF) + CHR$(&HFF)
  13. 1000    ' start of the main program
  14. 1010    '
  15. 1110    GOSUB 14000 'get my bindery access level
  16. 1120    CLS
  17. 1130    PRINT "Your read rights are "+ RDRIGHTS$
  18. 1140    PRINT "Your write rights are "+ WRTRIGHTS$: PRINT
  19. 1150    '
  20. 1160    'now set up and start polling the bindery for data
  21. 1170    '
  22. 1180    ' file servers first
  23. 1190        LASTOBJECTID$ = FIRSTTRY$
  24. 1200        RETURNCODE% = 0
  25. 1210        PATTERNTYPEHI$ = CHR$(0)
  26. 1220        PATTERNTYPELO$ = CHR$(4)
  27. 1230        PRINT: PRINT "FILESERVERS           PROPERTIES": PRINT "===========           =========="
  28. 1240        GOSUB 20000
  29. 1250    ' users next
  30. 1260        LASTOBJECTID$ = FIRSTTRY$
  31. 1270        RETURNCODE% = 0
  32. 1280        PATTERNTYPEHI$ = CHR$(0)
  33. 1290        PATTERNTYPELO$ = CHR$(1)
  34. 1300        PRINT: PRINT "USERS                 PROPERTIES": PRINT "===========           =========="
  35. 1310        GOSUB 20000
  36. 1320    ' now groups
  37. 1330        LASTOBJECTID$ = FIRSTTRY$
  38. 1340        RETURNCODE% = 0
  39. 1350        PATTERNTYPEHI$ = CHR$(0)
  40. 1360        PATTERNTYPELO$ = CHR$(2)
  41. 1370        PRINT: PRINT "GROUPS                PROPERTIES": PRINT "======                =========="
  42. 1380        GOSUB 20000
  43. 1390    ' now print servers
  44. 1400        LASTOBJECTID$ = FIRSTTRY$
  45. 1410        RETURNCODE% = 0
  46. 1420        PATTERNTYPEHI$ = CHR$(0)
  47. 1430        PATTERNTYPELO$ = CHR$(3)
  48. 1440        PRINT: PRINT "PRINT SERVERS         PROPERTIES": PRINT "=============         =========="
  49. 1450        GOSUB 20000
  50. 1460    ' now unknowns
  51. 1470        LASTOBJECTID$ = FIRSTTRY$
  52. 1480        RETURNCODE% = 0
  53. 1490        PATTERNTYPEHI$ = CHR$(0)
  54. 1500        PATTERNTYPELO$ = CHR$(0)
  55. 1510        PRINT: PRINT "UNKNOWN OBJECTS       PROPERTIES": PRINT "===============       =========="
  56. 1520        GOSUB 20000
  57. 9999   END
  58.  
  59. 10000 '
  60. 10010 ' routines for network use
  61. 10020 '
  62.  
  63. 10100 '  This section contains the routine names and
  64. 10101 '  offsets for the BASNET library
  65. 10102 ' the return is after everything is set up for NetWare calls
  66.  
  67. 10110 XTNDOPN  =   0   'xtndopn(Mode%, Filename$, Handle%, ErrCode%)
  68. 10111 SETATTR  =   3   'setattr(Func%, Filename$, Attribute%, ErrCode%)
  69. 10112 EOJSTAT  =   6   'eojstat(Flag%)
  70. 10113 PRLH.LOG =   9   'PRLH.Log(FileHandle%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
  71. 10114 PRLH.REL =  12   'PRLH.Rel(FileHandle%,HiByteOffset%,LoByteOffset%,ErrCode%)
  72. 10115 PRLH.CLR =  15   'PRLH.Clr(FileHandle%,HiByteOffset%,LoByteOffset%,Errcode%)
  73. 10116 PRLF.LOG =  18   'PRLF.Log(fcb%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
  74. 10117 PRLF.REL =  21   'PRLF.Rel(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
  75. 10118 PRLF.CLR =  24   'PRLF.Clr(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
  76. 10119 PRLS.LCK =  27   'PRLS.Lck(Flags%,TimeOut%,ErrCode%)
  77. 10120 PRLS.REL =  30   'PRLS.Rel(ErrCode%)
  78. 10121 PRLS.CLR =  33   'PRLS.Clr(ErrCode%)
  79. 10122 OPENSEM  =  36   'OpenSem(Sema4$,SemaValu%,HiHandle%,LoHandle%,OpenCnt%,RetCode%)
  80. 10123 EXAMSEM  =  39   'ExamSem(HiHandle%,LoHandle%,SemaValu%,OpenCnt%,RetCode%)
  81. 10124 WAITSEM  =  42   'WaitSem(HiHandle%,LoHandle%,TimeOut%,RetCode%)
  82. 10125 SIGSEM   =  45   'SigSem(HiHandle%,LoHandle%,RetCode%)
  83. 10126 CLOSSEM  =  48   'ClosSem(HiHandle%,LoHandle%,RetCode%)
  84. 10127 SETLCK   =  51   'setlck(Func%,Mode%)
  85. 10128 BAKOUTS  =  54   'Bakouts(Func%,RetCode%)
  86. 10129 BTRANS   =  57   'btran(ReturnCode%, Mode%)
  87. 10130 ETRANS   =  60   'etrans(ReturnCode%)
  88. 10131 EXCLOG   =  63   'exclog(ReturnCode%, FcbAddr)
  89. 10132 EXCLCKS  =  66   'exclcks(ReturnCode%, Mode%)
  90. 10133 EXCULKF  =  69   'exculkf(ReturnCode%, FcbAddr)
  91. 10134 EXCULKS  =  72   'exculks(ReturnCode%)
  92. 10135 EXCCLRF  =  75   'excclrf(ReturnCode%, FcbAddr)
  93. 10136 EXCCLRS  =  78   'excclrs(ReturnCode%)
  94. 10137 RECLOG   =  81   'reclog(ReturnCode%, String$)
  95. 10138 RECLCK   =  84   'reclck(ReturnCode%, Mode%)
  96. 10139 RECULK   =  87   'reculk(ReturnCode%, Semaphore$)
  97. 10140 RECULKS  =  90   'reculks(ReturnCode%)
  98. 10141 RECCLR   =  93   'recclr(ReturnCode%, Semaphore$)
  99. 10142 RECCLRS  =  96   'recclrs(ReturnCode%)
  100. 10143 EOJ      =  99   'eoj(ReturnCode%)
  101. 10144 SYSOUT   = 102   'sysout(ReturnCode%)
  102. 10145 ALLOCR   = 105   'allocr(ReturnCode%, Resource%)
  103. 10146 DALLOCR  = 108   'dallocr(ReturnCode%, Resource%)
  104. 10147 VOLSTAT  = 111   'volstat(volume%, reply$)
  105. 10148 LOCDRV   = 114   'locdrv(NumDisks%)
  106. 10149 WSID     = 117   'wsid(ThisStationNum%)
  107. 10150 ERRMODE  = 120   'errmode(mode%)
  108. 10151 BCSMODE  = 123   'bcsmode(mode%)
  109. 10152 CTLSPL   = 126   'ctlspl(mode%)
  110. 10153 SPLREQ   = 129   'splreq(ErrCode%, RequestBlock$, Reply$)
  111. 10154 PIPREQ   = 132   'pipreq(ErrCode%, RequestBlock$, Reply$)
  112. 10155 DPATH    = 135   'dpath(ReturnCode%, RequestBlock$, Reply$)
  113. 10156 SYSLOG   = 138   'syslog(ReturnCode%, RequestBlock$, Reply$)
  114. 10157 FATTR    = 141   'fattr(ReturnCode%, FcbAddr, Attribute%)
  115. 10158 UPDFCB   = 144   'updfcb(RetCode%,FcbAddr)
  116. 10159 CPYFILE  = 147   'cpyfile(ReturnCode%, FcbSource, FcbDest, CountLow, CountHigh)
  117. 10160 NETTOD   = 150   'nettod(time$)
  118. 10161 CLSMODE  = 153   'clsmode(mode%)
  119. 10162 DRVMAP   = 156   'drvmap(ReturnFlags%, drive%)
  120. 10163 RETSHL   = 159   'retshl(RetCode%, Mode%)
  121. 10164 ASCLOG   = 162   'asclog(RetCode%, Asciiz$)
  122. 10165 ASCULKF  = 165   'asculkf(RetCode%, Asciiz$)
  123. 10166 ASCCLRF  = 168   'ascclrf(RetCode%, Asciiz$)
  124. 10167 GETPSN   = 171   'Get_PSN(StationNo%)
  125. 10168 GETSTA   = 174   'Get_STA(Mode%,Segment%,Offset%)
  126. 10169 SETSERV  = 177   'SetServ(Mode%,NewServ%,CurrServ%)
  127. 10170 MODSERV  = 180   'ModServ(Mode%,NewServ%,RetCode%)
  128. 10200     '
  129. 10210     ' Assign the segment address for the library to the variable LibSeg
  130. 10220     '
  131. 10230     def seg = 0
  132. 10240     suboff = peek(&h4f0)+(256*peek(&h4f1))
  133. 10250     subseg = peek(&h4f2)+(256*peek(&h4f3))
  134. 10260     LibSeg = subseg
  135. 10270     def seg
  136. 10300     '
  137. 10310     ' set the error mode so its more informative
  138. 10320     def seg = LibSeg
  139. 10330     NewMode% = 1
  140. 10340     call errmode(NewMode%)
  141. 10350     def seg
  142. 10400     '
  143. 10999     return
  144.  
  145. 14000     '
  146. 14010     'determine the users access level
  147. 14020     '
  148. 14030     'enter with - LibSeg
  149. 14040     'uses (without altering) - LibSeg
  150. 14050     'changes - ReqPacLenHi$,ReqPacLenLo$,Func$,ReturnCode%, AccessReq$,
  151. 14060     '   AccessByte$, AccessReply$, rdrights$, wrtrights$
  152. 14070  REQPACLENLO$ = CHR$(1)
  153. 14080  REQPACLENHI$ = CHR$(0)
  154. 14090  FUNC$ = CHR$(70)
  155. 14100  ACCESSREQ$ = REQPACLENLO$ + REQPACLENHI$ + FUNC$
  156. 14110  ACCESSREPLY$ = CHR$(5)+CHR$(0)+STRING$(5,"x")
  157. 14120  RETURNCODE% = 0
  158. 14130  DEF SEG = LIBSEG
  159. 14140  CALL SYSLOG(RETURNCODE%,ACCESSREQ$,ACCESSREPLY$)
  160. 14150  DEF SEG
  161. 14160  IF RETURNCODE% <> 0 THEN PRINT "Request Error, Aborting": END
  162. 14170     ACCESSBYTE$ = MID$(ACCESSREPLY$,3,1)
  163. 14180     IF ACCESSBYTE$ = CHR$(0) THEN RDRIGHTS$ = "Free" : WRTRIGHTS$ = "Free"
  164. 14190     IF ACCESSBYTE$ = CHR$(1) THEN RDRIGHTS$ = "Logged" : WRTRIGHTS$ = "Free"
  165. 14200     IF ACCESSBYTE$ = CHR$(2) THEN RDRIGHTS$ = "Mine" : WRTRIGHTS$ = "Free"
  166. 14210     IF ACCESSBYTE$ = CHR$(3) THEN RDRIGHTS$ = "Supervisor" : WRTRIGHTS$ = "Free"
  167. 14220     IF ACCESSBYTE$ = CHR$(16) THEN RDRIGHTS$ = "Free" : WRTRIGHTS$ = "Logged"
  168. 14230     IF ACCESSBYTE$ = CHR$(17) THEN RDRIGHTS$ = "Logged" : WRTRIGHTS$ = "Logged"
  169. 14240     IF ACCESSBYTE$ = CHR$(18) THEN RDRIGHTS$ = "Mine" : WRTRIGHTS$ = "Logged"
  170. 14250     IF ACCESSBYTE$ = CHR$(19) THEN RDRIGHTS$ = "Supervisor" : WRTRIGHT$ = "Logged"
  171. 14260     IF ACCESSBYTE$ = CHR$(32) THEN RDRIGHTS$ = "Free" : WRTRIGHTS$ = "Mine"
  172. 14270     IF ACCESSBYTE$ = CHR$(33) THEN RDRIGHTS$ = "Logged" : WRTRIGHTS$ = "Mine"
  173. 14280     IF ACCESSBYTE$ = CHR$(34) THEN RDRIGHTS$ = "Mine" : WRTRIGHTS$ = "Mine"
  174. 14290     IF ACCESSBYTE$ = CHR$(35) THEN RDRIGHTS$ = "Supervisor" : WRTRIGHTS$ = "Mine"
  175. 14300     IF ACCESSBYTE$ = CHR$(48) THEN RDRIGHTS$ = "Free" : WRTRIGHTS$ = "Supervisor"
  176. 14310     IF ACCESSBYTE$ = CHR$(49) THEN RDRIGHTS$ = "Logged" : WRTRIGHTS$ = "Supervisor"
  177. 14320     IF ACCESSBYTE$ = CHR$(50) THEN RDRIGHTS$ = "Mine" : WRTRIGHTS$ = "Supervisor"
  178. 14330     IF ACCESSBYTE$ = CHR$(51) THEN RDRIGHTS$ = "Supervisor" : WRTRIGHTS$ = "Supervisor"
  179. 14999     RETURN
  180. 15000     '
  181. 15010     ' set up the request packet to scan for objects of the chosen type
  182. 15020     '
  183. 15030     ' when calling this routine remember to set the LastObjectSeen$
  184. 15040     ' (4 bytes) to -1 initially and thereafter equal to the UniqueObjectId$
  185. 15050     '
  186. 15060     ' enter with - PatternTypeHi$, PatternTypeLo$, LastObjectId$, LibSeg
  187. 15070     ' uses (but does not alter) - PatternTypeHi$, LoPatternTypeLo$, LastObjectSeen$, LibSeg
  188. 15080     ' changes - ReqPacLenHi$, ReqPacLenLo$, Func$, RepPacLenHi$, RepPacLo$,
  189. 15090     '    ObjReply$, ObjRequest$, PatternLen$, Pattern$
  190. 15100     REQPACLENHI$ = CHR$(0)
  191. 15110     REQPACLENLO$ = CHR$(9)
  192. 15120     FUNC$ = CHR$(55) 'scan for objects subfunction
  193. 15130     PATTERNLEN$ = CHR$(1)
  194. 15140     PATTERN$ = "*"
  195. 15150     OBJREQ$ = REQPACLENLO$ + REQPACLENHI$ + FUNC$ + LASTOBJECTID$ + PATTERNTYPEHI$ + PATTERNTYPELO$ + PATTERNLEN$ + PATTERN$
  196. 15200     ' set up the reply buffer
  197. 15210     REPPACLENHI$ = CHR$(0)
  198. 15220     REPPACLENLO$ = CHR$(57)
  199. 15230     OBJREPLY$ = REPPACLENLO$ + REPPACLENHI$ + STRING$((ASC(REPPACLENHI$)*256) + ASC(REPPACLENLO$),"x")
  200. 15300     'make the bindery request
  201. 15310     DEF SEG = LIBSEG
  202. 15320     CALL SYSLOG(RETURNCODE%,OBJREQ$,OBJREPLY$)
  203. 15330     DEF SEG
  204. 15999     RETURN
  205. 16000     '
  206. 16010     ' This routine strips the nulls off the right side of a string
  207. 16020     ' - enter with the string to be stripped as Incoming$
  208. 16030     '   the processed string will be returned as Outgoing$
  209. 16040     '
  210. 16050     'enter with - Incoming$
  211. 16060     'uses (without altering) - Incoming$
  212. 16070     'changes - checkchar$, i, Outgoing$
  213. 16080     '
  214. 16090    OUTGOING$ = ""
  215. 16100    I = 0
  216. 16110    CHECKCHAR$ = CHR$(1)
  217. 16120    WHILE CHECKCHAR$ <> CHR$(0)
  218. 16130        I=I+1
  219. 16140        CHECKCHAR$=MID$(INCOMING$,I,1)
  220. 16150        IF CHECKCHAR$ <> CHR$(0) THEN OUTGOING$ = OUTGOING$ + CHECKCHAR$
  221. 16160    WEND
  222. 16999    RETURN
  223. 17000     '
  224. 17010     ' set up the request packet to scan for properties
  225. 17020     '
  226. 17030     ' when calling this routine remember to set the LastInstance$
  227. 17040     ' (4 bytes) to -1 initially and thereafter equal to the SearchInstance$
  228. 17050     '
  229. 17060     ' enter with - ObjectType$, ObjName$, LastInstance$, LibSeg
  230. 17070     ' uses (but does not alter) - PatternTypeHi$, LoPatternTypeLo$, LastObjectSeen$, LibSeg
  231. 17080     ' changes - ReqPacLenHi$, ReqPacLenLo$, Func$, RepPacLenHi$, RepPacLo$,
  232. 17090     '    ObjReply$, ObjRequest$, PatternLen$, Pattern$
  233. 17110     FUNC$ = CHR$(60) 'scan for properties subfunction
  234. 17120     SEARCHPROPNAMELEN$ = CHR$(1)
  235. 17130     SEARCHPROPNAME$ = "*"
  236. 17140     OBJNAMELEN$ = CHR$(LEN(OBJNAME$))
  237. 17150     REQPACLENHI$ = CHR$(0)
  238. 17160     REQPACLENLO$ = CHR$(LEN(FUNC$)+ LEN(OBJTYPE$)+ LEN(OBJNAMELEN$)+ LEN(OBJNAME$)+ LEN(LASTINSTANCE$)+ LEN(SEARCHPROPNAMELEN$)+ LEN(SEARCHPROPNAME$))
  239. 17170     PROPREQ$ = REQPACLENLO$ + REQPACLENHI$ + FUNC$ + OBJTYPE$ + OBJNAMELEN$ + OBJNAME$ + LASTINSTANCE$ + SEARCHPROPNAMELEN$ + SEARCHPROPNAME$
  240. 17200     ' set up the reply buffer
  241. 17210     REPPACLENHI$ = CHR$(0)
  242. 17220     REPPACLENLO$ = CHR$(26)
  243. 17230     PROPREPLY$ = REPPACLENLO$ + REPPACLENHI$ + STRING$((ASC(REPPACLENHI$)*256) + ASC(REPPACLENLO$),CHR$(0))
  244. 17300     'make the bindery request
  245. 17310     DEF SEG = LIBSEG
  246. 17320     CALL SYSLOG(PROPRETCODE%,PROPREQ$,PROPREPLY$)
  247. 17330     DEF SEG
  248. 17999     RETURN
  249. 20000    '
  250. 20010    ' get and display the objects and properties
  251. 20020    '
  252. 20030    'enter with -
  253. 20040    'uses (without altering) -
  254. 20050    'changes -
  255. 20060    '
  256. 20100    WHILE RETURNCODE% <> 252
  257. 20110        GOSUB 15000
  258. 20120        IF RETURNCODE% <> 252 THEN PRINT MID$(OBJREPLY$,9,48) ELSE OBJREPLY$ = STRING$(60,CHR$(0))
  259. 20130        LASTOBJECTID$ = MID$(OBJREPLY$,3,4)
  260. 20140        PROPERTIES$ = MID$(OBJREPLY$,59,1)
  261. 20150        IF PROPERTIES$ <> CHR$(0) THEN OBJTYPE$ = MID$(OBJREPLY$,7,2): INCOMING$ = MID$(OBJREPLY$,9,48): GOSUB 16000: OBJNAMELEN$ = CHR$(LEN(OUTGOING$)): OBJNAME$ = OUTGOING$: LASTINSTANCE$ = FIRSTTRY$: PROPRETCODE% = 0
  262. 20220            WHILE PROPRETCODE% <> 251
  263. 20230               GOSUB 17000
  264. 20240               IF PROPRETCODE% <> 251 THEN PRINT "                      "+ MID$(PROPREPLY$,3,16) ELSE PROPREPLY$ = STRING$(26,CHR$(0))
  265. 20260               LASTINSTANCE$ = MID$(PROPREPLY$,21,4)
  266. 20270            WEND
  267. 20280    WEND
  268. 20999    RETURN
  269.