home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / VRAC / DIRCNT16.ZIP / DIROV.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-07  |  4KB  |  189 lines
  1.  
  2. (*
  3.  * dirov - produce an overview of a DIRCOUNT formatted area summary
  4.  *
  5.  *)
  6.  
  7. (* --------------------------------------------------------- *)
  8. function remove_commas(s: string): string;
  9. var
  10.    i: integer;
  11.    t: string;
  12. begin
  13.    t := '';
  14.    for i := 1 to length(s) do
  15.       case s[i] of
  16.          '0'..'9':
  17.             t := t + s[i];
  18.       end;
  19.    remove_commas := t;
  20. end;
  21.  
  22.  
  23. (* --------------------------------------------------------- *)
  24. function atoi(s: string): longint;
  25. var
  26.    i: integer;
  27.    l: longint;
  28. begin
  29.    s := remove_commas(s);
  30.    val(s,l,i);
  31.    atoi := l;
  32. end;
  33.  
  34.  
  35. (* --------------------------------------------------------- *)
  36. function insert_commas(s: string): string;
  37. var
  38.    i: integer;
  39. begin
  40.    i := length(s);
  41.    while i > 3 do
  42.    begin
  43.       dec(i,3);
  44.       insert(',',s,i+1);
  45.    end;
  46.  
  47.    insert_commas := s;
  48. end;
  49.  
  50.  
  51. (* --------------------------------------------------------- *)
  52. function itoa (n: longint): string;
  53. var
  54.    tstr:          string;
  55.  
  56. begin
  57.    str(n, tstr);
  58.    itoa := insert_commas(tstr);
  59. end;
  60.  
  61.  
  62. (* --------------------------------------------------------- *)
  63. function itoan(n: longint; width: integer): string;
  64. var
  65.    s: string;
  66. begin
  67.    s := itoa(n);
  68.    while length(s) < width do
  69.       s := ' ' + s;
  70.    itoan := s;
  71. end;
  72.  
  73.  
  74. (* --------------------------------------------------------- *)
  75. function ljust(s: string; width: integer): string;
  76. begin
  77.    s := copy(s,1,width);
  78.    while length(s) < width do
  79.       s := s + ' ';
  80.    ljust := s;
  81. end;
  82.  
  83.  
  84. (* --------------------------------------------------------- *)
  85. function center(s: string; width: integer): string;
  86. var
  87.    i: integer;
  88. begin
  89.    s := copy(s,1,width);
  90.    i := (width - length(s)) div 2;
  91.    while i > 0 do
  92.    begin
  93.       s := ' ' + s;
  94.       dec(i);
  95.    end;
  96.    center := s;
  97. end;
  98.  
  99.  
  100. (* --------------------------------------------------------- *)
  101. function cjust(s: string; width: integer): string;
  102. var
  103.    i: integer;
  104. begin
  105.    s := copy(s,1,width);
  106.    i := (width - length(s)) div 2;
  107.    while i > 0 do
  108.    begin
  109.       s := ' ' + s;
  110.       dec(i);
  111.    end;
  112.    while length(s) < width do
  113.       s := s + ' ';
  114.    cjust := s;
  115. end;
  116.  
  117. (* --------------------------------------------------------- *)
  118. var
  119.    boardname:  string;
  120.    confname:   string;
  121.    line:       string;
  122.    oline:      string;
  123.    fd:         text;
  124.    i,deswid,k:      integer;
  125.  
  126. begin
  127.    if paramcount <> 2 then
  128.    begin
  129.       writeln('Usage: DIROV sumfile descwidth >outfile');
  130.       writeln('Produces an overview of a report file generated by DIRCOUNT');
  131.       writeln('Parameters:');
  132.       writeln('   sumfile specifies the input file, as produced by DIRCOUNT');
  133.       writeln('   descwidth specifies the maximum width of descriptions');
  134.       writeln('   outfile specifies the output file for the overview');
  135.       halt;
  136.    end;
  137.  
  138.    assign(fd,paramstr(1));
  139.    reset(fd);
  140.  
  141.    val(paramstr(2),deswid,k);
  142.  
  143.    readln(fd);
  144.    readln(fd,boardname);
  145.  
  146.    readln(fd,confname);
  147.    while copy(confname,1,1) = ' ' do
  148.       delete(confname,1,1);
  149.  
  150.    if confname[1] = '[' then
  151.    begin
  152.       delete(confname,1,1);
  153.       dec(confname[0]);
  154.    end;
  155.  
  156.    while length(confname) < 40 do
  157.       confname := confname + ' ';
  158.  
  159.    if (deswid > 35) or (deswid < 1) then
  160.       deswid := 35;
  161.  
  162.    repeat
  163.       readln(fd,line);
  164.  
  165.       if (length(line) = 73) and (line[6] in ['0'..'9']) then
  166.       begin
  167.          for i := 1 to length(line) do
  168.             if line[i] = '·' then
  169.                line[i] := ' ';
  170.          oline := copy(line,4,3) + '-' + copy(line,12,deswid+1);
  171.  
  172.          while oline[length(oline)] = ' ' do
  173.             dec(oline[0]);
  174.  
  175.          if length(oline) > deswid+4 then
  176.          begin
  177.             oline[deswid+3] := '.';
  178.             oline[deswid+4] := '.';
  179.             oline[0] := chr(deswid+4);
  180.          end;
  181.  
  182.          writeln(oline);
  183.       end;
  184.  
  185.    until eof(fd);
  186.    close(fd);
  187. end.
  188.  
  189.