'===========================================================================
' Subject: PB NET STUFF                       Date: 06-07-93 (4:47)        
'  Author: Erik Olson                         Code: PB                     
'  Origin: Rolf@ice.prima.ruhr.de           Packet: NETWORK.ABC
'===========================================================================
CLS
PRINT "NetStuff - based on QuickBASIC code by Chip Morrow"
PRINT "Adapted to PowerBASIC (6/7/93) by Erik Olson"
PRINT
PRINT "--------------------------------------------------"
PRINT

SOUND 5000,.5

IF NOT NetBios% THEN PRINT "NetBIOS Not Installed.":END
   PRINT "NetBIOS is installed."

   '........................................... Get the Local Machine Name
   Q% = NetName%(Machine$)
   PRINT "Current machine name is: "; Machine$


   '............................................ List current redirections
   Index% = 0
   DO
     GetDevice Index%, D$, N$
     IF D$ = "" THEN EXIT DO
     PRINT D$; " is redirected to "; N$
     INCR Index%
   LOOP
   PRINT

   '.................................................. List logged servers
   ' this routine uses sub function 80 of function 5F of int 21, which
   ' is not documented, so I assume that it's proprietary to LANtastic
   Index% = 0
   DO
     LoggedIn Index%, Logg$
     IF Logg$ = "" THEN EXIT DO
     PRINT "Logged into: "; Logg$
     INCR Index%
   LOOP
   IF Index%=0 THEN PRINT "You are not logged into any servers. (Lantastic only?)"
   PRINT

   '.................................. List available (not logged) servers
   ' this routine uses sub function 84 of function 5F of int 21, which
   ' is not documented, so I assume that it's proprietary to LANtastic
   Index% = 0
   DO
     Inactive Index%, Logg$
     IF Logg$ = "" THEN EXIT DO
     PRINT "Available: "; Logg$
     INCR index%
   LOOP
   IF Index%=0 THEN PRINT "All availabler servers are logged in. (Lantastic only?)"
   PRINT

DELAY 1:SOUND 1000,.5

' --------------------------------------------------------------------
' Quickie implementation of Redirect and NetCancel routines.
' Device name to redirect or cancel should be c:, d:, prn, lpt:, etc.
' Server's path should be full path, such as \\node1\cdrive
' --------------------------------------------------------------------

  PRINT "R)edirect, C)ancel redirection, or Q)uit : ";
  DO
    Z$ = UCASE$(INKEY$)
    SELECT CASE Z$
      CASE "R", "C", "Q": EXIT DO
    END SELECT
  LOOP
       PRINT Z$
       SELECT CASE Z$:
	 CASE "R":                                            ' Redirect
	    PRINT "Drive letter or logical device ---> ";
	    LINE INPUT "", ReDir$
	    PRINT "Server's path to use -------------> ";
	    LINE INPUT "", SPath$
	    PRINT "Device type = P)rinter, or D)isk -> ";
	    DO
	      Z$ = UCASE$(INKEY$)
	      SELECT CASE Z$
		CASE "P", "D": EXIT DO
	      END SELECT
	    LOOP
	    PRINT Z$
	    SELECT CASE Z$
	      CASE "P":  DevType% = 3            ' 3 = printer
	      CASE ELSE: DevType% = 4            ' 4 = disk
	    END SELECT
	    Redirect DevType%, ReDir$, SPath$     ' Do it.
	    IF DevType% > 0 THEN                  ' Devtype = 0 if no error.
	       PRINT "Error"; DevType%;
	       PRINT " - no redirection performed."
	    ELSE
	       PRINT "Redirection successful."
	    END IF
	    PRINT
	 CASE "C":                                          ' Cancel
	    PRINT "Drive letter or logical device --> ";
	    LINE INPUT "", DevName$
	    Z% = NetCancel%(DevName$)            ' Do it.
	    IF Z% > 0 THEN                       ' Z = 0 if no error.
	       PRINT "Error"; Z%; " - unable to cancel redirection."
	    ELSE
	       PRINT "Redirection successfully cancelled."
	    END IF
	    PRINT
	 CASE "Q", CHR$(27):            ' Quit
	   END
       END SELECT
SOUND 1000,.5:DELAY 1:SOUND 100,.5
RUN

' End sample.  Subs & functions follow.

' **************************************************************************

SUB GetDevice (DeviceNum%, DevName$, NetPath$)   ' Get redirected device entry.
  '
  ' DeviceNum% begins at zero (for first entry).
  ' DevName$ is returned as the name of the redirected device.
  ' NetPath$ is returned as the name of the server's network path.
  '
  ' DevName$ is returned as a nul string if DeviceNum is invalid.
  '
  DevNam$ = SPACE$(16)
  NetPat$ = SPACE$(128)
  REG 1, &H5F02
  REG 2, DeviceNum%

  REG 8, STRSEG(DevNam$) 'DS
  REG 5, STRPTR(DevNam$) 'SI
  REG 9, STRSEG(NetPat$) 'ES
  REG 6, STRPTR(NetPat$) 'DI
  CALL INTERRUPT &H21
  Strip DevNam$, DevName$
  Strip NetPat$, NetPath$
END SUB

SUB Inactive (EntryNum%, Returned$)
  '
  ' Display a list of servers that are available, but that you haven't
  ' logged into.
  '
  ' EntryNum% is input to the routine, and begins at zero (for first entry).
  ' Returned$ is returned as the name of the server, or as "" if an invalid
  '           EntryNum is passed.
  '
  CurrentEntry$=SPACE$(16)
  Reg 1, &H5F84
  Reg 2, EntryNum%
  Reg 9, STRSEG(CurrentEntry$)  ' ES
  REG 6, STRPTR(CurrentEntry$)  ' DI
  CALL INTERRUPT &H21
  Strip CurrentEntry$, Returned$
  IF Returned$ <> "" THEN
     Returned$ = "(" + Returned$ + ")"
  END IF
END SUB

SUB LoggedIn (EntryNum%, Logged$)
  '
  ' Display a list of servers that you're currently logged into.
  ' EntryNum% begins at zero (for first entry).
  ' Logged$ returns the server name, or a nul string if invalid EntryNum.
  '
  CurrentEntry$=SPACE$(16)
  REG 1, &H5F80
  REG 2, EntryNum%
  REG 9, STRSEG(CurrentEntry$) 'ES
  REG 6, STRPTR(CurrentEntry$) 'DI
  CALL INTERRUPT &H21
  Strip CurrentEntry$, Logged$
END SUB

FUNCTION NetBios%                     ' Determine if NetBios is present.
   Reg 1, 0
   CALL INTERRUPT &H2A
   AH = Reg(1) \ 256
   IF AH = 0 THEN
      NetBios% = 0
   ELSE
      NetBios% = -1
   END IF
END FUNCTION

FUNCTION NetCancel% (DevName$)                  ' Cancel device redirection.
  '
  ' Cancel redirection of a device.
  ' DevName$ is device name to cancel redirection for,
  ' NetCancel% returns an error code if unsuccessful, zero otherwise.
  '
  Reg 1, &H5F04
  Reg 8, STRSEG(DevName$) 'DS
  Reg 5, STRPTR(DevName$) 'SI
  CALL INTERRUPT &H21
  IF (REG(0) AND 1) THEN
     NetCancel% = REG(1)
  ELSE
     NetCancel% = 0
  END IF
END FUNCTION

FUNCTION NetName% (Machine$)          ' Get current machine name.
  '
  ' This routine takes no inputs.  It returns:
  '
  ' NetName% is the machine number (or zero if error)
  ' Machine$ is the current machine name.
  '
  MName$ = SPACE$(16)
  REG 1, &H5E00
  REG 8, STRSEG(MName$) 'DS
  REG 4, STRPTR(MName$) 'DX (that's right)
  CALL INTERRUPT &H21
  IF (REG(0) AND 1) THEN       ' Carry flag is set. (Error)
     NetName% = 0
     LSET MName$ = "N/A"
     Strip MName$, Machine$
     EXIT FUNCTION
  END IF
  CH = REG(3) \ 256
  IF CH = 0 THEN
     NetName% = 0
     EXIT FUNCTION
  END IF
  NetName% = REG(3) - (CH * 256)    ' CL
  Strip MName$, Machine$
END FUNCTION

SUB Redirect (DevType%, DevName$, NetPath$)      ' Redirect a device
  '
  ' Inputs:
  '
  ' DevType% = 3 for Printer device, or
  '            4 for disk device.
  '            DevName$ = "C:", "D:", "LPT1:", etc.
  '            NetPath$ = Server's network path to redirect, in the format:
  '                       \\server_name\device_name
  ' -----------------------------------------------------------------------
  ' OutPut:
  '
  ' DevType% returns zero if no error, or error number if one occurred.
  '
  DevNam$ = DevName$ + CHR$(0,0,0)
  NetPat$ = NetPath$ + CHR$(0,0,0)
  REG 1, &H5F03
  REG 2, DevType%
  REG 3, 0
  REG 8, STRSEG(DevNam$) ' DS
  REG 5, STRPTR(DevNam$) ' SI
  REG 9, STRSEG(NetPat$) ' ES
  REG 6, STRPTR(NetPat$) ' DI
  CALL INTERRUPT &H21
  DevType% = 0
  IF (REG(0) AND 1) THEN     ' Carry flag indicates error.
     DevType%=REG(1)
  END IF
END SUB

SUB Strip (A$, B$)
   B$=REMOVE$(A$, ANY CHR$(0,9,32,255))
END SUB