home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lan / basnet / nodeinfo.bas < prev    next >
BASIC Source File  |  1987-05-11  |  28KB  |  691 lines
  1. 10    'Initialization
  2. 15     GOSUB 10000  'set up the network access and library calls
  3. 17      '
  4. 50       CLS
  5. 90       PRINT "                            SHELL STATUS TABLES"
  6. 100      PRINT "------------------------------------------------------------------------------"
  7. 105      PRINT "LOG DRV    A  B  C  D  E  F  G  H  I  J  K  L  M  N  O  P  Q  R  S  T  U  V  W" 
  8. 107      PRINT " NAME  :     X  Y  Z  [  \  ]  ^  -  `"
  9.  
  10. 200     '
  11. 210     'Display Drive Handle Table
  12. 220     '
  13. 230      mode% = 0
  14. 365      TABLENAM$="DRV HDL: "
  15. 370      GOSUB 16000 
  16. 400      '
  17. 410      'Display the Drive Flag Table
  18. 420      '
  19. 430      mode% = 1
  20. 440      TABLENAM$="DRV FLG: "
  21. 450      GOSUB 16000
  22. 480      '
  23. 490      'Display Drive Server Table
  24. 500      '
  25. 510      mode% = 2
  26. 520      TABLENAM$="DRV SRV: "
  27. 530      GOSUB 16000
  28. 540      '
  29. 541      PRINT "______________________________________________________________________________"
  30. 542     MODE% = 2   'GET THE CURRENT EFFECTIVE SERVER
  31. 543     DEF SEG = LIBSEG
  32. 544     CALL SETSERV(MODE%,DRIVE%,CURR%)
  33. 545     DEF SEG
  34.  
  35. 547    MODE% = 3    'get server mapping table address function
  36. 550    '
  37. 553    DEF SEG = LIBSEG
  38. 557    CALL GETSTA(MODE%, STSEGMENT%, STOFFSET%)  'Func EFh
  39. 560     MODE% = 4
  40. 563     CALL GETSTA(MODE%,STSEGMENT%,NTOFF%)  'Func EFh
  41. 567    DEF SEG = STSEGMENT%
  42. 570    '
  43. 573    ' Now we will display the table contents for demo purposes
  44. 575     LOCATE 13,31
  45. 577     PRINT "Server mapping table contents:": PRINT
  46. 580     FOR I = 0 TO 7
  47. 584      T=15 + I
  48. 585      LOCATE T,30
  49. 586      PRINT I+1;:IF I+1=CURR% THEN PRINT "* "; ELSE PRINT "  ";
  50. 587      FOR X = 0 TO 13
  51. 590        PRINT RIGHT$("00"+HEX$(PEEK(STOFFSET% + (32*I) + X)),2);
  52. 593      NEXT X
  53. 597      PRINT SPC(3);
  54. 600      FOR X = 0 TO 19
  55. 603        A$ = CHR$(PEEK(NTOFF% + (I*48) + X))
  56. 607        IF A$ = CHR$(0) THEN X = 19 ELSE PRINT A$;
  57. 610      NEXT X
  58. 613      PRINT
  59. 617     NEXT I
  60. 620    '
  61. 630      LOCATE 13,1
  62. 650      PRINT "--------- MAIN MENU -------"
  63. 651      PRINT "  1. ATTACH (F1h mode=0)"
  64. 652      PRINT "  2. DETACH (F1h mode=1)"
  65. 653      PRINT "  3. LOGOUT (F1h mode=2)"
  66. 654      PRINT "  4. LOGIN  (E3h-00h)"
  67. 657      PRINT "  5. SET PREFERRED SERVER"
  68. 658      PRINT "  6. GET DRIVE INFORMATION"
  69. 662      PRINT "  7. SET PATH(Allocate a base)"
  70. 666      PRINT "  8. ADD A SUBDIRECTORY"
  71. 670      PRINT "  9. EXIT program"
  72. 674      PRINT "---------------------------"
  73. 678      INPUT ; "Please make a menu selection: ",RE$
  74. 680      IF (RE$ <"1") OR (RE$>"9") THEN 50
  75. 682      ON VAL(RE$) GOSUB 1000,2000,3000,4000,5000,6000,7000,8000
  76. 684      IF RE$ = "9" THEN 999
  77. 686      GOTO 50
  78.  
  79. 999      SYSTEM
  80.  
  81. 1000    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  82. 1010    ' Begin ATTACH
  83. 1020    CLS
  84. 1025    PRINT "SERVER NAME
  85. 1030    PRINT "-----------
  86. 1035    PRINT
  87. 1040    LASTOBJECTID$ = STRING$(4,255)
  88. 1045    RETURNCODE% = 0
  89. 1050    PATTERNTYPEHI$ = CHR$(0)
  90. 1055    PATTERNTYPELO$ = CHR$(4)
  91. 1060    REQPACLENHI$ = CHR$(0)
  92. 1065    REQPACLENLO$ = CHR$(9)
  93. 1070    FUNC$ = CHR$(55) 'scan for objects subfunction
  94. 1075    PATTERNLEN$ = CHR$(1)
  95. 1080    PATTERN$ = "*"
  96. 1085    REPPACLENHI$ = CHR$(0)
  97. 1090    REPPACLENLO$ = CHR$(57)
  98. 1095    WHILE RETURNCODE% <> 252
  99. 1100      'set up the request buffer
  100. 1105      OBJREQ$ = REQPACLENLO$ + REQPACLENHI$ + FUNC$ + LASTOBJECTID$ + PATTERNTYPEHI$ + PATTERNTYPELO$ + PATTERNLEN$ + PATTERN$
  101. 1110      'set up the reply buffer
  102. 1115      OBJREPLY$ = REPPACLENLO$ + REPPACLENHI$ + STRING$((ASC(REPPACLENHI$)*256) + ASC(REPPACLENLO$),"x")
  103. 1120      'make the bindery request
  104. 1125      DEF SEG = LIBSEG
  105. 1130      CALL SYSLOG(RETURNCODE%,OBJREQ$,OBJREPLY$)
  106. 1135      DEF SEG
  107. 1140      IF RETURNCODE% <> 252 THEN PRINT MID$(OBJREPLY$,9,48) ELSE OBJREPLY$ = STRING$(60,CHR$(0))
  108. 1145      LASTOBJECTID$ = MID$(OBJREPLY$,3,4)
  109. 1150    WEND
  110. 1155    print
  111. 1160    INPUT "Enter file server name you wish to attach to: ",SERVERNAME$
  112. 1165    IF SERVERNAME$ = "" THEN GOTO 1999
  113. 1170    ' now get the net address of the server
  114. 1175    GOSUB 18000
  115. 1180    IF PROPRETCODE% <> 0 THEN GOTO 1999
  116. 1190    '
  117. 1210    ' now check the table for target server match and an open entry to use
  118. 1220    SERVERMATCH% = 0: INSERT% = 0
  119. 1225    DEF SEG = STSEGMENT%
  120. 1230    FOR ENTRY% = 7 TO 0 STEP -1
  121. 1250        IF PEEK(STOFFSET% + (32 * ENTRY%)) <> 255 THEN INSERT% = ENTRY%+1: GOTO 1280
  122. 1251          DMY$ = ""
  123. 1252          FOR I = 2 TO 13
  124. 1254            DMY$ = DMY$ + CHR$(PEEK(STOFFSET%+32*ENTRY%+I))
  125. 1256          NEXT I
  126. 1258          IF TARGETADDRESS$ = DMY$ THEN SERVERMATCH% = ENTRY% + 1: GOTO 1290
  127. 1280    NEXT
  128. 1290    DEF SEG
  129. 1295    IF SERVERMATCH% THEN INPUT "That server is in the table. <enter>",V$:GOTO 1999
  130. 1400    '
  131. 1405    ' we now need to insert our server address into the table.
  132. 1410    '
  133. 1500    IF INSERT% = 0 THEN INPUT "There are no free entries. <enter>",V$: GOTO 1999
  134. 1520    TARGETBASEADD% = STOFFSET% + (32 * (INSERT% -1))
  135. 1590    DEF SEG = STSEGMENT%
  136. 1600    FOR CHARNO% = 1 TO 12
  137. 1620            THISCHAR% = ASC(MID$(TARGETADDRESS$,CHARNO%,1))
  138. 1630        THISADD% = TARGETBASEADD%  + CHARNO% + 1
  139. 1640        POKE THISADD%,THISCHAR%
  140. 1660    NEXT
  141. 1662    FOR X% = 1 TO LEN(SERVERNAME$)
  142. 1664       THISCHAR% = ASC(MID$(SERVERNAME$,X%,1))
  143. 1665       THISADDR% = STOFFSET% + 8*32 + (INSERT% - 1)*48 + X% - 1
  144. 1666       POKE THISADDR%,THISCHAR%
  145. 1668    NEXT
  146. 1669    POKE THISADDR%+1,0
  147. 1670    DEF SEG
  148. 1700    '
  149. 1705    ' now we need to set the order numbers for the server mapping table
  150. 1710    SLOT% = 1     'initialize the variable for a value higher than the table can hold
  151. 1715    DEF SEG = STSEGMENT%
  152. 1720    FOR CHKENTRY% = 0 TO 7
  153. 1730        THISOFF% = STOFFSET% + (32*CHKENTRY%)            
  154. 1740        IF PEEK(THISOFF%) <> 255 THEN GOTO 1770
  155. 1745              DMY$ = ""
  156. 1750          FOR I = 2 TO 13
  157. 1752                DMY$ = DMY$ + CHR$(PEEK(THISOFF% + I))
  158. 1754              NEXT
  159. 1756              IF TARGETADDRESS$ > DMY$ THEN SLOT% = SLOT% + 1: GOTO 1770
  160. 1758              POKE THISOFF%+1,PEEK(THISOFF%+1)+1
  161. 1770    NEXT
  162. 1780    '
  163. 1810    ' we need to set the in use flag for our new entry and the new order #
  164. 1830    POKE TARGETBASEADD%, 255:POKE TARGETBASEADD%+1,SLOT%
  165. 1890    '
  166. 1900    ' finally, we must make the call to attach to our new server
  167. 1905    '   (Function Call F1h)
  168. 1910    MODE% = 0 'mode to create an attachment
  169. 1920    RETCODE% = 0
  170. 1930    DEF SEG = LIBSEG
  171. 1940    CALL MODSERV(MODE%,SLOT%,RETCODE%)   'Func F1h
  172. 1950    DEF SEG
  173. 1960    IF RETCODE% <> 0 THEN INPUT "Attempt to attach failed <RETURN> to continue.",R$
  174. 1999    RETURN
  175.  
  176. 2000    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  177. 2005    'Begin DETACH
  178. 2007    '
  179. 2008    LOCATE 24,1
  180. 2010    INPUT "Enter Server Mapping Table entry (1-8) to be DETACHED: ",DL$
  181. 2020    IF DL$ = "" THEN 2999
  182. 2030    DL% = VAL(DL$)
  183. 2040    IF (DL% < 1) OR (DL% > 8) THEN 2008
  184. 2050    MODE% = 1
  185. 2060    RETCODE% = 0
  186. 2070    DEF SEG = LIBSEG
  187. 2080    CALL MODSERV(MODE%,DL%,RETCODE%)   'Func F1h
  188. 2090    DEF SEG
  189. 2100    IF RETCODE% <> 0 THEN PRINT "Not detached! Return code -> "RETCODE%: INPUT " <enter>",v$: goto 2999
  190. 2110    INPUT "DETACH Completed. <enter>",V$
  191. 2999    RETURN
  192.  
  193.  
  194. 3000    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  195. 3005    '  Begin LOGOUT
  196. 3007     '
  197. 3009    LOCATE 24,1
  198. 3010    INPUT "Enter Server Mapping Table entry (1-8) to be LOGOUT of: ",DL$
  199. 3020    IF DL$ = "" THEN 3999
  200. 3030    DL% = VAL(DL$)
  201. 3040    IF (DL% < 1) OR (DL% > 8) THEN 3009
  202. 3050    MODE% = 2
  203. 3060    RETCODE% = 0
  204. 3070    DEF SEG = LIBSEG
  205. 3080    CALL MODSERV(MODE%,DL%,RETCODE%)   'Func F1h
  206. 3090    DEF SEG
  207. 3100    IF RETCODE% <> 0 THEN PRINT "Not LOGGED OUT! Return code -> "RETCODE%: INPUT "<enter>",v$: goto 3999
  208. 3110    INPUT "LOGOUT Completed. <enter>",V$
  209. 3999    RETURN
  210.  
  211.  
  212. 4000    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  213. 4010    '  Begin LOGIN
  214. 4010    '
  215. 4020    ' first we need to select the file server which is the target
  216. 4030    ' of our request
  217. 4040    '
  218. 4041    LOCATE 24,1
  219. 4042    INPUT "Enter slot # of the server to be logged in to: ",SLOT$
  220. 4043    IF SLOT$ = "" THEN 4999
  221. 4044    SLOT% = VAL(SLOT$)
  222. 4046    IF (SLOT%<1) OR (SLOT%>8) THEN GOTO 4041
  223. 4050    MODE% = 0 'mode to set the preferred file server
  224. 4060    DEF SEG = LIBSEG
  225. 4070    CALL SETSERV(MODE%,SLOT%,CURRENTSERVER%)   'Func F0h
  226. 4080    DEF SEG
  227. 4200    ' and now we will log in
  228. 4210    ' set up the request packet
  229. 4212    INPUT "Enter login name: ",LOGNAME$
  230. 4220    REQPACLENHI$ = CHR$(0)
  231. 4230    REQPACLENLO$ = CHR$(LEN(LOGNAME$)+3)
  232. 4240    FUNC$ = CHR$(0) 'login subfunction
  233. 4250    LOGNAMELEN$ = CHR$(LEN(LOGNAME$))
  234. 4270    PASSWORDLEN$ = CHR$(0)
  235. 4280    PASSWORD$ = ""
  236. 4290    REQPACKET$ = REQPACLENLO$+REQPACLENHI$+FUNC$+LOGNAMELEN$+LOGNAME$+PASSWORDLEN$
  237. 4300    ' set up the reply buffer
  238. 4310    REPPACLENHI$ = CHR$(0)
  239. 4320    REPPACLENLO$ = CHR$(20)
  240. 4330    REPLYPACKET$ = REPPACLENLO$+REPPACLENHI$
  241. 4340    'make the login request
  242. 4350    DEF SEG = LIBSEG
  243. 4360    CALL SYSLOG(ERRCODE%,REQPACKET$,REPLYPACKET$)   'Func E3h(00h)
  244. 4370    DEF SEG
  245. 4380    IF ERRCODE% <> 0 THEN PRINT "Error -> "ERRCODE%: INPUT "<enter>",V$: GOTO 4041
  246. 4390    INPUT "login successful <enter>",v$    
  247. 4999    RETURN
  248.  
  249.  
  250. 5000 'SET THE PREFERRED FILE SERVER
  251. 5005    LOCATE 24,1
  252. 5010    input "Set preferred file server as (1-8): ",drive%
  253. 5030    MODE% = 0 'mode to set the preferred file server
  254. 5040    DEF SEG = LIBSEG
  255. 5050    CALL SETSERV(MODE%,DRIVE%,CURRENTSERVER%)
  256. 5060    DEF SEG
  257. 5070    RETURN
  258.  
  259.  
  260. 6000    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  261. 6010     CLS
  262. 6020    ' Begin GET DRIVE INFORMATION
  263. 6030    '
  264. 6032    INPUT "Select drive (0 thru 31): ",v$
  265. 6035    IF V$ = "" THEN GOTO 6999
  266. 6040    DRIVE% = VAL(V$)
  267. 6045    IF DRIVE% < 0 OR DRIVE% > 31 THEN GOTO 6010
  268. 6050    'now get the path base
  269. 6055    '
  270. 6060    ReturnFlags% = 0
  271. 6065    def seg = LibSeg
  272. 6070    call drvmap(ReturnFlags%,Drive%)
  273. 6075    def seg
  274. 6080    BaseFlag% = ReturnFlags%/256 ' the base flag is the high byte of the return
  275. 6085    PathBase% = (ReturnFlags% - (BaseFlag% * 256)) ' the path base is the low byte of the return
  276. 6095    'next we can get the path itself
  277. 6100    '
  278. 6105    Func$ = chr$(1)
  279. 6110    SourceBase$ = chr$(PathBase%)
  280. 6115    ReqPacLenHi$ = chr$(0)
  281. 6120    ReqPacLenLo$ = chr$(2)
  282. 6125    ReqPacket$ = ReqPacLenLo$ + ReqPacLenHi$ + Func$ + SourceBase$
  283. 6130    Reply$ = chr$(64)+chr$(0) + string$(64,0)
  284. 6135    ReturnCode% = 0
  285. 6140    def seg = LibSeg
  286. 6145    call dpath(ReturnCode%,ReqPacket$,Reply$)
  287. 6150    def seg
  288. 6155    RetPathLen% = asc(mid$(Reply$,3,1))
  289. 6160    Path$ = mid$(Reply$,4,RetPathLen%)
  290. 6165    print "The current path is " Path$
  291.  
  292. 6170    ' now we find out what rights the directory allows
  293. 6175    '
  294. 6180    Func$ = chr$(2)
  295. 6185    SourceBase$ = chr$(0)
  296. 6190    SearchStart$ = chr$(0) + chr$(1)
  297. 6200    SpecLength$ = chr$(len(Path$))
  298. 6205    LoPacLen$ = chr$(5+len(Path$))
  299. 6210    HiPacLen$ = chr$(0)
  300. 6215    Request$ = LoPacLen$ + HiPacLen$ + Func$ + SourceBase$ + SearchStart$ + SpecLength$ + Path$
  301. 6220    Reply$ = chr$(28)+chr$(0) + string$(28,0)
  302. 6225    ErrCode% = 0
  303. 6230    def seg = LibSeg
  304. 6235    call dpath(ErrCode%,Request$,Reply$)
  305. 6240    def seg
  306. 6245    if ErrCode% <> 0 then PRINT "Request for allowable directory rights failed. <enter> ",v$: goto 6320
  307. 6250    Access% = asc(mid$(Reply$,27,1))
  308. 6255    print "This directory permits the following rights: "
  309. 6260    PRINT "  (";
  310. 6265    if Access% > 127 then print "Modify";:Access% = Access% - 128
  311. 6270    if Access% > 63  then print ", Search";:Access% = Access% - 64
  312. 6275    if Access% > 31  then print ", Parental";:Access% = Access% - 32
  313. 6290    if Access% > 15  then print ", Delete";:Access% = Access% - 16
  314. 6295    if Access% > 7     then print ", Create";:Access% = Access% - 8
  315. 6300    if Access% > 3     then print ", Open";:Access% = Access% - 4
  316. 6305    if Access% > 1     then print ", Write";:Access% = Access% - 2
  317. 6310    if Access% > 0     then print ", Read";:Access% = Access% - 1
  318. 6315    PRINT ")"
  319.  
  320. 6320    ' the next step is to discover which rights we have in this
  321. 6325    ' directory
  322. 6330    '
  323. 6335    Func$ = chr$(3)
  324. 6345    LoPacLen$ = chr$(3+len(Path$))
  325. 6350    HiPacLen$ = chr$(0)
  326. 6355    Request$ = LoPacLen$ + HiPacLen$ + Func$ + SourceBase$ + SpecLength$ + Path$
  327. 6360    Reply$ = chr$(1) + chr$(0) + chr$(0)
  328. 6365    ErrCode% = 0
  329. 6370    def seg = LibSeg
  330. 6375    call dpath(ErrCode%,Request$,Reply$)
  331. 6380    def seg
  332. 6385    if ErrCode% <> 0 then print "Request for your effective directory rights failed.": GOTO 6450
  333. 6390    Access% = asc(mid$(Reply$,3,1))
  334. 6395    print "Your rights in this directory are: "
  335. 6400    PRINT "  (";
  336. 6405    if Access% > 127 then print "Modify";:Access% = Access% - 128
  337. 6410    if Access% > 63  then print ", Search";:Access% = Access% - 64
  338. 6415    if Access% > 31  then print ", Parental";:Access% = Access% - 32
  339. 6420    if Access% > 15  then print ", Delete";:Access% = Access% - 16
  340. 6425    if Access% > 7     then print ", Create";:Access% = Access% - 8
  341. 6430    if Access% > 3     then print ", Open";:Access% = Access% - 4
  342. 6435    if Access% > 1     then print ", Write";:Access% = Access% - 2
  343. 6440    if Access% > 0     then print ", Read";:Access% = Access% - 1
  344. 6445    PRINT ")"
  345.  
  346. 6450    ' NEXT LIST ALL TRUSTEES OF THIS DIRECTORY
  347. 6455    ErrCode% = 0
  348. 6460    SetNo% = 1
  349. 6465    func$ = chr$(12) 'E2h function 12 gets trustees
  350. 6470    while ErrCode% = 0
  351. 6490       SetNo$ = chr$(SetNo%)                       
  352. 6505       Request$ = Func$ + SourceBase$ + SetNo$ + SpecLength$ + path$
  353. 6506       request$ = chr$(len(request$)) + chr$(0) + request$
  354. 6510       Reply$ = chr$(49) + chr$(0) + string$(49,chr$(0))
  355. 6515       def seg = LibSeg
  356. 6520       call dpath(ErrCode%,Request$,Reply$)
  357. 6525       def seg
  358. 6530       if ErrCode% <> 0 and SetNo% = 1 then print "(This directory has no trustees.";:goto 6625
  359. 6535       if ErrCode% <> 0 then goto 6625
  360. 6540       PRINT "The trustees of this directory are:"
  361. 6545       print " (";
  362. 6550       Trustee# = 1 : count% = 0
  363. 6555       while Trustee# <> 0 and count% < 5
  364. 6560          offset% = 27 + (count% * 4)
  365. 6565          Trustee# = asc(mid$(Reply$,offset% ,1)) + (256 * asc(mid$(Reply$,offset% + 1,1))) + (256 * 256 * asc(mid$(Reply$,offset% + 2,1)))
  366. 6566          trustee# = trustee# + (256*256*256* asc(mid$(reply$,offset%+3,1)))
  367. 6570          if Trustee# = 0 then goto 6625
  368. 6575          GetTrusteeName$ = chr$(5) + chr$(0) + chr$(54) + mid$(Reply$,offset%,4)
  369. 6580          TrusteeNameResponse$ = chr$(56) + chr$(0) + string$(56,0)
  370. 6585          RetCode% = 0
  371. 6590          def seg = LibSeg
  372. 6595          call syslog(RetCode%, GetTrusteeName$, TrusteeNameResponse$)
  373. 6600          def seg
  374. 6605          if RetCode% = 0 then print spc(1) mid$(TrusteeNameResponse$,9,48);
  375. 6610          if RetCode% <> 0 then count% = 5
  376. 6615          count% = count% + 1
  377. 6620       wend
  378. 6625       SetNo% = SetNo% + 1
  379. 6630    wend
  380. 6635    print ")"
  381.  
  382. 6640    ' NEXT TOTAL DISK SPACE USED IN THIS DIRECTORY
  383. 6645    func$ = chr$(15)
  384. 6650    lastslot$ = chr$(255) + chr$(255)
  385. 6655    searchattrib$ = chr$(0)
  386. 6656    spec$ = path$ + "\*": specln$ = chr$(len(spec$))
  387. 6660    done% = 0: total# = 0:
  388. 6670    while done% = 0
  389. 6675      request$ = func$ + lastslot$ + sourcebase$ + searchattrib$ + specln$ + spec$
  390. 6680      request$ = chr$(len(request$)) + chr$(0) + request$
  391. 6685      reply$ = chr$(96)+chr$(0) + string$(96,0)
  392. 6689      def seg = libseg
  393. 6690      call syslog(done%, request$, reply$)
  394. 6691      def seg
  395. 6695      if done% <> 0 then print "The total bytes used in this directory is: "total#: goto 6710
  396. 6700      total# = total# + 256*256*256*asc(mid$(reply$,21,1))
  397. 6701      total# = total# + 256*256*asc(mid$(reply$,22,1))
  398. 6702      total# = total# + 256*asc(mid$(reply$,23,1))
  399. 6703      total# = total# + asc(mid$(reply$,24,1))
  400. 6705      lastslot$ = mid$(reply$,3,2)
  401. 6710    wend
  402.  
  403. 6720    ' NEXT LIST ALL SUBDIRECTORIES
  404. 6725    func$ = chr$(2)
  405. 6730    hisearch% = 0: losearch% = 1 :s = 0
  406. 6735    done% = 0
  407. 6740    print "The Subdirectories are: "
  408. 6745    def seg = libseg
  409. 6750    while done% = 0
  410. 6755      request$ = func$ + sourcebase$ + chr$(hisearch%) + chr$(losearch%) + specln$ + spec$
  411. 6760      request$ = chr$(len(request$)) + chr$(0) + request$
  412. 6765      reply$ = chr$(28)+chr$(0) + string$(28,0)
  413. 6770      call dpath(done%, request$, reply$)
  414. 6775      if done% <> 0 then goto 6790
  415. 6780      print spc(3)mid$(reply$,3,16);
  416. 6783      hisearch% = asc(mid$(reply$,29,1))
  417. 6784      losearch% = asc(mid$(reply$,30,1))
  418. 6785      if s = hisearch% * 256 + losearch% then done% = 1: goto 6790
  419. 6786      s = hisearch% + losearch%
  420. 6787      losearch% = losearch% + 1
  421. 6788      if losearch% > 255 then losearch% = 0 and hisearch% = hisearch% + 1
  422. 6790    wend
  423. 6795    def seg
  424. 6800    PRINT
  425. 6805    INPUT "<enter> ",v$
  426. 6999    return
  427.  
  428.  
  429. 7000    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  430. 7005     CLS
  431. 7010    '  Begin SET PATH
  432. 7015    '
  433. 7020    ' This routine demonstrates the ability of a program to set a
  434. 7030    ' a permanent base path.
  435. 7040    '
  436. 7110    'set up a base for exit purposes
  437. 7120    'set up request packet
  438. 7125    '
  439. 7127    PRINT "Menu Option 7 - SET PATH"
  440. 7128    PRINT
  441. 7130    INPUT "Allocate Base as 'P'ermanent or 'T'emporary: ",ANS$:PRINT
  442. 7131    IF ANS$ = "" THEN GOTO 7399
  443. 7132    IF ASC(ANS$) > 96 THEN ANS$ = CHR$(ASC(ANS$)-32)
  444. 7135    IF (ANS$ <> "P") AND (ANS$ <> "T") THEN 7130
  445. 7150    FUNC$ = CHR$(18)
  446. 7155    IF ANS$ = "T" THEN FUNC$ = CHR$(19)
  447. 7160    SOURCEBASE$ = CHR$(0)
  448. 7170    INPUT "Enter a logical drive name (A to ` ): ",DRIVENAME$:PRINT
  449. 7171    IF DRIVENAME$ = "" THEN 7399
  450. 7174    IF ASC(DRIVENAME$) > 96 THEN DRIVENAME$ = CHR$(ASC(DRIVENAME$)-32)
  451. 7177    IF (DRIVENAME$ < "A") OR (DRIVENAME$ > "`") THEN 7170
  452. 7190    INPUT "Enter Path Name specification (SYS:PUBLIC/COMMON): ",PATHSPEC$:PRINT
  453. 7192    SPECLEN$ = CHR$(LEN(PATHSPEC$))
  454. 7194    REQPACLENHI$ = CHR$(0)
  455. 7196    REQPACLENLO$ = CHR$(4 + LEN(PATHSPEC$))
  456. 7200    'set up reply buffer
  457. 7210    REPLENHI$ = CHR$(0)
  458. 7220    REPLENLO$ = CHR$(2)
  459. 7230    NEWBASE$ = " "
  460. 7240    ACCESSMASK$ = " "
  461. 7250    REQUESTBLOCK$ = REQPACLENLO$ + REQPACLENHI$ + FUNC$ + SOURCEBASE$ + DRIVENAME$ + SPECLEN$ + PATHSPEC$
  462. 7260    REPLY$ = REPLENLO$ + REPLENHI$ + NEWBASE$ + ACCESSMASK$
  463. 7270    DEF SEG = LIBSEG
  464. 7280    CALL DPATH(RETURNCODE%, REQUESTBLOCK$, REPLY$)  'Func E2h(12h)
  465. 7290    IF RETURNCODE% <> 0 THEN PRINT "Path Error: " RETURNCODE%:PRINT:GOTO 7300
  466. 7292    PRINT PATHSPEC$;" has been mapped to drive ";DRIVENAME$:PRINT
  467. 7300    DEF SEG
  468. 7310    input "<RETURN> to continue.",r$
  469. 7399    RETURN
  470.  
  471.  
  472. 8000    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  473. 8005     CLS
  474. 8010    '  Begin ADD SUBDIRECTORY
  475. 8015    '
  476. 8020    '  makes a subdirectory below the current directory
  477. 8030    '
  478. 8040    ' first get the current drive
  479. 8050    '
  480. 8055    PRINT "Menu Option 8 - ADD SUBDIRECTORY"
  481. 8057    PRINT
  482. 8060    DRIVE% = 0
  483. 8070    DEF SEG = LIBSEG
  484. 8080    CALL GETDRV(DRIVE%)  'DOS Func call 19h
  485. 8090    DEF SEG
  486. 8100    '
  487. 8110    'now get the path base
  488. 8120    '
  489. 8130    RETURNFLAGS% = 0
  490. 8140    DEF SEG = LIBSEG
  491. 8150    CALL DRVMAP(RETURNFLAGS%,DRIVE%)   'Func E9h
  492. 8160    DEF SEG
  493. 8170    BASEFLAG% = RETURNFLAGS%/256 ' the base flag is the high byte of the return
  494. 8180    pathbase% = (RETURNFLAGS% - (BASEFLAG% * 256)) ' the path base is the low byte of the return
  495. 8200    '
  496. 8210    'next we can get the path itself
  497. 8220    '
  498. 8230    FUNC$ = CHR$(1)
  499. 8240    SOURCEBASE$ = CHR$(pathbase%)
  500. 8250    REQPACLENHI$ = CHR$(0)
  501. 8260    REQPACLENLO$ = CHR$(2)
  502. 8270    REQPACKET$ = REQPACLENLO$ + REQPACLENHI$ + FUNC$ + SOURCEBASE$
  503. 8280    REPLY$ = CHR$(&H40) + CHR$(0) + STRING$(64,CHR$(0))
  504. 8290    RETURNCODE% = 0
  505. 8300    DEF SEG = LIBSEG
  506. 8310    CALL DPATH(RETURNCODE%,REQPACKET$,REPLY$)   'Func E2h(01h)
  507. 8320    DEF SEG
  508. 8330    PATH$ = MID$(REPLY$,4,63)
  509. 8340    INCOMING$ = PATH$
  510. 8350    GOSUB 11000  'subroutine to strip nulls from the string
  511. 8360    PATH$ = OUTGOING$
  512. 8400    '
  513. 8410    'Now add the subdirectory
  514. 8420    '
  515. 8440    FUNC$ = CHR$(10)
  516. 8450    ' use the current source base
  517. 8470    INPUT "NAME YOUR SUBDIRECTORY:  ",PATHSPEC$:PRINT
  518. 8480    IF PATHSPEC$ = "" THEN GOTO 8699
  519. 8490    SPECLENGTH$ = CHR$(LEN(PATHSPEC$))
  520. 8500    LOPACLEN$ = CHR$(4+LEN(PATHSPEC$))
  521. 8510    HIPACLEN$ = CHR$(0)
  522. 8520    REQUEST$ = LOPACLEN$ + HIPACLEN$ + FUNC$ + SOURCEBASE$ +CHR$(0) + SPECLENGTH$ + PATHSPEC$
  523. 8530    REPLY$ = CHR$(0) + CHR$(0)
  524. 8540    ERRCODE% = 0
  525. 8550    DEF SEG = LIBSEG
  526. 8560    CALL DPATH(ERRCODE%,REQUEST$,REPLY$)   'Func E2h(0Ah)
  527. 8570    DEF SEG
  528. 8580    IF ERRCODE% <> 0 THEN PRINT:PRINT "Request failed. Error code " ERRCODE%:PRINT:GOTO 8470
  529. 8590    PRINT "'";PATHSPEC$;"'";" was created as a subdirectory in ";PATH$
  530. 8592    PRINT
  531. 8595    INPUT "<RETURN> to continue",S$
  532. 8699    RETURN
  533.  
  534.  
  535.  
  536. 10000 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  537. 10010 ' routines for network use
  538. 10020 '
  539. 10100 '  This file contains the routine names and
  540. 10101 '  offsets for the BASNET library
  541. 10110 XTNDOPN  =   0   'xtndopn(Mode%, Filename$, Handle%, ErrCode%)
  542. 10111 SETATTR  =   3   'setattr(Func%, Filename$, Attribute%, ErrCode%)
  543. 10112 EOJSTAT  =   6   'eojstat(Flag%)
  544. 10113 PRLH.LOG =   9   'PRLH.Log(FileHandle%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
  545. 10114 PRLH.REL =  12   'PRLH.Rel(FileHandle%,HiByteOffset%,LoByteOffset%,ErrCode%)
  546. 10115 PRLH.CLR =  15   'PRLH.Clr(FileHandle%,HiByteOffset%,LoByteOffset%,Errcode%)
  547. 10116 PRLF.LOG =  18   'PRLF.Log(fcb%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
  548. 10117 PRLF.REL =  21   'PRLF.Rel(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
  549. 10118 PRLF.CLR =  24   'PRLF.Clr(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
  550. 10119 PRLS.LCK =  27   'PRLS.Lck(Flags%,TimeOut%,ErrCode%)
  551. 10120 PRLS.REL =  30   'PRLS.Rel(ErrCode%)
  552. 10121 PRLS.CLR =  33   'PRLS.Clr(ErrCode%)
  553. 10122 OPENSEM  =  36   'OpenSem(Sema4$,SemaValu%,HiHandle%,LoHandle%,OpenCnt%,RetCode%)
  554. 10123 EXAMSEM  =  39   'ExamSem(HiHandle%,LoHandle%,SemaValu%,OpenCnt%,RetCode%)
  555. 10124 WAITSEM  =  42   'WaitSem(HiHandle%,LoHandle%,TimeOut%,RetCode%)
  556. 10125 SIGSEM   =  45   'SigSem(HiHandle%,LoHandle%,RetCode%)
  557. 10126 CLOSSEM  =  48   'ClosSem(HiHandle%,LoHandle%,RetCode%)
  558. 10127 SETLCK   =  51   'setlck(Func%,Mode%)
  559. 10128 BAKOUTS  =  54   'Bakouts(Func%,RetCode%)
  560. 10129 BTRANS   =  57   'btran(ReturnCode%, Mode%)
  561. 10130 ETRANS   =  60   'etrans(ReturnCode%)
  562. 10131 EXCLOG   =  63   'exclog(ReturnCode%, FcbAddr)
  563. 10132 EXCLCKS  =  66   'exclcks(ReturnCode%, Mode%)
  564. 10133 EXCULKF  =  69   'exculkf(ReturnCode%, FcbAddr)
  565. 10134 EXCULKS  =  72   'exculks(ReturnCode%)
  566. 10135 EXCCLRF  =  75   'excclrf(ReturnCode%, FcbAddr)
  567. 10136 EXCCLRS  =  78   'excclrs(ReturnCode%)
  568. 10137 RECLOG   =  81   'reclog(ReturnCode%, String$)
  569. 10138 RECLCK   =  84   'reclck(ReturnCode%, Mode%)
  570. 10139 RECULK   =  87   'reculk(ReturnCode%, Semaphore$)
  571. 10140 RECULKS  =  90   'reculks(ReturnCode%)
  572. 10141 RECCLR   =  93   'recclr(ReturnCode%, Semaphore$)
  573. 10142 RECCLRS  =  96   'recclrs(ReturnCode%)
  574. 10143 EOJ      =  99   'eoj(ReturnCode%)
  575. 10144 SYSOUT   = 102   'sysout(ReturnCode%)
  576. 10145 ALLOCR   = 105   'allocr(ReturnCode%, Resource%)
  577. 10146 DALLOCR  = 108   'dallocr(ReturnCode%, Resource%)
  578. 10147 VOLSTAT  = 111   'volstat(volume%, reply$)
  579. 10148 LOCDRV   = 114   'locdrv(NumDisks%)
  580. 10149 WSID     = 117   'wsid(ThisStationNum%)
  581. 10150 ERRMODE  = 120   'errmode(mode%)
  582. 10151 BCSMODE  = 123   'bcsmode(mode%)
  583. 10152 CTLSPL   = 126   'ctlspl(mode%)
  584. 10153 SPLREQ   = 129   'splreq(ErrCode%, RequestBlock$, Reply$)
  585. 10154 PIPREQ   = 132   'pipreq(ErrCode%, RequestBlock$, Reply$)
  586. 10155 DPATH    = 135   'dpath(ReturnCode%, RequestBlock$, Reply$)
  587. 10156 SYSLOG   = 138   'syslog(ReturnCode%, RequestBlock$, Reply$)
  588. 10157 FATTR    = 141   'fattr(ReturnCode%, FcbAddr, Attribute%)
  589. 10158 UPDFCB   = 144   'updfcb(RetCode%,FcbAddr)
  590. 10159 CPYFILE  = 147   'cpyfile(ReturnCode%, FcbSource, FcbDest, CountLow, CountHigh)
  591. 10160 NETTOD   = 150   'nettod(time$)
  592. 10161 CLSMODE  = 153   'clsmode(mode%)
  593. 10162 DRVMAP   = 156   'drvmap(ReturnFlags%, drive%)
  594. 10163 RETSHL   = 159   'retshl(RetCode%, Mode%)
  595. 10164 ASCLOG   = 162   'asclog(RetCode%, Asciiz$)
  596. 10165 ASCULKF  = 165   'asculkf(RetCode%, Asciiz$)
  597. 10166 ASCCLRF  = 168   'ascclrf(RetCode%, Asciiz$)
  598. 10167 GETPSN   = 171   'Get_PSN(StationNo%)
  599. 10168 GETSTA   = 174   'Get_STA(Mode%,Segment%,Offset%)
  600. 10169 SETSERV  = 177   'SetServ(Mode%,NewServ%,CurrServ%)
  601. 10170 MODSERV  = 180   'ModServ(Mode%,NewServ%,RetCode%)
  602. 10171 GETDRV   = 183   'GetDrv(Drive%)
  603. 10200     '
  604. 10210     ' Assign the segment address for the library to the variable LibSeg
  605. 10330     DEF SEG = 0
  606. 10331     SUBOFF = PEEK(&H4F0)+(256*PEEK(&H4F1))
  607. 10332     SUBSEG = PEEK(&H4F2)+(256*PEEK(&H4F3))
  608. 10333     LIBSEG = SUBSEG
  609. 10400     '
  610. 10410     ' set the error mode so its more informative
  611. 10420     DEF SEG = LIBSEG
  612. 10430     NEWMODE% = 1
  613. 10440     CALL ERRMODE(NEWMODE%)
  614. 10450     DEF SEG
  615. 10999 RETURN
  616.  
  617.  
  618. 11000    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  619. 11005    ' routine to strip nulls from the right side of a string
  620. 11010    '
  621. 11020    OUTGOING$ = ""
  622. 11030    I = 0
  623. 11040    CHECKCHAR$ = CHR$(1)
  624. 11050    WHILE CHECKCHAR$ <> CHR$(0)
  625. 11060        I=I+1
  626. 11070        CHECKCHAR$=MID$(INCOMING$,I,1)
  627. 11080        IF CHECKCHAR$ <> CHR$(0) THEN OUTGOING$ = OUTGOING$ + CHECKCHAR$
  628. 11090    WEND
  629. 11999    RETURN
  630.  
  631.  
  632. 16000    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  633. 16010    '
  634. 16100    '  Perform get and display shell tables routine
  635. 16110    '
  636. 16240      def seg = libseg
  637. 16250      call GETSTA(Mode%,DHTsegment%,DHToffset%)   'Func EFh
  638. 16260      def seg
  639. 16265      PRINT TABLENAM$;
  640. 16268      def seg = DHTsegment%
  641. 16270      for x=0 to 22
  642. 16282        IF MODE%=1 THEN PRINT RIGHT$("  " + HEX$(PEEK(DHTOFFSET% + X)),3);:GOTO 16290
  643. 16289        PRINT USING "###";PEEK(DHTOFFSET% + X);
  644. 16290      next x
  645. 16296      PRINT
  646. 16297      PRINT "           ";
  647. 16298      for x=23 to 31
  648. 16300        IF MODE%=1 THEN PRINT RIGHT$("  " + HEX$(PEEK(DHTOFFSET% + X)),3);:GOTO 16310
  649. 16305        PRINT USING "###";PEEK(DHTOFFSET% + X);
  650. 16310      next x
  651. 16315      DEF SEG
  652. 16320      PRINT
  653. 16400      RETURN
  654.  
  655.  
  656. 18000    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  657. 18005     ' set up the request packet to get the net address 
  658. 18010     '   (Function Call E3h(3Dh) also see Function Call Ref pg. 8-5)
  659. 18030     '
  660. 18040     FUNC$ = CHR$(61) 'get a properites value subfunction 3Dh
  661. 18110     OBJTYPE$ = CHR$(0) + CHR$(4)
  662. 18120     OBJNAME$ = SERVERNAME$
  663. 18130     OBJNAMELEN$ = CHR$(LEN(OBJNAME$))
  664. 18140     SEGNUM$ = CHR$(1)
  665. 18150     PROPNAME$ = "NET_ADDRESS"
  666. 18160     PROPLEN$ = CHR$(LEN(PROPNAME$))
  667. 18190     PROPVALREQ$ = FUNC$ + OBJTYPE$ + OBJNAMELEN$ + OBJNAME$ + SEGNUM$ + PROPLEN$ + PROPNAME$
  668. 18192    LGTH$ = CHR$(LEN(PROPVALREQ$))    + CHR$(0)
  669. 18195    PROPVALREQ$ = LGTH$ + PROPVALREQ$
  670. 18200     ' set up the reply buffer
  671. 18210     REPPACLENHI$ = CHR$(0)
  672. 18220     REPPACLENLO$ = CHR$(130)
  673. 18230     PROPVALREPLY$ = REPPACLENLO$ + REPPACLENHI$ + STRING$(130," ")
  674. 18300     'make the bindery request
  675. 18310     DEF SEG = LIBSEG
  676. 18320     CALL SYSLOG(PROPRETCODE%,PROPVALREQ$,PROPVALREPLY$)  'Func E3h(3Dh)
  677. 18330     DEF SEG
  678. 18340     IF PROPRETCODE% <> 0 THEN INPUT "No address was found for that Server. <ENTER>",V$:RETURN
  679. 18345    '
  680. 18350     ' we will put the address in a string to use later
  681. 18360     TARGETADDRESS$ = MID$(PROPVALREPLY$,3,12)
  682. 18370     ' for demo purposes we will print the address if we found one
  683. 18372    NTW$=""
  684. 18375    FOR I = 3 TO 14
  685. 18380        NTW$= NTW$+RIGHT$("00"+HEX$(ASC(MID$(PROPVALREPLY$,I,1))),2)
  686. 18390    NEXT I
  687. 18400    NET$ = MID$(NTW$,1,8): NODE$ = MID$(NTW$,9,12): SOC$ = MID$(NTW$,21,4)
  688. 18430    PRINT "NET is " NET$" NODE is " NODE$" SOCKET is " SOC$
  689. 18440    INPUT " <enter>",V$
  690. 18999     RETURN
  691.