home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FORUM25C.ZIP / FLAGS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-12-27  |  1.7 KB  |  72 lines
  1. {$R-,S-,I-,D-,V-,B-,N-,L- }
  2. {$O+}
  3.  
  4. unit flags;
  5.  
  6.  
  7. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  8.  
  9. interface
  10.  
  11. uses gentypes,subs1;
  12.  
  13. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  14.  
  15.  
  16. const accessstr:array [accesstype] of string[8]=
  17.         ('By level','Keep out','Let in','');
  18.  
  19. Procedure setuseraccflag (VAR u:userrec; bn:integer; ac:accesstype);
  20. Function getuseraccflag (VAR u:userrec; bn:integer):accesstype;
  21. Procedure setallflags (bn:integer; ac:accesstype);
  22. Procedure setalluserflags (VAR u:userrec; ac:accesstype);
  23.  
  24.  
  25. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  26.  
  27. implementation
  28.  
  29. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  30.  
  31.  
  32. Procedure setuseraccflag (VAR u:userrec; bn:integer; ac:accesstype);
  33. begin
  34.   if (ord(ac) and 1)=1
  35.     then u.access1:=u.access1+[bn]
  36.     else u.access1:=u.access1-[bn];
  37.   if (ord(ac) and 2)=2
  38.     then u.access2:=u.access2+[bn]
  39.     else u.access2:=u.access2-[bn]
  40. end;
  41.  
  42. Function getuseraccflag (VAR u:userrec; bn:integer):accesstype;
  43. VAR ac:accesstype;
  44. begin
  45.   getuseraccflag:=accesstype(ord(bn in u.access1) or
  46.                              (ord(bn in u.access2) shl 1))
  47. end;
  48.  
  49. Procedure setallflags (bn:integer; ac:accesstype);
  50. VAR cnt:integer;
  51.     u:userrec;
  52. begin
  53.   for cnt:=1 to filesize(ufile)-1 do begin
  54.     seek (ufile,cnt);
  55.     read (ufile,u);
  56.     setuseraccflag (u,bn,ac);
  57.     seek (ufile,cnt);
  58.     write (ufile,u)
  59.   end
  60. end;
  61.  
  62. Procedure setalluserflags (VAR u:userrec; ac:accesstype);
  63. VAR b1,b2:byte;
  64. begin
  65.   b1:=(ord(ac) and 1)*255;
  66.   b2:=((ord(ac) and 2) shr 1)*255;
  67.   fillchar (u.access1,32,b1);
  68.   fillchar (u.access2,32,b2)
  69. end;
  70.  
  71. end.
  72.