home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / qbnewsl / qbnws302 / lantasti / lanstat.bas
BASIC Source File  |  1991-09-29  |  11KB  |  326 lines
  1. ' LANSTAT.BAS - LANTastic function calls for QB. - Chip Morrow
  2. '
  3. ' Compile/Link via:
  4. '
  5. '    QB LANSTAT /O;
  6. '    LINK LANSTAT,,NUL,QB;
  7. '
  8. ' $INCLUDE: 'QB.BI'                       ' INTERRUPT Types/Declares
  9. '
  10. DEFINT A-Z                                ' Everybody's an integer
  11.  
  12. DECLARE FUNCTION NetBios% ()
  13. DECLARE FUNCTION NetCancel% (DevName$)
  14. DECLARE FUNCTION NetName% (Machine$)
  15. DECLARE SUB GetDevice (DeviceNum%, DevName$, NetPath$)
  16. DECLARE SUB Inactive (EntryNum%, Returned$)
  17. DECLARE SUB LoggedIn (EntryNum%, LogName$)
  18. DECLARE SUB NetVersion (Major%, Minor%)
  19. DECLARE SUB Redirect (DevType%, DevName$, NetPath$)
  20. DECLARE SUB Strip (A$, B$)
  21.  
  22. COMMON SHARED Registers AS RegType        ' Pass Registers TYPE variable to
  23.                                           ' all subs/functions.
  24.  
  25. ' Sample implementation of most of these routines follows.
  26. ' (Similar to LANTastic's "NET SHOW" command).
  27.  
  28. PRINT "LANStat - your current status on a LANTastic network."
  29. PRINT
  30.  
  31. IF NetBios THEN                            ' Determine if netbios is present.
  32.    Q = NetName(Machine$)                   ' Get machine name.
  33.    NetVersion Major, Minor                 ' Get major and minor version #'s.
  34.    PRINT "   LANTastic version is: ";                     ' Display results..
  35.    PRINT LTRIM$(STR$(Major)); "."; LTRIM$(STR$(Minor))    ' ...
  36.    PRINT "Current machine name is: "; Machine$            ' ...
  37.    PRINT                                                  ' ...
  38.  
  39.    ' ---------------------------------------------------------------------
  40.    ' First, get a list of devices that you are redirecting to this station.
  41.    ' ---------------------------------------------------------------------
  42.  
  43.    Index = 0                            ' Always start at zero.
  44.  
  45.    DO                                   ' Start looping...
  46.      GetDevice Index, D$, N$               ' Get current device redirection.
  47.      IF D$ = "" THEN EXIT DO               ' Jump out if nothing on this pass
  48.      PRINT D$; " is redirected to "; N$    ' Display results from GetDevice.
  49.      Index = Index + 1                     ' Increment index.
  50.    LOOP                                 ' Get next device entry.
  51.  
  52.    ' ------------------------------------------------------------------
  53.    ' Next, get a list of server names that you're currently logged into.
  54.    ' ------------------------------------------------------------------
  55.  
  56.    PRINT
  57.    Index = 0                            ' Reset our index
  58.  
  59.    DO                                   ' Start looping...
  60.      LoggedIn Index, Log$                  ' Get a server name
  61.      IF Log$ = "" THEN EXIT DO             ' Jump out if nothing on this pass
  62.      PRINT "Logged into: "; Log$           ' Display result from LoggedIn.
  63.      Index = Index + 1                     ' Increment index.
  64.    LOOP                                 ' Get next server name.
  65.  
  66.    ' --------------------------------------------------------------------
  67.    ' Now get a list of available servers that you haven't yet logged into.
  68.    ' --------------------------------------------------------------------
  69.  
  70.    PRINT
  71.    Index = 0                            ' Reset our index
  72.  
  73.    DO                                   ' Start looping...
  74.      Inactive Index, Log$                  ' Get inactive server name
  75.      IF Log$ = "" THEN EXIT DO             ' If nothing, jump out
  76.      PRINT "Available: "; Log$             ' Display result from Inactive
  77.      Index = Index + 1                     ' Increment index
  78.    LOOP                                 ' Get next server name
  79.  
  80. ELSE                                    ' No netbios present, so get out.
  81.  
  82.    PRINT "NetBios not installed."
  83.    END
  84.  
  85. END IF
  86.  
  87. ' --------------------------------------------------------------------
  88. ' Quickie implementation of Redirect and NetCancel routines.
  89. ' Device name to redirect or cancel should be c:, d:, prn, lpt:, etc.
  90. ' Server's path should be full path, such as \\node1\cdrive
  91. ' --------------------------------------------------------------------
  92.  
  93. DO
  94.  
  95.   PRINT "R)edirect, C)ancel redirection, or Q)uit : ";
  96.  
  97.   DO
  98.     Z$ = UCASE$(INKEY$)
  99.     SELECT CASE Z$
  100.       CASE "R", "C", "Q": EXIT DO
  101.     END SELECT
  102.   LOOP
  103.  
  104.        PRINT Z$
  105.  
  106.        SELECT CASE Z$:
  107.  
  108.      CASE "R":                                            ' Redirect
  109.         PRINT "Drive letter or logical device ---> ";
  110.         LINE INPUT "", ReDir$
  111.         PRINT "Server's path to use -------------> ";
  112.         LINE INPUT "", SPath$
  113.         PRINT "Device type = P)rinter, or D)isk -> ";
  114.         DO
  115.           Z$ = UCASE$(INKEY$)
  116.           SELECT CASE Z$
  117.         CASE "P", "D": EXIT DO
  118.           END SELECT
  119.         LOOP
  120.         PRINT Z$
  121.         SELECT CASE Z$
  122.           CASE "P":  DevType = 3            ' 3 = printer
  123.           CASE ELSE: DevType = 4            ' 4 = disk
  124.         END SELECT
  125.  
  126.         Redirect DevType, ReDir$, SPath$    ' Do it.
  127.  
  128.         IF DevType > 0 THEN                 ' Devtype = 0 if no error.
  129.            PRINT "Error"; DevType;
  130.            PRINT " - no redirection performed."
  131.         ELSE
  132.            PRINT "Redirection successful."
  133.         END IF
  134.         PRINT
  135.  
  136.      CASE "C":                                          ' Cancel
  137.         PRINT "Drive letter or logical device --> ";
  138.         LINE INPUT "", DevName$
  139.  
  140.         Z = NetCancel(DevName$)            ' Do it.
  141.  
  142.         IF Z > 0 THEN                      ' Z = 0 if no error.
  143.            PRINT "Error"; Z; " - unable to cancel redirection."
  144.         ELSE
  145.            PRINT "Redirection successfully cancelled."
  146.         END IF
  147.         PRINT
  148.  
  149.      CASE "Q", CHR$(27):            ' Quit
  150.        EXIT DO
  151.  
  152.        END SELECT
  153.  
  154. LOOP
  155.  
  156. END
  157.  
  158. ' End sample.  Subs & functions follow.
  159.  
  160. ' **************************************************************************
  161.  
  162. SUB GetDevice (DeviceNum%, DevName$, NetPath$)   ' Get redirected device entry.
  163.   '
  164.   ' DeviceNum% begins at zero (for first entry).
  165.   ' DevName$ is returned as the name of the redirected device.
  166.   ' NetPath$ is returned as the name of the server's network path.
  167.   '
  168.   ' DevName$ is returned as a nul string if DeviceNum is invalid.
  169.   '
  170.   DIM DevNam AS STRING * 16
  171.   DIM NetPat AS STRING * 128
  172.   Registers.ax = &H5F02
  173.   Registers.bx = DeviceNum
  174.   Registers.si = VARPTR(DevNam)
  175.   Registers.di = VARPTR(NetPat)
  176.   INTERRUPT &H21, Registers, Registers
  177.   Strip DevNam, DevName$
  178.   Strip NetPat, NetPath$
  179. END SUB
  180.  
  181. SUB Inactive (EntryNum%, Returned$)
  182.   '
  183.   ' Display a list of servers that are available, but that you haven't
  184.   ' logged into.
  185.   '
  186.   ' EntryNum% is input to the routine, and begins at zero (for first entry).
  187.   ' Returned$ is returned as the name of the server, or as "" if an invalid
  188.   '           EntryNum is passed.
  189.   '
  190.   DIM CurrentEntry AS STRING * 16
  191.   Registers.ax = &H5F84
  192.   Registers.bx = EntryNum
  193.   Registers.di = VARPTR(CurrentEntry)
  194.   INTERRUPT &H21, Registers, Registers
  195.   Strip CurrentEntry, Returned$
  196.   IF Returned$ <> "" THEN
  197.      Returned$ = "(" + Returned$ + ")"
  198.   END IF
  199. END SUB
  200.  
  201. SUB LoggedIn (EntryNum%, Logged$)
  202.   '
  203.   ' Display a list of servers that you're currently logged into.
  204.   ' EntryNum% begins at zero (for first entry).
  205.   ' Logged$ returns the server name, or a nul string if invalid EntryNum.
  206.   '
  207.   DIM CurrentEntry AS STRING * 16
  208.   Registers.ax = &H5F80
  209.   Registers.bx = EntryNum
  210.   Registers.di = VARPTR(CurrentEntry)
  211.   INTERRUPT &H21, Registers, Registers
  212.   Strip CurrentEntry, Logged$
  213. END SUB
  214.  
  215. FUNCTION NetBios%                     ' Determine if NetBios is present.
  216.    '
  217.    ' NetBios =  0 (Not installed), or
  218.    '           -1 (Installed).
  219.    '
  220.    Registers.ax = 0
  221.    INTERRUPT &H2A, Registers, Registers
  222.    AH = Registers.ax \ 256
  223.    IF AH = 0 THEN
  224.       NetBios% = 0
  225.    ELSE
  226.       NetBios% = -1
  227.    END IF
  228. END FUNCTION
  229.  
  230. FUNCTION NetCancel% (DevName$)                  ' Cancel device redirection.
  231.   '
  232.   ' Cancel redirection of a device.
  233.   ' DevName$ is device name to cancel redirection for,
  234.   ' NetCancel% returns an error code if unsuccessful, zero otherwise.
  235.   '
  236.   Registers.ax = &H5F04
  237.   Registers.si = SADD(DevName$)
  238.   INTERRUPT &H21, Registers, Registers
  239.   IF Registers.flags AND 1 THEN
  240.      NetCancel% = Registers.ax
  241.   ELSE
  242.      NetCancel% = 0
  243.   END IF
  244. END FUNCTION
  245.  
  246. FUNCTION NetName% (Machine$)          ' Get current machine name.
  247.   '
  248.   ' This routine takes no inputs.  It returns:
  249.   '
  250.   ' NetName% is the machine number (or zero if error)
  251.   ' Machine$ is the current machine name.
  252.   '
  253.   DIM MName AS STRING * 16
  254.   Registers.ax = &H5E00
  255.   Registers.dx = VARPTR(MName)
  256.   INTERRUPT &H21, Registers, Registers
  257.   IF Registers.flags AND 1 THEN       ' Carry flag is set. (Error)
  258.      NetName% = 0
  259.      LSET MName = "N/A"
  260.      Strip MName, Machine$
  261.      EXIT FUNCTION
  262.   END IF
  263.   CH = Registers.cx \ 256
  264.   IF CH = 0 THEN
  265.      NetName = 0
  266.      EXIT FUNCTION
  267.   END IF
  268.   NetName = Registers.cx - (CH * 256)    ' CL
  269.   Strip MName, Machine$
  270. END FUNCTION
  271.  
  272. SUB NetVersion (Major%, Minor%)          ' Determine LANTastic version.
  273.   '
  274.   ' Nothing is input to the routine.
  275.   ' Major%  and  Minor% are returned as the version numbers.
  276.   ' (Version 2.57 would be returned as Major = 2, Minor = 57)
  277.   '
  278.   Registers.ax = &HB809
  279.   INTERRUPT &H2F, Registers, Registers
  280.   Major% = Registers.ax \ 256            ' AH
  281.   Minor% = Registers.ax - (Major * 256)  ' AL
  282. END SUB
  283.  
  284. SUB Redirect (DevType%, DevName$, NetPath$)      ' Redirect a device
  285.   '
  286.   ' Inputs:
  287.   '
  288.   ' DevType% = 3 for Printer device, or
  289.   '            4 for disk device.
  290.   '            DevName$ = "C:", "D:", "LPT1:", etc.
  291.   '            NetPath$ = Server's network path to redirect, in the format:
  292.   '                       \\server_name\device_name
  293.   ' -----------------------------------------------------------------------
  294.   ' OutPut:
  295.   '
  296.   ' DevType% returns zero if no error, or error number if one occurred.
  297.   '
  298.   DIM DevNam AS STRING * 16
  299.   DIM NetPat AS STRING * 128
  300.   LSET DevNam = DevName$ + CHR$(0)
  301.   LSET NetPat = NetPath$ + CHR$(0)
  302.   Registers.ax = &H5F03
  303.   Registers.bx = DevType
  304.   Registers.cx = 0
  305.   Registers.si = VARPTR(DevNam)
  306.   Registers.di = VARPTR(NetPat)
  307.   INTERRUPT &H21, Registers, Registers           ' Duitoit.
  308.   DevType = 0
  309.   IF Registers.flags AND 1 THEN                  ' Carry flag indicates error.
  310.      DevType = Registers.ax
  311.   END IF
  312. END SUB
  313.  
  314. SUB Strip (A$, B$)                         ' Kludge to trim down fixed-length
  315.                        ' strings.
  316.    B$ = ""
  317.    FOR Z = 1 TO LEN(A$)
  318.       C$ = MID$(A$, Z, 1)
  319.       IF C$ <> " " AND C$ <> CHR$(0) THEN
  320.      B$ = B$ + C$
  321.       END IF
  322.    NEXT
  323.  
  324. END SUB
  325.  
  326.