home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / qbbsetc / qkratop.lzh / QKRATOP.PAS < prev   
Pascal/Delphi Source File  |  1990-10-18  |  14KB  |  456 lines
  1. Program QkRATop;
  2.  
  3. Uses
  4.   Dos, Crt, OpRoot, OpString;
  5.  
  6. Const
  7.      Clear   = #27+'[2J';
  8.      Default = #27+'[0m';
  9.      Bold    = #27+'[1m';
  10.      Blink   = #27+'[5m';
  11.  
  12.      Colors  : array[0..15] of string[5] =
  13.                (
  14.                  #27+'[30m', #27+'[31m', #27+'[32m', #27+'[33m',
  15.                  #27+'[34m', #27+'[35m', #27+'[36m', #27+'[37m',
  16.                  #27+'[40m', #27+'[41m', #27+'[42m', #27+'[43m',
  17.                  #27+'[44m', #27+'[45m', #27+'[46m', #27+'[47m'
  18.                );
  19.  
  20. Type
  21.  
  22.     string35 = string[35];
  23.     OneLine  = string[80];
  24.     FlagType = ARRAY[1..4] of byte;
  25.  
  26.     USERSrecord = RECORD
  27.                     Name     : string[35];
  28.                     Location : string[25];
  29.                     Password : string[15];
  30.                     DataPhone,
  31.                     VoicePhone : string[12];
  32.                     LastTime : string[5];
  33.                     LastDate : string[8];
  34.                     Attribute : byte;
  35.                     Flags : FlagType;
  36.                     Credit,
  37.                     Pending : word;
  38.                     MsgsPosted,
  39.                     LastRead,
  40.                     Security,
  41.                     NoCalls,
  42.                     Uploads,
  43.                     Downloads,
  44.                     UploadsK,
  45.                     DownloadsK : word;
  46.                     TodayK,
  47.                     Elapsed : integer;
  48.                     ScreenLength : word;
  49.                     LastPwdChange,
  50.                     Attribute2 : byte;
  51.                     ExtraSpace : ARRAY[1..6] OF byte;
  52.                   END;
  53.  
  54.      CONFIGdata = record            { Holds the program configuration data }
  55.         SystemName     : OneLine;
  56.         Sysop          : OneLine;
  57.         UserFile       : OneLine;
  58.         OutFile        : OneLine;
  59.         HiIntensity    : boolean;
  60.         fFrame, bFrame,
  61.         fHead,  bHead,
  62.         fData,  bData,
  63.         fHiLit, bHiLit : byte;
  64.      End;
  65.  
  66.      DataPtr = ^DataRec;
  67.      DataRec = object(SingleListNode)
  68.          Name    : string35;
  69.          Number  : word;
  70.          constructor Init(InitName : string35; InitNum : word);
  71.          function GetName : string35;
  72.          function GetNum  : word;
  73.      end;
  74.  
  75. Var
  76.      CFG            : CONFIGdata;
  77.      User           : USERSrecord;
  78.      UserFile       : FILE of USERSrecord;
  79.      AnsiOut        : TEXT;
  80.      AsciOut        : TEXT;
  81.      TOPcallers     : SingleList;
  82.      TOPposters     : SingleList;
  83.      TOPuploads     : SingleList;
  84.      Temp           : DataPtr;
  85.      fFr, bFr,
  86.      fHd, bHd,
  87.      fDat, bDat,
  88.      fHi, bHi       : string[5];
  89.  
  90. constructor DataRec.Init;
  91. begin
  92.   if NOT SingleListNode.Init then Fail;
  93.   Name   := InitName;
  94.   Number := InitNum;
  95. end;
  96.  
  97. function DataRec.GetName;
  98. begin
  99.   GetName := Name;
  100. end;
  101.  
  102. function DataRec.GetNum;
  103. begin
  104.   GetNum := Number;
  105. end;
  106.  
  107. Procedure Title;
  108. Begin
  109.      ClrScr;
  110.      Writeln('                               QkRATop v1.0');
  111.      Writeln;
  112.      Writeln('                   Remote Access BBS TOPTEN Screen Generator');
  113.      Writeln('               Copyright (c) 1990 Chrstopher Hall (505)821-5341');
  114.      Writeln('                            ALL RIGHTS RESERVED');
  115.      Writeln;
  116. End;
  117.  
  118. Procedure LoadConfig;
  119. var
  120.   ConfigFile : Text;
  121.   sTemp      : string;
  122. Begin
  123.   Assign(ConfigFile,'QkRATOP.CFG');
  124.   {$I-}
  125.   Reset(ConfigFile);
  126.   {$I+}
  127.   IF IOresult = 0 Then
  128.   Begin
  129.     Reset(ConfigFile);
  130.     Readln(ConfigFile, CFG.SystemName);
  131.     Readln(ConfigFile, CFG.Sysop);
  132.     Readln(ConfigFile, CFG.UserFile);
  133.     Readln(ConfigFile, CFG.OutFile);
  134.     Readln(ConfigFile, sTemp);
  135.     CFG.HiIntensity := (upcase(sTemp[1]) = 'H');
  136.     Read(ConfigFile, CFG.fFrame); Readln(ConfigFile, CFG.bFrame);
  137.     Read(ConfigFile, CFG.fHead);  Readln(ConfigFile, CFG.bHead);
  138.     Read(ConfigFile, CFG.fData);  Readln(ConfigFile, CFG.bData);
  139.     Read(ConfigFile, CFG.fHiLit); Readln(ConfigFile, CFG.bHiLit);
  140.     Close(ConfigFile);
  141.   End
  142.   Else
  143.   Begin
  144.     Writeln('ERROR:  Reading configuration file.');
  145.     Halt(1);      { Quit the program }
  146.   End;
  147.   fFr  := Colors[CFG.fFrame]; bFr  := Colors[CFG.bFrame];
  148.   fHd  := Colors[CFG.fHead];  bHd  := Colors[CFG.bHead];
  149.   fDat := Colors[CFG.fData];  bDat := Colors[CFG.bData];
  150.   fHi  := Colors[CFG.fHiLit]; bHi  := Colors[CFG.bHiLit];
  151. End;
  152.  
  153. Procedure DoScan;
  154. var
  155.   NewTemp : DataPtr;
  156. begin
  157.  
  158.   TOPcallers.Init;
  159.   TOPposters.Init;
  160.   TOPuploads.Init;
  161.  
  162.   assign(UserFile, CFG.UserFile);
  163.   {$I-}
  164.   reset(UserFile);
  165.   {$I+}
  166.   if IOResult <> 0 then
  167.   begin
  168.     writeln('ERROR:  Unable to locate USERS.BBS');
  169.     Halt;
  170.   end;
  171.   read(UserFile, User);      {Skip SYSOP Entry}
  172.   while NOT EOF(UserFile) do
  173.   begin
  174.     read(UserFile, User);
  175.  
  176.     {****    TOP Callers    ****}
  177.  
  178.     if TOPcallers.Size < 10 then        {Size of Linked List is < 10}
  179.     begin
  180.       Temp := DataPtr(TOPcallers.Head);
  181.       if Temp = nil then
  182.       begin
  183.         New(Temp, Init(User.Name, User.NoCalls));
  184.         TOPcallers.Append(Temp);
  185.       end
  186.       else
  187.       while Temp <> nil do
  188.       begin
  189.         if User.NoCalls > Temp^.GetNum then
  190.         begin
  191.           New(NewTemp, Init(User.Name, User.NoCalls));
  192.           TOPcallers.PlaceBefore(NewTemp, Temp);
  193.           Temp := nil;
  194.         end
  195.         else
  196.         begin
  197.           Temp := DataPtr(TOPcallers.Next(Temp));
  198.           if Temp = nil then
  199.           begin
  200.             New(NewTemp, Init(User.Name, User.NoCalls));
  201.             TOPcallers.Append(NewTemp);
  202.           end;
  203.         end;
  204.       end;
  205.     end
  206.     else         {Size of Linked List is already at Maximum}
  207.     begin
  208.       Temp := DataPtr(TOPcallers.Head);
  209.       while Temp <> nil do
  210.       begin
  211.         if User.NoCalls > Temp^.GetNum then
  212.         begin
  213.           New(NewTemp, Init(User.Name, User.NoCalls));
  214.           TOPcallers.PlaceBefore(NewTemp, Temp);
  215.           Temp := DataPtr(TOPcallers.Tail);
  216.           TOPcallers.Delete(Temp);
  217.           Temp := nil;
  218.         end
  219.         else
  220.           Temp := DataPtr(TOPcallers.Next(Temp));
  221.       end;
  222.     end;
  223.  
  224.     {****    TOP Message Posters    ****}
  225.  
  226.     if TOPposters.Size < 10 then        {Size of Linked List is < 10}
  227.     begin
  228.       Temp := DataPtr(TOPposters.Head);
  229.       if Temp = nil then
  230.       begin
  231.         New(Temp, Init(User.Name, User.MsgsPosted));
  232.         TOPposters.Append(Temp);
  233.       end
  234.       else
  235.       while Temp <> nil do
  236.       begin
  237.         if User.MsgsPosted > Temp^.GetNum then
  238.         begin
  239.           New(NewTemp, Init(User.Name, User.MsgsPosted));
  240.           TOPposters.PlaceBefore(NewTemp, Temp);
  241.           Temp := nil;
  242.         end
  243.         else
  244.         begin
  245.           Temp := DataPtr(TOPposters.Next(Temp));
  246.           if Temp = nil then
  247.           begin
  248.             New(NewTemp, Init(User.Name, User.MsgsPosted));
  249.             TOPposters.Append(NewTemp);
  250.           end;
  251.         end;
  252.       end;
  253.     end
  254.     else         {Size of Linked List is already at Maximum}
  255.     begin
  256.       Temp := DataPtr(TOPposters.Head);
  257.       while Temp <> nil do
  258.       begin
  259.         if User.MsgsPosted > Temp^.GetNum then
  260.         begin
  261.           New(NewTemp, Init(User.Name, User.MsgsPosted));
  262.           TOPposters.PlaceBefore(NewTemp, Temp);
  263.           Temp := DataPtr(TOPposters.Tail);
  264.           TOPposters.Delete(Temp);
  265.           Temp := nil;
  266.         end
  267.         else
  268.           Temp := DataPtr(TOPposters.Next(Temp));
  269.       end;
  270.     end;
  271.  
  272.     {****    TOP Uploaders    ****}
  273.  
  274.     if TOPuploads.Size < 10 then        {Size of Linked List is < 10}
  275.     begin
  276.       Temp := DataPtr(TOPuploads.Head);
  277.       if Temp = nil then
  278.       begin
  279.         New(Temp, Init(User.Name, User.Uploads));
  280.         TOPuploads.Append(Temp);
  281.       end
  282.       else
  283.       while Temp <> nil do
  284.       begin
  285.         if User.Uploads > Temp^.GetNum then
  286.         begin
  287.           New(NewTemp, Init(User.Name, User.Uploads));
  288.           TOPuploads.PlaceBefore(NewTemp, Temp);
  289.           Temp := nil;
  290.         end
  291.         else
  292.         begin
  293.           Temp := DataPtr(TOPuploads.Next(Temp));
  294.           if Temp = nil then
  295.           begin
  296.             New(NewTemp, Init(User.Name, User.Uploads));
  297.             TOPuploads.Append(NewTemp);
  298.           end;
  299.         end;
  300.       end;
  301.     end
  302.     else         {Size of Linked List is already at Maximum}
  303.     begin
  304.       Temp := DataPtr(TOPuploads.Head);
  305.       while Temp <> nil do
  306.       begin
  307.         if User.Uploads > Temp^.GetNum then
  308.         begin
  309.           New(NewTemp, Init(User.Name, User.Uploads));
  310.           TOPuploads.PlaceBefore(NewTemp, Temp);
  311.           Temp := DataPtr(TOPuploads.Tail);
  312.           TOPuploads.Delete(Temp);
  313.           Temp := nil;
  314.         end
  315.         else
  316.           Temp := DataPtr(TOPuploads.Next(Temp));
  317.       end;
  318.     end;
  319.  
  320.   end;
  321.   close(UserFile);
  322. end;
  323.  
  324. Procedure WriteBulletins;
  325. var
  326.   x, y  : byte;
  327.   Up, Msg, Call : DataPtr;
  328.   sLine, sTemp : string;
  329. begin
  330.   writeln('Writing Ascii Bulletin.');
  331.   writeln('Writing Ansi  Bulletin.');
  332.   assign(AsciOut, CFG.OutFile+'.ASC');
  333.   assign(AnsiOut, CFG.OutFile+'.ANS');
  334.   rewrite(AsciOut);
  335.   rewrite(AnsiOut);
  336.   if CFG.HiIntensity then write(AnsiOut, Bold);
  337.   write(AnsiOut, Clear, fFr, bFr);
  338.   writeln(AsciOut);
  339.   writeln(AsciOut,'┌───────────────────────────────────────────────────────────────────────────┐');
  340.   writeln(AsciOut,'│                  QkRemote Access Top Ten Users Bulletin                   │');
  341.   writeln(AsciOut,'│                    Copyright (c) 1990 Christopher Hall                    │');
  342.   writeln(AsciOut,'├───────────────────────────────────────────────────────────────────────────┤');
  343.   write  (AsciOut,'│');
  344.   sLine := 'System Name: ' + CFG.SystemName;
  345.   sLine := CenterCh(sLine, ' ', 75);
  346.   write(AsciOut, sLine);
  347.   writeln(AsciOut,'│');
  348.   write  (AsciOut,'│');
  349.   sLine := 'Sysop: ' + CFG.Sysop;
  350.   sLine := CenterCh(sLine, ' ', 75);
  351.   write(AsciOut, sLine);
  352.   writeln(AsciOut,'│');
  353.   writeln(AsciOut,'├────────────────────────┬────────────────────────┬─────────────────────────┤');
  354.   writeln(AsciOut,'│    Best Uploaders      │  Best Message Writers  │      Best Callers       │');
  355.   writeln(AsciOut,'└────────────────────────┴────────────────────────┴─────────────────────────┘');
  356.  
  357.   writeln(AnsiOut,'┌───────────────────────────────────────────────────────────────────────────┐');
  358.   write  (AnsiOut,'│');
  359.   write  (AnsiOut, fHd, bHd);
  360.   write  (AnsiOut,'                  QkRemote Access Top Ten Users Bulletin                   ');
  361.   write  (AnsiOut, fFr, bFr);
  362.   writeln(AnsiOut,'│');
  363.   write  (AnsiOut,'│');
  364.   write  (AnsiOut, fHd, bHd);
  365.   write  (AnsiOut,'                    Copyright (c) 1990 Christopher Hall                    ');
  366.   write  (AnsiOut, fFr, bFr);
  367.   writeln(AnsiOut,'│');
  368.   writeln(AnsiOut,'├───────────────────────────────────────────────────────────────────────────┤');
  369.   write  (AnsiOut,'│');
  370.   write  (AnsiOut, fHd, bHd);
  371.   sLine := 'System Name: ' + CFG.SystemName;
  372.   sLine := CenterCh(sLine, ' ', 75);
  373.   write  (AnsiOut, sLine);
  374.   write  (AnsiOut, fFr, bFr);
  375.   writeln(AnsiOut,'│');
  376.   write  (AnsiOut,'│');
  377.   write  (AnsiOut, fHd, bHd);
  378.   sLine := 'Sysop: ' + CFG.Sysop;
  379.   sLine := CenterCh(sLine, ' ', 75);
  380.   write  (AnsiOut, sLine);
  381.   write  (AnsiOut, fFr, bFr);
  382.   writeln(AnsiOut,'│');
  383.   writeln(AnsiOut,'├────────────────────────┬────────────────────────┬─────────────────────────┤');
  384.   writeln(AnsiOut,'│    Best Uploaders      │  Best Message Writers  │      Best Callers       │');
  385.   writeln(AnsiOut,'└────────────────────────┴────────────────────────┴─────────────────────────┘');
  386.  
  387.  
  388.   Up   := DataPtr(TOPuploads.Head);
  389.   Msg  := DataPtr(TOPposters.Head);
  390.   Call := DataPtr(TOPcallers.Head);
  391.   for x := 1 to 10 do
  392.   begin
  393.     sLine := '  '+ Up^.GetName; str(Up^.GetNum, sTemp);
  394.     write(AsciOut, sLine, ' ');
  395.     write(AnsiOut, fDat, bDat, sLine, ' ');
  396.     for y := length(sLine) to 22-length(sTemp) do
  397.     begin
  398.       write(AsciOut, '.');
  399.       write(AnsiOut, '.');
  400.     end;
  401.     write(AsciOut, sTemp);
  402.     write(AnsiOut, fHi, bHi, sTemp);
  403.     write(AsciOut, '   ');
  404.     write(AnsiOut, '   ');
  405.  
  406.     sLine := Msg^.GetName; str(Msg^.GetNum, sTemp);
  407.     write(AsciOut, sLine, ' ');
  408.     write(AnsiOut, fDat, bDat, sLine, ' ');
  409.     for y := length(sLine) to 20-length(sTemp) do
  410.     begin
  411.       write(AsciOut, '.');
  412.       write(AnsiOut, '.');
  413.     end;
  414.     write(AsciOut, sTemp);
  415.     write(AnsiOut, fHi, bHi, sTemp);
  416.     write(AsciOut, '   ');
  417.     write(AnsiOut, '   ');
  418.  
  419.     sLine := Call^.GetName; str(Call^.GetNum, sTemp);
  420.     write(AsciOut, sLine, ' ');
  421.     write(AnsiOut, fDat, bDat, sLine, ' ');
  422.     for y := length(sLine) to 22-length(sTemp) do
  423.     begin
  424.       write(AsciOut, '.');
  425.       write(AnsiOut, '.');
  426.     end;
  427.     writeln(AsciOut, sTemp);
  428.     writeln(AnsiOut, fHi, bHi, sTemp);
  429.  
  430.     Up   := DataPtr(TOPuploads.Next(Up));
  431.     Msg  := DataPtr(TOPposters.Next(Msg));
  432.     Call := DataPtr(TOPcallers.Next(Call));
  433.   end;
  434.   writeln(AsciOut);
  435.   writeln(AnsiOut);
  436.   writeln(AsciOut, 'Press [Enter] to Continue: ');
  437.   write  (AnsiOut, fFr, bFr, 'Press [');
  438.   write  (AnsiOut, fHi, bHi, 'Enter', fFr, bFr);
  439.   writeln(AnsiOut, '] to Continue: ', Default);
  440.   close(AsciOut);
  441.   close(AnsiOut);
  442.   writeln;
  443.   writeln('Done!');
  444. end;
  445.  
  446. begin
  447.   Title;
  448.   LoadConfig;
  449.   Writeln; Writeln('Scanning Users file.  Please Wait...');
  450.   DoScan;
  451.   WriteBulletins;
  452.   TOPcallers.Done;
  453.   TOPposters.Done;
  454.   TOPuploads.Done;
  455. End.
  456.