home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 5
/
ctrom5b.zip
/
ctrom5b
/
PROGRAM
/
PASCAL
/
NWTP06
/
WHO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-03-01
|
9KB
|
308 lines
{$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.