home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / MISC / TGARTS.ZIP / SAMPLE.ZIP / TGUSER.PAS < prev    next >
Pascal/Delphi Source File  |  1998-12-19  |  8KB  |  199 lines
  1.  
  2. Program  Tguser;
  3.  
  4. Uses Crt;
  5.  
  6.  
  7. {$I Telegard.inc}
  8.  
  9. Var User_File : File of userrec;
  10.     User_Record : Userrec;
  11.     Total_Users : Integer;
  12.     Male, Female : Integer;
  13.     RecN : Integer; (* Reocrd # *)
  14.     Stop_Now : Boolean;
  15.  
  16. Procedure Read_Totals;
  17. Begin
  18.   {This procedure is used twice so made it one procedure}
  19.   Assign(User_file,'users.dat');
  20.   Reset(User_file);
  21.   Total_Users := 0;   {Total users on your bbs set to 0}
  22.   Male := 0;     Female := 0;
  23.   While not eof(User_File) do
  24.   Begin
  25.     Read(User_File,User_record);
  26.     Inc(Total_Users); (* add 1 to total users *)
  27.     IF User_record.gender = 'M' then Inc(Male) else Inc(Female);
  28.   end;
  29.   Close(User_file);
  30. end;
  31.  
  32. Procedure User_Summary;
  33. Var MPercent, FPercent : Real;
  34.     MString, Fstring : String;
  35. Begin
  36.   ClrScr;GotoXY(10,10);Textcolor(14);
  37.   Read_Totals;
  38.   Mstring := ''; Fstring :='';
  39.   Writeln('Users Summary');
  40.   MPercent := (Male / Total_users)*100;
  41.   FPercent := (Female /  Total_users)*100;
  42.   Textcolor(11);  Write('Total number of Users :');
  43.   Textcolor(15);  Writeln(Total_Users);
  44.   Textcolor(11);  Write('     Total Male Users :');
  45.   Textcolor(15);  Write(Male);Write(' ');Textcolor(14);
  46.   Write(mpercent:0:2); (* This is a special way of doing things ! *)
  47.   Textcolor(10);  Writeln('% of total users');
  48.   Textcolor(11);  Write('   Total Female Users :');
  49.   Textcolor(15);  Write(Female); Write(' ');Textcolor(14);
  50.   Write(fpercent:0:2); (* This is a special way of doing things ! *)
  51.   Textcolor(10);  Writeln('% of total users');
  52.   Textcolor(12);  Writeln('Press any key to continue...');
  53.   Repeat until Keypressed;
  54. end;
  55.  
  56. Procedure Edit_Data;
  57. Var Loop : Byte;
  58.     Key2: Char;
  59.     EndNow : Boolean;
  60. Label 1;
  61. Begin
  62.     {Labels and gotos are bad but for this demo they work :)}
  63.     EndNow := False;
  64. 1:  (* Labels are highly bad coding but just this once :) Gotos eek *)
  65.     Textcolor(9);
  66.     For Loop := 1 to 4 do Begin Gotoxy(1,13+loop);Write(chr(64+loop)+'.');  end;
  67.     For Loop := 1 to 4 do Begin Gotoxy(33,13+loop);Write(chr(68+loop)+'.'); end;
  68.     Gotoxy(4,19);Textcolor(14);
  69.     Writeln('Enter A-H to toggle the flag on or off for this user, Q to end edit mode');
  70.     Repeat
  71.       Key2 := Readkey;Key2 := Upcase(Key2);
  72.     Until (Keypressed) or (Key2>='A') and (Key2<='H') or (key2='Q');
  73.     Case Key2 of
  74.       'A' : IF lockedout in user_record.status then
  75.                Exclude(user_record.status,lockedout) else Include(user_record.status,lockedout);
  76.       'B' : IF trapactivity in user_record.status then
  77.                Exclude(user_record.status,trapactivity) else Include(user_record.status,trapactivity);
  78.       'C' : IF chatauto in user_record.status then
  79.                Exclude(user_record.status,chatauto) else Include(user_record.status,chatauto);
  80.       'D' : IF slogseparate in user_record.status then
  81.                Exclude(user_record.status,slogseparate) else Include(user_record.status,slogseparate);
  82.       'E' : IF udeleted in user_record.status then
  83.                Exclude(user_record.status,udeleted) else Include(user_record.status,udeleted);
  84.       'F' : IF trapseparate in user_record.status then
  85.                Exclude(user_record.status,trapseparate) else Include(user_record.status,trapseparate);
  86.       'G' : IF chatseparate in user_record.status then
  87.                Exclude(user_record.status,chatseparate) else Include(user_record.status,chatseparate);
  88.       'H' : IF alert in user_record.status then
  89.                Exclude(user_record.status,alert) else Include(user_record.status,alert);
  90.       'Q' : EndNow := True;
  91.     end;
  92.     {see Include/Exclude functions in pascal help to see what they do}
  93.     If lockedout    In user_record.status then begin  Gotoxy(5,14); Write('X');  end else begin Gotoxy(5,14); Write(' '); end;
  94.     If udeleted     In user_record.status then begin  Gotoxy(37,14);Write('X');  end;
  95.     If trapactivity In user_record.status then begin  Gotoxy(5,15); Write('X');  end;
  96.     If trapseparate In user_record.status then begin  Gotoxy(37,15);Write('X');  end;
  97.     If chatauto     In user_record.status then begin  Gotoxy(5,16); Write('X');  end;
  98.     If chatseparate In user_record.status then begin  Gotoxy(37,16);Write('X');  end;
  99.     If slogseparate In user_record.status then begin  Gotoxy(5,17); Write('X');  end;
  100.     If alert        In user_record.status then begin  Gotoxy(37,17);Write('X');  end;
  101.     If EndNow = false then goto 1;
  102.     {You use the IN relational operator to check to see if a element is in
  103.      a set by a true/false selection}
  104.     Gotoxy(10,20);
  105.     Writeln('Save the changes? (if any) (Y or N)');
  106.     Repeat
  107.       Key2 := Readkey;Key2 := Upcase(Key2);
  108.     Until (Keypressed) or (Key2='Y') or (Key2<='N');
  109.     If Key2='Y' then
  110.     Begin
  111.       {Finds the record you are editing by seek and saves it}
  112.       Seek(User_file,recN);
  113.       Write(User_File,user_record);
  114.     end;
  115. end;
  116.  
  117. Procedure Show_Stats;
  118. Var Key : Char;
  119.     Stop:Boolean;
  120. Begin
  121.   Read_Totals;
  122.   Assign(User_file,'users.dat');
  123.   Reset(User_file);
  124.   RecN := 1;
  125.   Read(User_File, User_record);
  126.   Repeat
  127.   Begin
  128.     ClrScr;GotoXY(1,10);Textcolor(11);
  129.     Stop:=False;
  130.     Write('User Stats - user #');Write(RecN+1);Write(' of ');Writeln(Total_users);
  131.     Textcolor(14);
  132.     Writeln('User Name :'+user_record.name);
  133.     Writeln('Real Name :'+user_record.realname);
  134.     Writeln('User Status flags (IF X then its set for this user)');
  135.     Textcolor(15);
  136.     Writeln('   [ ] User Locked out             [ ] User deleted');
  137.     Writeln('   [ ] Trapping user Activity      [ ] Trapping to separate TRAP File');
  138.     Writeln('   [ ] Auto Chat Trapping          [ ] Separate chat file to trap');
  139.     Writeln('   [ ] Separate Sysop Log          [ ] Alert sysop when user logs on');
  140.     Textcolor(10);
  141.     If lockedout    In user_record.status then begin  Gotoxy(5,14); Write('X');  end;
  142.     If udeleted     In user_record.status then begin  Gotoxy(37,14);Write('X');  end;
  143.     If trapactivity In user_record.status then begin  Gotoxy(5,15); Write('X');  end;
  144.     If trapseparate In user_record.status then begin  Gotoxy(37,15);Write('X');  end;
  145.     If chatauto     In user_record.status then begin  Gotoxy(5,16); Write('X');  end;
  146.     If chatseparate In user_record.status then begin  Gotoxy(37,16);Write('X');  end;
  147.     If slogseparate In user_record.status then begin  Gotoxy(5,17); Write('X');  end;
  148.     If alert        In user_record.status then begin  Gotoxy(37,17);Write('X');  end;
  149.     Gotoxy(4,18);Writeln('Press [, ] for next, previous record or E to edit that user (Q to quit)');
  150.     Repeat
  151.       Key := Readkey;Key := Upcase(Key);
  152.     Until (Keypressed) or (Key='[') or (Key=']') or (key='Q') or (Key='E');
  153.     Case Key of
  154.       '[','-': Dec(RecN);
  155.       ']','+': Inc(RecN);
  156.       'Q': Stop:=True;
  157.       'E': Edit_data;
  158.     end;
  159.     If Stop=False then
  160.     Begin
  161.       If RecN<1 then RecN:=0;  {minor error checking}
  162.       If RecN>=total_users then RecN:=Total_users-1;
  163.       Seek(User_file,RecN);
  164.       Read(user_file,user_record);
  165.     end;
  166.   end;
  167.   until Stop;
  168.   Close(User_file);
  169. end;
  170.  
  171. Procedure Main_menu;
  172. Var Key : Char;
  173. Begin
  174.   ClrScr;GotoXY(10,10);Textcolor(14);
  175.   Writeln('Users.dat Demo');
  176.   Writeln('    ** Menu **');
  177.   Writeln(' A.  Show Users Summary');
  178.   Writeln(' B.  Show User Stats');
  179.   Writeln(' Q.  Quit');
  180.   Writeln;
  181.   Writeln('Press A, B or Q please');
  182.   Repeat
  183.     Key := Readkey;Key := Upcase(Key);
  184.   Until (Keypressed) or (Key>=chr(65)) and (Key<=chr(67)) or (key='Q');
  185.   Case Key of
  186.     'A': User_Summary;
  187.     'B': Show_Stats;
  188.     'Q': Stop_Now := True;
  189.   end;
  190. end;
  191.  
  192. Begin
  193.   Stop_Now := False;
  194.   Repeat
  195.     Main_Menu;
  196.   Until Stop_Now;
  197. end.
  198.  
  199.