Comment
=============================================================

WHOHAS.MNU Copyright 1993-2000 by Marc Perkel

Returns a list of users who have a specific file open.

Computer Tyme * http://www.ctyme.com marc@perkel.com

Note: This utility doesn't determine who has a file open. It sends a
request to the Novell server which returns a list. The server checks
security and will return an error if the user doesn't have rights. I can
not program around these Netware restrictions.

NT doesn't support this so I can't check files on NT servers.

This is an example of how you can use MarxMenu to write a
command line utility.

=============================================================
EndComment

;#Define Shareware

var
  Masterlist
  FileList
  ConIndex
  LargestConnection
  LongestName
  LongestFileName
  SendMode
  DropMode
  Message
  UserCount
  FileMask
  MyConnection
  PreferredServer
  Grant
  Revoke


Qualifier
  ConnectionFound
  ConnectionName
  ConnectionStationAddress
  ConnectionObjectType
  ConnectionLoginTime
  ConnectionObjectNumber

Main
ExitWhoHas

;========================== PROCEDURES ==========================

Procedure Help
   Writeln 'Computer Tyme WhoHas * Copyright 1993-2001 by Marc Perkel'
   Writeln 'All Rights Reserved * Version 3.2 * Release Date: 02-19-01'

   Include 'ADDRESS.INC'

   Writeln 'This utility returns a list of users who have a specific file open.'
   Writeln 'Shows username, connection, and login time.'
   Writeln
   Writeln 'USAGE: WHOHAS <FILENAME> /S/D "Message"
   Writeln
   Writeln '  /S = Send message to users who have file open.'
   Writeln '  /D = Drop connection of users who have file open.'
   Writeln '  /G = Grant Console Operator Rights to User'
   Writeln '  /R = Remove Console Operator Rights from User'
   Writeln '  /L = List users with Console Operator Rights'
   Writeln
   Pause
   Writeln
   Writeln 'Examples:'
   Writeln '  WHOHAS N:MARXMENU.OVR'
   Writeln '  WHOHAS N:MARXMENU.OVR /S "Please exit menu!"'
   Writeln '  WHOHAS N:MARXMENU.OVR /D'
   Writeln '  WHOHAS USERNAME /G'
   Writeln '  WHOHAS SERVER/USERNAME /G'
   Writeln '  WHOHAS USERNAME /R'
   Writeln '  WHOHAS SERVER/USERNAME /R'
   Writeln '  WHOHAS /L'
   Writeln '  WHOHAS SERVER /L'
   Writeln '  WHOHAS *.DBF             ;Yes! Wildcards are allowed!'
   Writeln '  TYPE FILE.LST|WHOHAS
   Writeln '  WHOHAS \\TYME\SYS\PUBLIC\NSK\MARXMENU.OVR'
   Writeln '  WHOHAS TYME\SYS:PUBLIC\NSK\MARXMENU.OVR'
   Writeln
   Pause
   Writeln '/D/G/R/L/S Require Supervisor or Admin Rights'
   Writeln
   Writeln 'Number of files open returned in DOS ErrorLevel'
   Writeln
   Writeln 'Users must have "Console Operator" rights to use this program.'
   Writeln 'On Netware 4+ servers you must set the Bindery Context.'
   Writeln
   Writeln '  Example: Set Bindery Context = O=CTYME'
   Writeln
   Writeln '$95 per Server. Written in MarxMenu.'
   Writeln 'Comes free with the Network Survival Kit.'
   Writeln
   ShowRights
   ExitWhoHas
EndProc


Procedure Pause
var Ch
   if OutputRedirected then Return
   Write    'Press and Key ... '
   Ch = ReadKey
   Write CR '                 ' CR
EndProc


Procedure ParseServer
var P
   P = pos('/',FileMask)
   if P > 0
      NovSetPreferredServer(Left(FileMask,P-1))
      delete(FileMask,1,P)
   endif
EndProc



Procedure ShowRights
var UserName Server
   Username = NovLoginName
   Server = NovdefaultServer


   if UserName > ''
      Writeln 'You are [' Server '/' UserName '] on connection ' NovConnection '.'

      if NovConsoleOperator
         Writeln 'You have Console Operator rights.'
      else
         Writeln 'You do not have Console Operator rights.'
         Writeln 'Console Operator Rights are required to run this program.'
         ExitCode = 255
      endif

      if NovBinderyAccess < 3
         Writeln 'You do not have Supervisor/Admin rights.'
      else
         Writeln 'You have Supervisor/Admin rights.'
      endif

   else
      Writeln 'Error: Unable to determine user name on connection ' NovConnection '.'
      Writeln
      Writeln 'Users must have "Console Operator" rights to use this program.'
      Writeln 'On Netware 4+ servers you must set the Bindery Context.'
      Writeln
      Writeln '  Example: Set Bindery Context = O=CTYME'
      Writeln
   endif

EndProc


Procedure ScanInfo
Var FileIndex L
   Loop MasterList
      FileIndex = LoopIndex
      Loop LoopVal
         ConIndex[LoopVal].ConnectionFound = True
         L = Length(ConIndex[LoopVal].ConnectionName) + Length(Str(LoopVal))
         LongestName = Max(LongestName,L)
         UserCount = UserCount + 1
      EndLoop
   EndLoop
EndProc


Procedure NameAndCon (Con)
var Line
   Line = ConIndex[Con].ConnectionName + ' [' + Str(Con) + ']'
   length(Line) = LongestName + 3
   Return Line
EndProc


Procedure Display
Var FileIndex Line LTime
   Loop MasterList
      FileIndex = LoopIndex
      Writeln
      Writeln 'Connections using: ' FileList[FileIndex]
      Writeln
      Loop LoopVal
         Line = '  ' + NameAndCon(LoopVal)
         LTime = ConIndex[LoopVal].ConnectionLoginTime
         Line = Line + '  ' + DateString(LTime) + ' ' + TimeString(LTime)
         Writeln Line
      EndLoop
   EndLoop
EndProc


Procedure RemoveDuplicates (Orig)
var List
   if NumberOfElements(Orig) < 2 then Return
   List = Orig
   Dispose Orig
   SortArray(List)
   Loop List
      if LoopVal <> List[LoopIndex + 1]
         AppendArray(Orig,LoopVal)
      endif
   EndLoop
EndProc


Procedure SendMessages
   Writeln
   Loop 1 LargestConnection ConIndex
      if LoopVal.ConnectionFound and (LoopIndex <> MyConnection)
         Write 'Sending Message to: ' NameAndCon(LoopIndex) ' ... '
         NovSendMessage(Message,LoopIndex)
         Writeln
      endif
   EndLoop
EndProc


Procedure DropUsers
   Writeln

   if NovBinderyAccess < 3
      ShowRights
      Writeln 'Supervisor/Admin Rights are required to drop user connections.'
      ExitCode = 255
      ExitWhoHas
   endif

   Loop 1 LargestConnection ConIndex
      if LoopVal.ConnectionFound and (LoopIndex <> MyConnection)
         Write 'Dropping Connection: ' NameAndCon(LoopIndex) ' ... '
         NovClearConnection(LoopIndex)
         Writeln
         if NovResult <> 0
            ReportCode 'dropping connection'
            ExitCode = 255
            ShowRights
            ExitWhoHas
         endif
      endif
   EndLoop
EndProc



#If Shareware

Procedure Beg
   BoxBorderColor Green Blue
   BoxInsideColor White Blue
   BoxHeaderColor Yellow Mag
   BoxHeader ' * Shameless Beg Screen * '
   DrawBox 10 8 61 6
   Writeln
   WriteCenter '* WhoHas Evaluation Copy *'
   Writeln
   WriteCenter 'Please remember to register this software.'
   Wait 600
   EraseTopWindow
   ClearKbdBuffer
EndProc

#Endif

Procedure ExitWhoHas
   if ExitCode = 0
      ExitCode = Min(255,UserCount)
   endif
   NovPreferredServer = ''
   ExitMenu
EndProc


Procedure ReportCode ($St)
var Message
   if NovResult = 0 then return

   Message = Str(NovResult)

   if NovResult = 252
      Message 'User not Found'
   endif

   Writeln
   Writeln 'Novell result code: "' Message '" returned while ' St '.'
   Writeln
EndProc


Procedure GetConnectionInfo
var ConInfo Index
   if PreferredServer <> NovPreferredServer
      dispose(ConIndex)
      MyConnection = NovConnection
      NovConnectionInfo(ConInfo)
      LargestConnection = ConInfo[NumberOfElements(ConInfo),1]
      Loop ConInfo

         ;- Store Connection Number in Index

         Index = LoopVal[1]

         ;- Use Connection Number Field as a boolean Flag Field

         LoopVal.ConnectionFound = False
         ConIndex[Index] = LoopVal
      EndLoop
      PreferredServer = NovPreferredServer
   endif
EndProc


Procedure GatherConnections (Mask, NoFileExit)
var FileName ConnectionList FList P St

   St = NovCleanVolumeName(Mask)

   P = pos('/',St)
   if P > 0
      NovPreferredServer = Left(St,pred(P))
   endif

   GetConnectionInfo

   WholeFileNames On
   ReadLongNames On

   ReadDirectory(Mask,FList)

   if NoFileExit and (NumberOfElements(FList) = 0)
      Writeln
      Writeln 'No Files Selected while looking for ' Mask
      Writeln
      ExitCode = 255
      ExitWhoHas
   endif

   Loop FList
      FileName = LoopVal
      NovConUsingAFile(ConnectionList,FileName)
      if NovResult <> 0
         Writeln
         if NovResult = $C6
            ShowRights
         else
            ReportCode 'reading connections using file'
         endif
         ExitCode = 255
         ExitWhoHas
      endif
      if NumberOfElements(ConnectionList) > 0
         RemoveDuplicates(Loc ConnectionList)
         AppendArray(MasterList,ConnectionList)
         AppendArray(FileList,FileName)
      endif
   EndLoop
EndProc


Procedure GrantConsoleRights (UserName,Grant)
   if NovBinderyAccess < 3
      ShowRights
      Writeln 'Supervisor/Admin Rights are required to grant or remove Console Operator Rights.'
      ExitCode = 255
      ExitWhoHas
   endif

   if Grant
      NovAddToSet(NovDefaultServer,'OPERATORS',4,UserName,1)
      if (NovResult = 0) or (NovResult = 233)
         Writeln 'User ' UserName ' now has Console Operator Rights.'
      else
         ReportCode 'Adding Console Operator Rights'
         ExitCode = 255
      endif
   else
      if (UserName = 'SUPERVISOR') or (UserName = 'ADMIN')
         Writeln 'Removal of Console Operator Rights for ' UserName ' is Prohibited.'
      else
         NovDeleteFromSet(NovDefaultServer,'OPERATORS',4,UserName,1)
         if (NovResult = 0) or (NovResult = 234)
            Writeln 'User ' UserName ' no longer has Console Operator Rights.'
         else
            ReportCode 'Removing Console Operator Rights'
            ExitCode = 255
         endif
      endif
   endif
   ExitWhoHas
EndProc


Procedure ListConsoleOperators
var Operators

   if NovBinderyAccess < 3

      ;- Note: Artificial Restriction assuming that you don't want
      ;- just anyone to run this - Netware allows it

      ShowRights
      Writeln 'Supervisor/Admin Rights are required to list Console Operator Users.'
      ExitCode = 255
      ExitWhoHas
   endif

   if FileMask > ''
      NovSetPreferredServer(FileMask)
   endif

   NovPropertyValues(Operators,NovDefaultServer,'OPERATORS',4)
   if NovResult = 0
      Writeln
      Writeln 'List of users with Console Operator Rights on Server: ' NovDefaultServer
      Writeln 'Supervisor and Admin equivelents not listed'
      Writeln 'Supervisor and Admin equivelents already have enough rights.'
      Writeln
      if NumberOfElements Operators = 0
         Writeln 'No one has Console Operator Rights on Server: ' NovDefaultServer
      else
         SortArray(Operators)
         Loop Operators
            Writeln LoopVal
         EndLoop
      endif
   else
      ReportCode 'Listing users with Console Operator Rights'
      ExitCode = 255
   endif
   ExitWhoHas
EndProc


Procedure Setup
var St

   #If Shareware
      Beg
   #Endif

   StandardIO
   AmPm
   ExitCode = 0

   if not InputRedirected
      FileMask = UpperCase(ParamStr(2))
      if FileMask = '' then Help
   endif

   if not NovConsoleOperator
      Writeln
      ShowRights
      ExitWhoHas
   endif

   if pos(':',CmdLine) > 0
      delete(CmdLine,1,pos(':',CmdLine))
   endif

   SendMode = OptionSwitch(CmdLine,'S')
   DropMode = OptionSwitch(CmdLine,'D')
   if DropMode then SendMode = False

   Grant = OptionSwitch(CmdLine,'G')
   Revoke = OptionSwitch(CmdLine,'R')

   if OptionSwitch(CmdLine,'L')
      ListConsoleOperators
   endif

   if Grant
      ParseServer
      GrantConsoleRights(FileMask,True)
   endif

   if Revoke
      ParseServer
      GrantConsoleRights(FileMask,False)
   endif

   if SendMode
      delete(CmdLine,1,pred(pos('"',CmdLine)))
      Message = NextWord CmdLine
      SendMode = Message > ''
   endif

   if SendMode
      St = 'From ' + NovLoginName + '[' + Str(NovConnection) + ']: '
      Message = St + Message
   endif

EndProc


Procedure Main
var List

   Setup

   if InputRedirected
      ReadTextFile('',List)
      Loop List
         GatherConnections(LoopVal,False)
      EndLoop
   else
      GatherConnections(FileMask,True)
   endif
   if NumberOfElements(MasterList) = 0
      if not (OutputRedirected or InputRedirected)
         Writeln
         Writeln 'No one is using: ' FileMask
      endif
   endif

   ScanInfo
   Display

   if SendMode then SendMessages

   if DropMode
      Wait 100
      DropUsers
   Endif

EndProc