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