home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 554 / AVRIL / VERBOSE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  4KB  |  176 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 473 of 523
  3. From : Justin Marquez                      1:106/100.0          27 Apr 93  10:40
  4. To   : All
  5. Subj : Fido .MSG header example
  6. ────────────────────────────────────────────────────────────────────────────────}
  7. Program VERBOSITY_INDEX;
  8. { Reads a FidoNet *.MSG file areas and logs info about authorship and
  9.   "verbosity" found in the messages.
  10.  
  11.   Requires Turbo Pascal 7.xx or Borland Pascal 7.xx (for the STRINGS unit)
  12.  
  13.   OutPut is redirectable.  Can be quickly sorted with DOS's SORT.COM
  14.   Here is a batch file you may find useful:
  15.  
  16. rem YAK.BAT
  17. verbose %1 > zap.txt
  18. sort < zap.txt > yak.txt /+37 /R
  19. del zap.txt
  20.  
  21.    This program is written by Justin Marquez, FidoNet 106/100
  22.    It is being donated to all as a PUBLIC DOMAIN program, which may be
  23.    freely used, copied and modified as you please.
  24.  
  25.    "If you improve on it, I'd like a copy of the modifications for my
  26.    own edification!"
  27. }
  28.  
  29. Uses Strings,
  30.      DOS;
  31.  
  32. TYPE
  33.   FidoMessageHeader = Record
  34.     FromUser  : Array[0..35] of Char ;
  35.     ToUser    : Array[0..35] of Char ;
  36.     Subject   : Array[0..71] of Char ;
  37.     DateTime  : Array[0..19] of Char ;
  38.     TimesRead : Word ;
  39.     DestNode  : Word ;
  40.     OrigNode  : Word ;
  41.     Cost      : Word ;
  42.     OrigNet   : Word ;
  43.     DestNet   : Word ;
  44.     Filler    : Array[0..7] of Byte ;
  45.     Replyto   : Word ;
  46.     Attribute : Word ;
  47.     NextReply : Word ;
  48.   End;
  49.  
  50.   Entry = record
  51.     Author : string[36];
  52.     Count  : integer;
  53.     Bytes  : longint;
  54.   End;
  55.  
  56. VAR
  57.    MsgDir,
  58.    fn       : string;
  59.    SR       : SearchRec;
  60.    tmp      : FidoMessageHeader;
  61.    Who_From : string[36];
  62.    n,
  63.    i        : integer;
  64.    HiNum    : integer;
  65.    rec      : Array [1..512] of Entry;
  66.    TotBytes : LongInt;
  67.  
  68. Procedure GetMsgInfo (fname:string; VAR Hdr:FidoMessageHeader);
  69. Var
  70.    HFile : file of FidoMessageHeader;
  71.    MFile : Text;
  72. Begin
  73.   FillChar(Hdr,SizeOf(Hdr),#0);  { clear it out initially }
  74.   { get msg hdr only }
  75.   Assign(Hfile,fname);
  76.    Reset(HFile);
  77.    Seek(Hfile,0);
  78.    Read(Hfile,Hdr);
  79.   Close(Hfile);
  80. End;
  81.  
  82. Procedure Pad_Path(Var s:string);
  83. Begin
  84.   if s[length(s)] = '\'
  85.   then
  86.   else
  87.     s := s+'\';
  88. End;
  89.  
  90. Procedure Process_Name;
  91. Var
  92.   k : integer;
  93.   Found : Boolean;
  94. Begin
  95.   Found := FALSE;
  96.   if n > 0
  97.   then begin
  98.        for k := 1 to n do begin
  99.          if Who_From = rec[k].author then begin
  100.            inc(rec[k].count);
  101.            rec[k].Bytes := rec[k].Bytes + SR.Size;
  102.            Found := TRUE;
  103.          end;
  104.        end;
  105.   end
  106.   else begin
  107.        rec[1].author := Who_From;
  108.        rec[1].count  := 1;
  109.        rec[1].Bytes := rec[1].Bytes + SR.Size
  110.   end;
  111.   If NOT Found then begin
  112.     inc(n);
  113.     Rec[n].Author := Who_From;
  114.     Rec[n].Count  := 1;
  115.     rec[n].Bytes := rec[n].Bytes + SR.Size;
  116.   end;
  117. End;
  118.  
  119. Procedure Intro_And_Init;
  120. Begin
  121.   FillChar(rec,SizeOf(rec),#0);  { clear it out initially }
  122.   HiNum    := 0;
  123.   TotBytes := 0;
  124.   n        := 0;
  125.   If ParamCount > 0
  126.   then
  127.     MsgDir := ParamStr(1)
  128.   else
  129.     begin
  130.       WriteLn(' VERBOSE <path> >');
  131.       WriteLn('EXAMPLE:');
  132.       WriteLn;
  133.       WriteLn('VERBOSE C:\OPUS\HOUSYSOP\ ');
  134.       WriteLn(' reads all msg files in the area and reports findings.');
  135.       WriteLn;
  136.       WriteLn(' Note: can be redirected to a file or device.');
  137.       WriteLn;
  138.       WriteLn('Public Domain from 106/100. Request as VERBOSE.ZIP.');
  139.       Halt(2);
  140.     end;
  141. End;
  142.  
  143. Procedure Process_Files;
  144. Begin
  145.   Pad_Path(MsgDir);
  146.   fn := MsgDir+'*.MSG';
  147.   FindFirst(fn, AnyFile, SR);
  148.   while DosError = 0 do
  149.   begin
  150.     fn        := MsgDir+SR.Name;
  151.     GetMsgInfo (fn,tmp);
  152.     Who_From  := '';
  153.     Who_From  := StrPas( StrUpper(tmp.FromUser) );
  154.     Inc(HiNum);
  155.     TotBytes := TotBytes + SR.Size;
  156.       Process_Name;
  157.     FindNext(SR);
  158.   end;
  159. End;
  160.  
  161. Procedure Report_Results;
  162. Begin
  163.   for i := 1 to n do
  164.     WriteLn(rec[i].Author:36,Rec[i].Count:4,(100*Rec[i].Count/HiNum):6:1,'% ',
  165.             Rec[i].Bytes:6, ' bytes or',(100*Rec[i].Bytes/TotBytes):5:1,
  166.             '% by size' );
  167.   WriteLn(' Total messages found: ':36,HiNum:4);
  168.   WriteLn(' Total bytes found   : ':36,TotBytes:18);
  169.   WriteLn(n,' different writers found in ',MsgDir,'.');
  170. End;
  171.  
  172. BEGIN
  173.   Intro_And_Init;
  174.   Process_Files;
  175.   Report_Results;
  176. END.