{$X+,V-,B-}
program who;

{ Adaption of a similar program privided with one of the other public
  domain TP API's.

  Example program for the nwConn unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }

uses nwMisc,nwBindry,nwConn,nwServ;
     {nwServ used for GetFileServerDateAndTime only}

Type String25=string[25];
     PTuserInfo=^TuserInfo;
     TuserInfo=record
               objName  :string25;
               objId    :LongInt;
               TrueName :string25;
               LoginTime:TnovTime; { time of last logon }
               ConnNbr  :byte;      { 0= not logged on}
               next     :PTuserInfo;
               end;

var Param            : string;
    DispAll,DispHelp : boolean;
    MyConnNbr        : byte;
    MyServer         : string;
    ConnInUse,UsersConnected,ConnNotLogIn:byte;
    startPtr         : PTuserInfo;

Procedure ScanBinderyUsers;
Var lastObjSeen:LongInt;
    UserName   :string;
    UserType   :word;
    UserId     :LongInt;
    Flag,Security:Byte;
    hp         :boolean;
    nUser,lUser,wUser:PTuserInfo;
    tempStr    :string;
    LogInfo    :TloginControl;

begin
LastObjSeen:=-1;
WHILE ScanBinderyObject('*',1 {OT_USER},LastObjSeen,
                        UserName,UserType,UserId,Flag,Security,hp)
 do begin
    New(nUser);
    PstrCopy(nUser^.objName,UserName,25);
    nUser^.objId:=UserId;
    nUser^.ConnNbr:=0;
    nUser^.next:=NIL;

    GetObjectLoginControl(UserName,1 {ot_user},LogInfo);
    nUser^.LoginTime:=LogInfo.LastLoginTime;

    IF nwBindry.GetRealUserName(UserName,tempstr)
     then if (tempStr='')
          then tempStr:='_';
    PstrCopy(nUser^.TrueName,tempStr,25);

    wUser:=startPtr;
    While (wUser<>NIL) and (wUser^.objName<nUser^.objName)
     do begin lUser:=wUser;wUser:=wUser^.next; end;
    nUser^.next:=wUser;
    lUser^.next:=nUser;

    end;
if nwBindry.Result<>$FC { no such object}
 then writeln('Error scanning Bindery.');

end;

Procedure DumpLoginTime(connNbr:byte;objName:string;objId:LongInt;time:TnovTime);
Var nUser,lUser:PTuserInfo;
begin
lUser:=startPtr^.next;
while (lUser<>NIL) and (luser^.objId<>objId)
 do lUser:=lUser^.next;
if lUser<>NIL
 then begin
      if lUser^.ConnNbr=0 { first time the user is found at some connection }
       then begin
            lUser^.LoginTime:=time;
            lUser^.ConnNbr:=ConnNbr;
            end
       else begin { user logged in at multiple connections }
            new(nUser);
            nUser^:=lUser^;
            {nUser^.next:=lUser^.next}
            nUser^.LoginTime:=time;
            nUser^.ConnNbr:=ConnNbr;
            lUser^.next:=nUser;
            end;
      end
 else begin
      writeln('SECURITY WARNING: USER ''',objName,''' @ connection:',connNbr);
      writeln('                  IS LOGGED IN W/O CORRESPONDING BINDERY OBJECT.');
      end
end;

procedure DisplayHeader;
Var connId  :byte;
    username:string;
    objType :word;
    objID   :LongInt;
    dateTime:TnovTime;
begin
  UpString(Param);
  If NOT (GetPreferredConnectionID(connId) and (connId<>0))
   then if NOT (GetDefaultConnectionID(connId) and (connId<>0))
         then GetPrimaryConnectionId(connId);
  GetFileServerName(connId,MyServer);
  GetConnectionNumber(MyConnNbr);
  GetConnectionInformation(MyconnNbr,username,objType,objID,datetime);
  if Param='' then writeln('List of currently logged on users for server ',MyServer)
              else writeln('List for user ',Param,' on ',MyServer,'.');
  writeln;
  writeln('Con: Name:                Login/off Time:');
  writeln('---  -------------------- -------------------------');
end;


procedure GetConnectedUsers;
Var connNbr:byte;
    objName:string;
    objType:word;
    objId  :LongInt;
    LogTime:TnovTime;
    {serverInfo:TFileServerInformation;}
begin
ConnInUse:=0;
UsersConnected:=0;
ConnNotLogIn:=0;
{ To determine the maximum number of connections allowed by the
  license, you would normally use the
    nwServ.GetFileServerInformation(servername,serverInfo)
  call. For now, we'll suppose there are max. 250 connectios allowed. }

for connNbr := 1 to 250 {serverinfo.ConnectionsMax}
 do begin
    IF GetConnectionInformation(connNbr,objName,objType,objId,LogTime)
     then begin
          if objName='NOT-LOGGED-IN'
           then begin
                inc(ConnNotLogIn);
                inc(connInUse);
                DumpLoginTime(connNbr,objName,objId,LogTime);{ logOUT time }
                end
           else if objType=1 {OT_USER}
                 then begin
                      inc(ConnInUse);
                      inc(UsersConnected);
                      DumpLoginTime(connNbr,objName,objId,LogTime);{ logIN }
                      end
                 else inc(connInUse);
          end
    end; {do}
end;


procedure DisplayAllUsers;
Var lUser       :PTuserInfo;
    time,tempStr:string;
Begin
lUser:=startPtr^.next;
while lUser<>NIL
 do begin
    if (param='') or (pos(param,lUser^.objName)>0)
     then begin
          if lUser^.ConnNbr=0
           then begin
                if DispAll and (lUser^.objName<>'NOT-LOGGED-IN')
                 then begin
                      PstrCopy(tempStr,lUser^.objName,20);
                      write('N/A  ',tempStr);
                      if lUser^.LoginTime.day<>0
                       then begin
                            NovTime2String(lUser^.LoginTime,time);
                            time[1]:='?';time[2]:='?';time[3]:='?';
                            writeln(' ',time);
                            end
                       else writeln(' ------not available------');
                      writeln('':5,lUser^.TrueName);
                      end
                end
           else begin

                NovTime2String(lUser^.LoginTime,time);
                PstrCopy(tempStr,lUser^.objName,20);

                write(lUser^.connNbr:3);
                if Luser^.ConnNbr=MyConnNbr
                 then write(' *')
                 else write('  ');

                writeln(tempstr,' ',time);
                writeln('':5,lUser^.TrueName);
                end;
          end;
    lUser:=lUser^.next
    end;
end;


procedure DisplayFooter;
Var now:TnovTime;
    nowStr:string;
    remainder:byte;
begin
getFileServerDateAndTime(now);
NovTime2String(now,nowStr);
If UsersConnected=1 then write('1 user is');
if UsersConnected>1 then write(UsersConnected,' users are');
if UsersConnected>0 then writeln(' logged into ',MyServer,' as of ',nowStr);
IF ConnNotLogIn=1 then write('1 connection is');
IF ConnNotLogIn>1 then write(ConnNotLogIn,' connections are');
IF ConnNotLogIn>0 then writeln(' in use, but the workstation has logged out.');
remainder:=ConnInUse-UsersConnected-ConnNotLogIn;
IF remainder>0 then writeln(remainder,' connection(s) used by non-user objects.');
end;

procedure credits;
begin
writeln;
writeln('WHO:  Displays a list of currently logged in users.');
writeln;
writeln('SYNTAX: WHO [servername/][username] [/A]');
writeln;
writeln('Servername has to match an existing server.');
writeln('All users with ''username'' contained in them wil be displayed.');
writeln;
writeln('Example:     WHO             Display everyone');
writeln('             WHO username    Display a particular user.');
writeln('             WHO server/     Display a different server.');
writeln;
halt(0);
end;


procedure ChangeServer;    { change default server to something else }
var ServerChanged:Boolean;
    p,connId:byte;
    NewServer : string;
    servername : string;
begin
ServerChanged:=False;
p := pos('/',Param);
NewServer := copy(Param,1,p-1);
UpString(NewServer);
Param := copy(Param,p+1,255);
for connId := 1 to 8
 do begin
    GetFileServerName(connId,servername);
    if servername=NewServer
     then begin
          serverChanged:=True;
          SetPreferredConnectionId(connId);
          end;
    end;
if NOT ServerChanged
 then begin
      writeln('Server ',NewServer,' not found.');
      halt(1);
      end;
end;

Var OldConnId:Byte;
    nliConn:PTuserInfo;

begin {---------main-----------------------------------------------------}
 New(startPtr);
 New(nliConn);
 nliConn^.objName:='NOT-LOGGED-IN';
 nliConn^.objId:=0;
 nliConn^.TrueName:='';
 nliConn^.next:=NIL;
 nliConn^.connNbr:=0;
 startPtr^.next:=nliConn;
 startPtr^.objName:=#0;

 if paramcount > 0
  then Param := paramstr(1)
  else Param := '';
 DispAll:=(paramCount > 0)
          and ( (pos('/A',paramstr(1))=1)
                or (pos('/a',paramStr(1))=1)
              );
 If dispall then param:='';
 DispAll:=DispAll or ( (paramCount > 1)
                       and ( (pos('/A',paramstr(2))=1)
                             or (pos('/a',paramStr(2))=1)
                           )
                     );
 UpString(Param);
 DispHelp:=(Param = '?') or (Pos('/H',Param)=1);


 GetPreferredConnectionId(OldConnId);
 if DispHelp then credits;
 if pos('/',Param) > 1 then ChangeServer;
 ScanBinderyUsers;
 GetConnectedUsers;
 DisplayHeader;
 DisplayAllUsers;
 DisplayFooter;
 SetPreferredConnectionId(OldConnId);
end.