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