'===========================================================================
' Subject: RETURN USER NAME ON NETWORK        Date: 09-10-97 (20:05)       
'  Author: Scott Slater                       Code: QB, PDS                
'  Origin: captain@usaor.net                Packet: NETWORK.ABC
'===========================================================================
' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
' Program Title: WHO_QB.BAS
'     Copyright: Donated to PUBLIC DOMAIN By Scott Slater
'        Author: Scott Slater
' Last Modified: 09/10/1997
' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
'   Description: Similar to Novell's WHOAMI but written in QuickBASIC!
' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
'         Notes: Just tinkering may be useful later on.
' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
'       History: none, but look for a PowerBASIC version also.
' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

' Change the INCLUDE to QBX.BI for PDS

'$INCLUDE: 'QB.BI'

DEFINT A-Z

DECLARE FUNCTION GetConNum% ()
DECLARE FUNCTION GetConStat$ (ConNum%)

Connection% = GetConNum%

IF Connection% THEN
   PRINT "Logical Connection Number"; Connection%
ELSE
   PRINT "Not connected"
   END
END IF


'  The function  GetConStat$ will return either a nul string if there is no
'connection or login, or it will return a 62 byte string that can be broken
'down as follows:
'
'   Offset    Size    Description
'   00h       DWORD   unique user ID
'   04h       WORD    user type
'   06h   48  BYTEs   user name
'   36h    7  BYTEs   login time
'   3Dh       BYTE    reserved
'

cs$ = GetConStat$(Connection%)

IF cs$ = "" THEN                       ' see if we are connected if cs$ is
   PRINT "Not logged in"               ' NUL, we aren't logged in.
ELSE                                   ' otherwise we are
   li$ = MID$(cs$, 55, 7)              ' fill the login time buffer
   PRINT "UserName    : "; MID$(cs$, 7, 48) ' show the current username
   PRINT "Login time  : ";
   work = ASC(MID$(li$, 4, 1))         ' get the hour of login
   nm$ = LTRIM$(RTRIM$(STR$(work)))    ' convert it to a string
   IF work < 10 THEN nm$ = "0" + nm$   ' if single digit add a preceeding 0
   PRINT nm$; ":";                     ' print the hour
   work = ASC(MID$(li$, 5, 1))         ' get the minute of login
   nm$ = LTRIM$(RTRIM$(STR$(work)))    ' convert it to a string
   IF work < 10 THEN nm$ = "0" + nm$   ' if single digit add a preceeding 0
   PRINT nm$; ":";                     ' print minutes
   work = ASC(MID$(li$, 6, 1))         ' get the second of login
   nm$ = LTRIM$(RTRIM$(STR$(work)))    ' convert it to a string
   IF work < 10 THEN nm$ = "0" + nm$   ' if single digit add a preceeding 0
   PRINT nm$                           ' finaly, print the seconds
END IF

PRINT                                  ' extra line

END                                    ' see ya!

FUNCTION GetConNum%

   DIM inreg AS RegTypeX
   DIM outreg AS RegTypeX


   ' NetWare CONNECTION SERVICES - GET CONNECTION NUMBER Function DCh

   inreg.ax = &HDC00                   ' Function DCh
   InterruptX &H21, inreg, outreg      ' call interrupt 21h
   Connection% = outreg.ax AND 255     ' AL holds connecton number
																				 '   or a 0 if no connection.
   GetConNum% = Connection%

END FUNCTION

FUNCTION GetConStat$ (ConNum%)

   DIM ReqPack AS STRING * 7
   DIM RplPack AS STRING * 62
   DIM inreg AS RegTypeX
   DIM outreg AS RegTypeX

   IF ConNum% > 0 THEN

      ' Set up Request Buffer

      Packet$ = CHR$(5) + CHR$(0)
      Packet$ = Packet$ + CHR$(28)
      Packet$ = Packet$ + CHR$(ConNum% AND 255) + CHR$((ConNum% AND &HFF00) / 256) + CHR$(0) + CHR$(0)

      ReqPack = Packet$

      FOR a = 1 TO 100                 ' Try this up to 100 times
	 inreg.ax = &HF217             ' Novell Get Connection Info Svc
	 inreg.cx = 7                  ' CX holds the len of the Request
				       '   Buffer
	 inreg.dx = 62                 ' DX holds the len of the Reply
				       '   Buffer
	 inreg.ds = VARSEG(ReqPack)    ' DS:SI = Address of Request Buffer
	 inreg.si = VARPTR(ReqPack)
	 inreg.es = VARSEG(RplPack)    ' ES:DI = Address of Reply Buffer
	 inreg.di = VARPTR(RplPack)
	 InterruptX &H21, inreg, outreg  ' call interrupt 21h
	 IF (outreg.ax AND 255) = 0 THEN EXIT FOR  ' AL returns 0 if successful
      NEXT

      IF a > 100 THEN          ' see if we ran out of trys from above
	 GetConStat$ = ""
      ELSE
	 GetConStat$ = RplPack
      END IF
   ELSE
      GetConStat$ = ""
   END IF

END FUNCTION