home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lan / basnet / login2.bas < prev    next >
BASIC Source File  |  1987-07-14  |  8KB  |  211 lines
  1. 542     MODE% = 2   'GET THE CURRENT EFFECTIVE SERVER
  2. 543     DEF SEG = LIBSEG
  3. 544     CALL SETSERV(MODE%,DRIVE%,CURR%)
  4. 545     DEF SEG
  5.  
  6. 547    MODE% = 3    'get server mapping table address function
  7. 550    '
  8. 553    DEF SEG = LIBSEG
  9. 557    CALL GETSTA(MODE%, STSEGMENT%, STOFFSET%)  'Func EFh
  10. 560     MODE% = 4
  11. 563     CALL GETSTA(MODE%,STSEGMENT%,NTOFF%)  'Func EFh
  12. 567    DEF SEG = STSEGMENT%
  13. 570    '
  14. 573    ' Now we will display the table contents for demo purposes
  15. 575     LOCATE 13,31
  16. 577     PRINT "Server mapping table contents:": PRINT
  17. 580     FOR I = 0 TO 7
  18. 584      T=15 + I
  19. 585      LOCATE T,30
  20. 586      PRINT I+1;:IF I+1=CURR% THEN PRINT "* "; ELSE PRINT "  ";
  21. 587      FOR X = 0 TO 13
  22. 590        PRINT RIGHT$("00"+HEX$(PEEK(STOFFSET% + (32*I) + X)),2);
  23. 593      NEXT X
  24. 597      PRINT SPC(3);
  25. 600      FOR X = 0 TO 19
  26. 603        A$ = CHR$(PEEK(NTOFF% + (I*48) + X))
  27. 607        IF A$ = CHR$(0) THEN X = 19 ELSE PRINT A$;
  28. 610      NEXT X
  29. 613      PRINT
  30. 617     NEXT I
  31. 650    Input "a to attach or v to view or l to login",r$
  32. 660    if r$="a" then gosub 1000:goto 542
  33. 710    if r$="l" then gosub 4000:goto 542
  34. 720    if r$="v" then 542
  35. 800    end
  36.  
  37. 1000    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  38. 1010    ' Begin ATTACH
  39. 1020    CLS
  40. 1025    PRINT "SERVER NAME
  41. 1030    PRINT "-----------
  42. 1035    PRINT
  43. 1040    LASTOBJECTID$ = STRING$(4,255)
  44. 1045    RETURNCODE% = 0
  45. 1050    PATTERNTYPEHI$ = CHR$(0)
  46. 1055    PATTERNTYPELO$ = CHR$(4)
  47. 1060    REQPACLENHI$ = CHR$(0)
  48. 1065    REQPACLENLO$ = CHR$(9)
  49. 1070    FUNC$ = CHR$(55) 'scan for objects subfunction
  50. 1075    PATTERNLEN$ = CHR$(1)
  51. 1080    PATTERN$ = "*"
  52. 1085    REPPACLENHI$ = CHR$(0)
  53. 1090    REPPACLENLO$ = CHR$(57)
  54. 1095    WHILE RETURNCODE% <> 252
  55. 1100      'set up the request buffer
  56. 1105      OBJREQ$ = REQPACLENLO$ + REQPACLENHI$ + FUNC$ + LASTOBJECTID$ + PATTERNTYPEHI$ + PATTERNTYPELO$ + PATTERNLEN$ + PATTERN$
  57. 1110      'set up the reply buffer
  58. 1115      OBJREPLY$ = REPPACLENLO$ + REPPACLENHI$ + STRING$((ASC(REPPACLENHI$)*256) + ASC(REPPACLENLO$),"x")
  59. 1120      'make the bindery request
  60. 1125      DEF SEG = LIBSEG
  61. 1130      CALL SYSLOG(RETURNCODE%,OBJREQ$,OBJREPLY$)
  62. 1135      DEF SEG
  63. 1140      IF RETURNCODE% <> 252 THEN PRINT MID$(OBJREPLY$,9,48) ELSE OBJREPLY$ = STRING$(60,CHR$(0))
  64. 1145      LASTOBJECTID$ = MID$(OBJREPLY$,3,4)
  65. 1150    WEND
  66. 1155    print
  67. 1160    INPUT "Enter file server name you wish to attach to: ",SERVERNAME$
  68. 1165    IF SERVERNAME$ = "" THEN GOTO 1999
  69. 1170    ' now get the net address of the server
  70. 1175    GOSUB 18000
  71. 1180    IF PROPRETCODE% <> 0 THEN GOTO 1999
  72. 1190    '
  73. 1210    ' now check the table for target server match and an open entry to use
  74. 1220    SERVERMATCH% = 0: INSERT% = 0
  75. 1225    DEF SEG = STSEGMENT%
  76. 1230    FOR ENTRY% = 7 TO 0 STEP -1
  77. 1250        IF PEEK(STOFFSET% + (32 * ENTRY%)) <> 255 THEN INSERT% = ENTRY%+1: GOTO 1280
  78. 1251          DMY$ = ""
  79. 1252          FOR I = 2 TO 13
  80. 1254            DMY$ = DMY$ + CHR$(PEEK(STOFFSET%+32*ENTRY%+I))
  81. 1256          NEXT I
  82. 1258          IF TARGETADDRESS$ = DMY$ THEN SERVERMATCH% = ENTRY% + 1: GOTO 1290
  83. 1280    NEXT
  84. 1290    DEF SEG
  85. 1295    IF SERVERMATCH% THEN INPUT "That server is in the table. <enter>",V$:GOTO 1999
  86. 1400    '
  87. 1405    ' we now need to insert our server address into the table.
  88. 1410    '
  89. 1500    IF INSERT% = 0 THEN INPUT "There are no free entries. <enter>",V$: GOTO 1999
  90. 1520    TARGETBASEADD% = STOFFSET% + (32 * (INSERT% -1))
  91. 1590    DEF SEG = STSEGMENT%
  92. 1600    FOR CHARNO% = 1 TO 12
  93. 1620            THISCHAR% = ASC(MID$(TARGETADDRESS$,CHARNO%,1))
  94. 1630        THISADD% = TARGETBASEADD%  + CHARNO% + 1
  95. 1640        POKE THISADD%,THISCHAR%
  96. 1660    NEXT
  97. 1662    FOR X% = 1 TO LEN(SERVERNAME$)
  98. 1664       THISCHAR% = ASC(MID$(SERVERNAME$,X%,1))
  99. 1665       THISADDR% = STOFFSET% + 8*32 + (INSERT% - 1)*48 + X% - 1
  100. 1666       POKE THISADDR%,THISCHAR%
  101. 1668    NEXT
  102. 1669    POKE THISADDR%+1,0
  103. 1670    DEF SEG
  104. 1700    '
  105. 1705    ' now we need to set the order numbers for the server mapping table
  106. 1710    SLOT% = 1     'initialize the variable for a value higher than the table can hold
  107. 1715    DEF SEG = STSEGMENT%
  108. 1720    FOR CHKENTRY% = 0 TO 7
  109. 1730        THISOFF% = STOFFSET% + (32*CHKENTRY%)            
  110. 1740        IF PEEK(THISOFF%) <> 255 THEN GOTO 1770
  111. 1745              DMY$ = ""
  112. 1750          FOR I = 2 TO 13
  113. 1752                DMY$ = DMY$ + CHR$(PEEK(THISOFF% + I))
  114. 1754              NEXT
  115. 1756              IF TARGETADDRESS$ > DMY$ THEN SLOT% = SLOT% + 1: GOTO 1770
  116. 1758              POKE THISOFF%+1,PEEK(THISOFF%+1)+1
  117. 1770    NEXT
  118. 1780    '
  119. 1810    ' we need to set the in use flag for our new entry and the new order #
  120. 1830    POKE TARGETBASEADD%, 255:POKE TARGETBASEADD%+1,SLOT%
  121. 1890    '
  122. 1900    ' finally, we must make the call to attach to our new server
  123. 1905    '   (Function Call F1h)
  124. 1910    MODE% = 0 'mode to create an attachment
  125. 1920    RETCODE% = 0
  126. 1930    DEF SEG = LIBSEG
  127. 1940    CALL MODSERV(MODE%,SLOT%,RETCODE%)   'Func F1h
  128. 1950    DEF SEG
  129. 1960    IF RETCODE% <> 0 THEN INPUT "Attempt to attach failed <RETURN> to continue.",R$
  130. 1999    return
  131.  
  132. 4000    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  133. 4005    '  Begin LOGIN
  134. 4010    '
  135. 4020    ' first we need to select the file server which is the target
  136. 4030    ' of our request
  137. 4040    '
  138. 4041    LOCATE 24,1
  139. 4042    INPUT "Enter slot # of the server to be logged in to: ",SLOT$
  140. 4043    IF SLOT$ = "" THEN 4999
  141. 4044    SLOT% = VAL(SLOT$)
  142. 4046    IF (SLOT%<1) OR (SLOT%>8) THEN GOTO 4041
  143. 4050    MODE% = 0 'mode to set the preferred file server
  144. 4060    def seg=libseg
  145. 4070    CALL SETSERV(MODE%,SLOT%,CURRENTSERVER%)   'Func F0h(00H)
  146. 4080    def seg
  147. 4072    mode% = 2
  148. 4073    def seg=libseg
  149. 4074    call setserv(mode%,slot%,currentserver%)   'Func f0h(02h)
  150. 4076    def seg
  151. 4080    Print "Current Server is ",currentserver%
  152. 4200    ' and now we will log in
  153. 4210    ' set up the request packet
  154. 4212    INPUT "Enter login name: ",LOGNAME$
  155. 4214    input "Enter password: ",password$
  156. 4220    REQPACLENHI$ = CHR$(0)
  157. 4230    REQPACLENLO$ = CHR$(LEN(LOGNAME$)+Len(password$)+3)
  158. 4240    FUNC$ = CHR$(0) 'login subfunction
  159. 4250    LOGNAMELEN$ = CHR$(LEN(LOGNAME$))
  160. 4270    PASSWORDLEN$ = CHR$(len(password$))
  161. 4290    REQPACKET$ = REQPACLENLO$+REQPACLENHI$+FUNC$+LOGNAMELEN$+LOGNAME$+PASSWORDLEN$+Password$
  162. 4300    ' set up the reply buffer
  163. 4310    REPPACLENHI$ = CHR$(0)
  164. 4320    REPPACLENLO$ = CHR$(20)
  165. 4330    REPLYPACKET$ = REPPACLENLO$+REPPACLENHI$
  166. 4340    'make the login request
  167. 4350    DEF SEG = LIBSEG
  168. 4360    CALL SYSLOG(ERRCODE%,REQPACKET$,REPLYPACKET$)   'Func E3h(00h)
  169. 4370    DEF SEG
  170. 4380    IF ERRCODE% <> 0 THEN PRINT "Error -> "ERRCODE%: INPUT "<enter>",V$: GOTO 4041
  171. 4390    INPUT "login successful <enter>",v$    
  172. 4999    return
  173.  
  174.  
  175. 18000    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  176. 18005     ' set up the request packet to get the net address 
  177. 18010     '   (Function Call E3h(3Dh) also see Function Call Ref pg. 8-5)
  178. 18030     '
  179. 18040     FUNC$ = CHR$(61) 'get a properites value subfunction 3Dh
  180. 18110     OBJTYPE$ = CHR$(0) + CHR$(4)
  181. 18120     OBJNAME$ = SERVERNAME$
  182. 18130     OBJNAMELEN$ = CHR$(LEN(OBJNAME$))
  183. 18140     SEGNUM$ = CHR$(1)
  184. 18150     PROPNAME$ = "NET_ADDRESS"
  185. 18160     PROPLEN$ = CHR$(LEN(PROPNAME$))
  186. 18190     PROPVALREQ$ = FUNC$ + OBJTYPE$ + OBJNAMELEN$ + OBJNAME$ + SEGNUM$ + PROPLEN$ + PROPNAME$
  187. 18192    LGTH$ = CHR$(LEN(PROPVALREQ$))    + CHR$(0)
  188. 18195    PROPVALREQ$ = LGTH$ + PROPVALREQ$
  189. 18200     ' set up the reply buffer
  190. 18210     REPPACLENHI$ = CHR$(0)
  191. 18220     REPPACLENLO$ = CHR$(130)
  192. 18230     PROPVALREPLY$ = REPPACLENLO$ + REPPACLENHI$ + STRING$(130," ")
  193. 18300     'make the bindery request
  194. 18310     DEF SEG = LIBSEG
  195. 18320     CALL SYSLOG(PROPRETCODE%,PROPVALREQ$,PROPVALREPLY$)  'Func E3h(3Dh)
  196. 18330     DEF SEG
  197. 18340     IF PROPRETCODE% <> 0 THEN INPUT "No address was found for that Server. <ENTER>",V$:RETURN
  198. 18345    '
  199. 18350     ' we will put the address in a string to use later
  200. 18360     TARGETADDRESS$ = MID$(PROPVALREPLY$,3,12)
  201. 18370     ' for demo purposes we will print the address if we found one
  202. 18372    NTW$=""
  203. 18375    FOR I = 3 TO 14
  204. 18380        NTW$= NTW$+RIGHT$("00"+HEX$(ASC(MID$(PROPVALREPLY$,I,1))),2)
  205. 18390    NEXT I
  206. 18400    NET$ = MID$(NTW$,1,8): NODE$ = MID$(NTW$,9,12): SOC$ = MID$(NTW$,21,4)
  207. 18430    PRINT "NET is " NET$" NODE is " NODE$" SOCKET is " SOC$
  208. 18440    INPUT " <enter>",V$
  209. 18999     RETURN
  210.  
  211.