home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 270.img / FORUM25C.ZIP / TOP10.PAS < prev    next >
Pascal/Delphi Source File  |  1989-02-01  |  5KB  |  169 lines
  1.  
  2. {=============  In Gentypes  ==============}
  3.  
  4. CONST MaxTopPosters = 10;
  5.  
  6. TYPE Top_poster_Rec = RECORD
  7.                          User_name : Mstr;
  8.                          Num_posts : WORD;
  9.                        End;
  10.  
  11.      Top_poster_type = ARRAY[1..MaxTopPosters] OF Top_poster_rec;
  12.  
  13. VAR Top_Post_file : FILE OF Top_poster_type;
  14.  
  15.  
  16. {============= In bulletin.pas ====================}
  17.  
  18. Function Name_there(User_nam : Mstr) : INTEGER;
  19. VAR c1 : BYTE;
  20.     Found : BOOLEAN;
  21. Begin
  22.   Found := FALSE;
  23.   For c1 := 1 to MaxTopPosters Do
  24.     Begin
  25.       If Post_Array[c1].User_name = User_nam THEN
  26.        Begin
  27.         Name_there := c1;
  28.         Found := TRUE;
  29.        End;
  30.     End;
  31.   If Not Found THEN Name_there := -1;
  32. End;
  33.  
  34. {=============================================================================}
  35.  
  36. {   Call after a user posts.
  37. NOTE:  Posts MUST already be incremated by 1 }
  38.  
  39. Procedure Add_name(User : Mstr; Posts : WORD);
  40. VAR L_pos : INTEGER;
  41.     c1    : BYTE;
  42.     Temp  : Top_poster_rec;
  43.  
  44. {-----------------------------------------------------------------------------}
  45.  
  46. Procedure Insert_name(Ins_num : BYTE; User_n : Mstr; Posts : WORD);
  47. VAR c1 : BYTE;
  48. Begin
  49.   If (Ins_num > MaxTopPosters) OR (Ins_num < 0) THEN Exit;
  50.   For c1 := MaxTopPosters DOWNTO Ins_num+1 DO
  51.       Post_array[c1] := Post_array[c1-1];
  52.   Post_array[Ins_num].User_name := User_n;
  53.   Post_array[Ins_num].Num_posts := Posts;
  54. End;
  55.  
  56. {-----------------------------------------------------------------------------}
  57.  
  58. Begin
  59.   L_pos := Name_there(User);
  60.   If L_pos = -1 THEN
  61.     Begin    {  Not currently in list }
  62.       For c1 := 0 TO MaxTopPosters DO
  63.         Begin
  64.           If Post_array[c1+1].Num_Posts < Posts THEN
  65.             Begin
  66.               Insert_Name(c1+1,User,Posts);
  67.               Exit;
  68.             End;
  69.         End;
  70.     End
  71.   ELSE       {  Currently in List     }
  72.     Begin
  73.       Inc(Post_array[L_pos].Num_posts);
  74.       If L_Pos = 1 THEN Exit;
  75.       If Post_array[L_pos-1].Num_Posts < Posts THEN
  76.         Begin
  77.           Temp := Post_array[L_pos-1];
  78.           Post_array[L_pos-1] := Post_array[L_pos];
  79.           Post_array[L_pos] := Temp;
  80.         End;
  81.     End;
  82. End;
  83.  
  84. {=============================================================================}
  85.  
  86. { Call when a post is deleted
  87.   NOTE:  Posts MUST already be decremated }
  88.  
  89. Procedure Delete_One_post(User : MStr; Posts : WORD);
  90. VAR L_pos : INTEGER;
  91.     Temp  : Top_poster_rec;
  92. Begin
  93.   L_pos := Name_there(User);
  94.   If L_pos <> -1 THEN
  95.     Begin
  96.       Dec(Post_array[L_pos].Num_posts);
  97.       If L_Pos = 10 THEN Exit;
  98.       If Post_array[L_pos+1].Num_Posts > Posts THEN
  99.         Begin
  100.           Temp := Post_array[L_pos+1];
  101.           Post_array[L_pos+1] := Post_array[L_pos];
  102.           Post_array[L_pos] := Temp;
  103.         End;
  104.     End;
  105. End;
  106.  
  107. {=============================================================================}
  108.  
  109. {   Call this procedure after any calls to above procedures  }
  110.  
  111. Procedure Save_top_posters;
  112. Begin
  113.   Assign(Top_post_file,BoardDir+'Forum.T10');
  114.   Rewrite(Top_post_file);
  115.   Write(Top_post_file,Post_Array);
  116.   Close(Top_post_file);
  117. End;
  118.  
  119. {=============================================================================}
  120.  
  121. {  Call to list top posters }
  122.  
  123. Procedure Show_top_posters;
  124. VAR IO_c       : INTEGER;
  125.     c2         : INTEGER;
  126.     Post_user  : UserRec;
  127.  
  128. {-----------------------------------------------------------------------------}
  129.  
  130. Begin
  131.   If Not Exist(BoardDir+'Forum.T10') THEN
  132.     Begin    { Create new poster file }
  133.  
  134.       Writeln('Top poster file does not exist.  Creating new file.');
  135.       Write('Wait ');
  136.       For c2 := 1 TO NumUsers DO
  137.         Begin
  138.           If c2 MOD 6 = 0 THEN Write('.');
  139.           Seek(Ufile,c2);
  140.           Read(Ufile,Post_user);
  141.           Add_name(Post_user.Handle,Post_user.Nbu);
  142.         End;
  143.       Writeln;
  144.       Save_top_posters;
  145.     End;
  146.   Assign(Top_post_file,BoardDir+'Forum.T10');
  147.   {$I-}
  148.     Reset(Top_post_file);
  149.   {$I+}
  150.   IO_c := IOResult;
  151.   If IO_c <> 0 THEN
  152.     Begin
  153.       Writeln('Critical error #',IO_c);
  154.       Exit;
  155.     End;
  156.   Read(Top_post_file,Post_Array);
  157.   Writeln;
  158.   WriteHdr(LongName+' Top Posters');
  159.   For c2 := 1 TO MaxTopPosters DO
  160.    Begin
  161.     Tab('',2);
  162.     Tab(Strr(c2)+'. ',4);
  163.     Tab(Post_array[c2].User_name,25);
  164.     Writeln('[',Post_array[c2].Num_posts,' posts]');
  165.    End;
  166.   Close(Top_post_file);
  167. End;
  168.  
  169. {=============================================================================}