home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 21 / CD_ASCQ_21_040595.iso / dos / prg / pas / nwtp06 / who.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-01  |  9KB  |  308 lines
  1. {$X+,V-,B-}
  2. program who;
  3.  
  4. { Adaption of a similar program privided with one of the other public
  5.   domain TP API's.
  6.  
  7.   Example program for the nwConn unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
  8.  
  9. uses nwMisc,nwBindry,nwConn,nwServ;
  10.      {nwServ used for GetFileServerDateAndTime only}
  11.  
  12. Type String25=string[25];
  13.      PTuserInfo=^TuserInfo;
  14.      TuserInfo=record
  15.                objName  :string25;
  16.                objId    :LongInt;
  17.                TrueName :string25;
  18.                LoginTime:TnovTime; { time of last logon }
  19.                ConnNbr  :byte;      { 0= not logged on}
  20.                next     :PTuserInfo;
  21.                end;
  22.  
  23. var Param            : string;
  24.     DispAll,DispHelp : boolean;
  25.     MyConnNbr        : byte;
  26.     MyServer         : string;
  27.     ConnInUse,UsersConnected,ConnNotLogIn:byte;
  28.     startPtr         : PTuserInfo;
  29.  
  30. Procedure ScanBinderyUsers;
  31. Var lastObjSeen:LongInt;
  32.     UserName   :string;
  33.     UserType   :word;
  34.     UserId     :LongInt;
  35.     Flag,Security:Byte;
  36.     hp         :boolean;
  37.     nUser,lUser,wUser:PTuserInfo;
  38.     tempStr    :string;
  39.     LogInfo    :TloginControl;
  40.  
  41. begin
  42. LastObjSeen:=-1;
  43. WHILE ScanBinderyObject('*',1 {OT_USER},LastObjSeen,
  44.                         UserName,UserType,UserId,Flag,Security,hp)
  45.  do begin
  46.     New(nUser);
  47.     PstrCopy(nUser^.objName,UserName,25);
  48.     nUser^.objId:=UserId;
  49.     nUser^.ConnNbr:=0;
  50.     nUser^.next:=NIL;
  51.  
  52.     GetObjectLoginControl(UserName,1 {ot_user},LogInfo);
  53.     nUser^.LoginTime:=LogInfo.LastLoginTime;
  54.  
  55.     IF nwBindry.GetRealUserName(UserName,tempstr)
  56.      then if (tempStr='')
  57.           then tempStr:='_';
  58.     PstrCopy(nUser^.TrueName,tempStr,25);
  59.  
  60.     wUser:=startPtr;
  61.     While (wUser<>NIL) and (wUser^.objName<nUser^.objName)
  62.      do begin lUser:=wUser;wUser:=wUser^.next; end;
  63.     nUser^.next:=wUser;
  64.     lUser^.next:=nUser;
  65.  
  66.     end;
  67. if nwBindry.Result<>$FC { no such object}
  68.  then writeln('Error scanning Bindery.');
  69.  
  70. end;
  71.  
  72. Procedure DumpLoginTime(connNbr:byte;objName:string;objId:LongInt;time:TnovTime);
  73. Var nUser,lUser:PTuserInfo;
  74. begin
  75. lUser:=startPtr^.next;
  76. while (lUser<>NIL) and (luser^.objId<>objId)
  77.  do lUser:=lUser^.next;
  78. if lUser<>NIL
  79.  then begin
  80.       if lUser^.ConnNbr=0 { first time the user is found at some connection }
  81.        then begin
  82.             lUser^.LoginTime:=time;
  83.             lUser^.ConnNbr:=ConnNbr;
  84.             end
  85.        else begin { user logged in at multiple connections }
  86.             new(nUser);
  87.             nUser^:=lUser^;
  88.             {nUser^.next:=lUser^.next}
  89.             nUser^.LoginTime:=time;
  90.             nUser^.ConnNbr:=ConnNbr;
  91.             lUser^.next:=nUser;
  92.             end;
  93.       end
  94.  else begin
  95.       writeln('SECURITY WARNING: USER ''',objName,''' @ connection:',connNbr);
  96.       writeln('                  IS LOGGED IN W/O CORRESPONDING BINDERY OBJECT.');
  97.       end
  98. end;
  99.  
  100. procedure DisplayHeader;
  101. Var connId  :byte;
  102.     username:string;
  103.     objType :word;
  104.     objID   :LongInt;
  105.     dateTime:TnovTime;
  106. begin
  107.   UpString(Param);
  108.   If NOT (GetPreferredConnectionID(connId) and (connId<>0))
  109.    then if NOT (GetDefaultConnectionID(connId) and (connId<>0))
  110.          then GetPrimaryConnectionId(connId);
  111.   GetFileServerName(connId,MyServer);
  112.   GetConnectionNumber(MyConnNbr);
  113.   GetConnectionInformation(MyconnNbr,username,objType,objID,datetime);
  114.   if Param='' then writeln('List of currently logged on users for server ',MyServer)
  115.               else writeln('List for user ',Param,' on ',MyServer,'.');
  116.   writeln;
  117.   writeln('Con: Name:                Login/off Time:');
  118.   writeln('---  -------------------- -------------------------');
  119. end;
  120.  
  121.  
  122. procedure GetConnectedUsers;
  123. Var connNbr:byte;
  124.     objName:string;
  125.     objType:word;
  126.     objId  :LongInt;
  127.     LogTime:TnovTime;
  128.     {serverInfo:TFileServerInformation;}
  129. begin
  130. ConnInUse:=0;
  131. UsersConnected:=0;
  132. ConnNotLogIn:=0;
  133. { To determine the maximum number of connections allowed by the
  134.   license, you would normally use the
  135.     nwServ.GetFileServerInformation(servername,serverInfo)
  136.   call. For now, we'll suppose there are max. 250 connectios allowed. }
  137.  
  138. for connNbr := 1 to 250 {serverinfo.ConnectionsMax}
  139.  do begin
  140.     IF GetConnectionInformation(connNbr,objName,objType,objId,LogTime)
  141.      then begin
  142.           if objName='NOT-LOGGED-IN'
  143.            then begin
  144.                 inc(ConnNotLogIn);
  145.                 inc(connInUse);
  146.                 DumpLoginTime(connNbr,objName,objId,LogTime);{ logOUT time }
  147.                 end
  148.            else if objType=1 {OT_USER}
  149.                  then begin
  150.                       inc(ConnInUse);
  151.                       inc(UsersConnected);
  152.                       DumpLoginTime(connNbr,objName,objId,LogTime);{ logIN }
  153.                       end
  154.                  else inc(connInUse);
  155.           end
  156.     end; {do}
  157. end;
  158.  
  159.  
  160. procedure DisplayAllUsers;
  161. Var lUser       :PTuserInfo;
  162.     time,tempStr:string;
  163. Begin
  164. lUser:=startPtr^.next;
  165. while lUser<>NIL
  166.  do begin
  167.     if (param='') or (pos(param,lUser^.objName)>0)
  168.      then begin
  169.           if lUser^.ConnNbr=0
  170.            then begin
  171.                 if DispAll and (lUser^.objName<>'NOT-LOGGED-IN')
  172.                  then begin
  173.                       PstrCopy(tempStr,lUser^.objName,20);
  174.                       write('N/A  ',tempStr);
  175.                       if lUser^.LoginTime.day<>0
  176.                        then begin
  177.                             NovTime2String(lUser^.LoginTime,time);
  178.                             time[1]:='?';time[2]:='?';time[3]:='?';
  179.                             writeln(' ',time);
  180.                             end
  181.                        else writeln(' ------not available------');
  182.                       writeln('':5,lUser^.TrueName);
  183.                       end
  184.                 end
  185.            else begin
  186.  
  187.                 NovTime2String(lUser^.LoginTime,time);
  188.                 PstrCopy(tempStr,lUser^.objName,20);
  189.  
  190.                 write(lUser^.connNbr:3);
  191.                 if Luser^.ConnNbr=MyConnNbr
  192.                  then write(' *')
  193.                  else write('  ');
  194.  
  195.                 writeln(tempstr,' ',time);
  196.                 writeln('':5,lUser^.TrueName);
  197.                 end;
  198.           end;
  199.     lUser:=lUser^.next
  200.     end;
  201. end;
  202.  
  203.  
  204. procedure DisplayFooter;
  205. Var now:TnovTime;
  206.     nowStr:string;
  207.     remainder:byte;
  208. begin
  209. getFileServerDateAndTime(now);
  210. NovTime2String(now,nowStr);
  211. If UsersConnected=1 then write('1 user is');
  212. if UsersConnected>1 then write(UsersConnected,' users are');
  213. if UsersConnected>0 then writeln(' logged into ',MyServer,' as of ',nowStr);
  214. IF ConnNotLogIn=1 then write('1 connection is');
  215. IF ConnNotLogIn>1 then write(ConnNotLogIn,' connections are');
  216. IF ConnNotLogIn>0 then writeln(' in use, but the workstation has logged out.');
  217. remainder:=ConnInUse-UsersConnected-ConnNotLogIn;
  218. IF remainder>0 then writeln(remainder,' connection(s) used by non-user objects.');
  219. end;
  220.  
  221. procedure credits;
  222. begin
  223. writeln;
  224. writeln('WHO:  Displays a list of currently logged in users.');
  225. writeln;
  226. writeln('SYNTAX: WHO [servername/][username] [/A]');
  227. writeln;
  228. writeln('Servername has to match an existing server.');
  229. writeln('All users with ''username'' contained in them wil be displayed.');
  230. writeln;
  231. writeln('Example:     WHO             Display everyone');
  232. writeln('             WHO username    Display a particular user.');
  233. writeln('             WHO server/     Display a different server.');
  234. writeln;
  235. halt(0);
  236. end;
  237.  
  238.  
  239. procedure ChangeServer;    { change default server to something else }
  240. var ServerChanged:Boolean;
  241.     p,connId:byte;
  242.     NewServer : string;
  243.     servername : string;
  244. begin
  245. ServerChanged:=False;
  246. p := pos('/',Param);
  247. NewServer := copy(Param,1,p-1);
  248. UpString(NewServer);
  249. Param := copy(Param,p+1,255);
  250. for connId := 1 to 8
  251.  do begin
  252.     GetFileServerName(connId,servername);
  253.     if servername=NewServer
  254.      then begin
  255.           serverChanged:=True;
  256.           SetPreferredConnectionId(connId);
  257.           end;
  258.     end;
  259. if NOT ServerChanged
  260.  then begin
  261.       writeln('Server ',NewServer,' not found.');
  262.       halt(1);
  263.       end;
  264. end;
  265.  
  266. Var OldConnId:Byte;
  267.     nliConn:PTuserInfo;
  268.  
  269. begin {---------main-----------------------------------------------------}
  270.  New(startPtr);
  271.  New(nliConn);
  272.  nliConn^.objName:='NOT-LOGGED-IN';
  273.  nliConn^.objId:=0;
  274.  nliConn^.TrueName:='';
  275.  nliConn^.next:=NIL;
  276.  nliConn^.connNbr:=0;
  277.  startPtr^.next:=nliConn;
  278.  startPtr^.objName:=#0;
  279.  
  280.  if paramcount > 0
  281.   then Param := paramstr(1)
  282.   else Param := '';
  283.  DispAll:=(paramCount > 0)
  284.           and ( (pos('/A',paramstr(1))=1)
  285.                 or (pos('/a',paramStr(1))=1)
  286.               );
  287.  If dispall then param:='';
  288.  DispAll:=DispAll or ( (paramCount > 1)
  289.                        and ( (pos('/A',paramstr(2))=1)
  290.                              or (pos('/a',paramStr(2))=1)
  291.                            )
  292.                      );
  293.  UpString(Param);
  294.  DispHelp:=(Param = '?') or (Pos('/H',Param)=1);
  295.  
  296.  
  297.  GetPreferredConnectionId(OldConnId);
  298.  if DispHelp then credits;
  299.  if pos('/',Param) > 1 then ChangeServer;
  300.  ScanBinderyUsers;
  301.  GetConnectedUsers;
  302.  DisplayHeader;
  303.  DisplayAllUsers;
  304.  DisplayFooter;
  305.  SetPreferredConnectionId(OldConnId);
  306. end.
  307.  
  308.