home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SYSPC22.ZIP / FLAGS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-06-08  |  1.4 KB  |  55 lines
  1. const accessstr:array [accesstype] of string[8]=
  2.         ('By level','Keep out','Let in','');
  3.  
  4. procedure setuseraccflag; {Forward: var u:userrec; bn:integer; ac:accesstype}
  5. begin
  6.   if (ord(ac) and 1)=1
  7.     then u.access1:=u.access1+[bn]
  8.     else u.access1:=u.access1-[bn];
  9.   if (ord(ac) and 2)=2
  10.     then u.access2:=u.access2+[bn]
  11.     else u.access2:=u.access2-[bn]
  12. end;
  13.  
  14. function getuseraccflag (var u:userrec; bn:integer):accesstype;
  15. var ac:accesstype;
  16. begin
  17.   getuseraccflag:=accesstype(ord(bn in u.access1) or
  18.                              (ord(bn in u.access2) shl 1))
  19. end;
  20.  
  21. procedure setallflags (bn:integer; ac:accesstype);
  22. var cnt:integer;
  23.     u:userrec;
  24. begin
  25.   for cnt:=1 to filesize(ufile)-1 do begin
  26.     seek (ufile,cnt);
  27.     read (ufile,u);
  28.     setuseraccflag (u,bn,ac);
  29.     seek (ufile,cnt);
  30.     write (ufile,u)
  31.   end
  32. end;
  33.  
  34. procedure setalluserflags; { FORWARD (var u:userrec; ac:accesstype) }
  35. var b1,b2:byte;
  36. begin
  37.   b1:=(ord(ac) and 1)*255;
  38.   b2:=((ord(ac) and 2) shr 1)*255;
  39.   fillchar (u.access1,32,b1);
  40.   fillchar (u.access2,32,b2)
  41. end;
  42.  
  43. procedure getacflag (var ac:accesstype; var tex:mstr);
  44. begin
  45.   writestr ('[K]ick off, [B]y level, [L]et in:');
  46.   ac:=invalid;
  47.   if length(input)=0 then exit;
  48.   case upcase(input[1]) of
  49.     'B':ac:=bylevel;
  50.     'L':ac:=letin;
  51.     'K':ac:=keepout
  52.   end;
  53.   tex:=accessstr[ac]
  54. end;
  55.