home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / CATLOG / DCAT10.LBR / DCAT10.PQS / dcat10.pas
Pascal/Delphi Source File  |  2000-06-30  |  6KB  |  168 lines

  1. PROGRAM DCAT;
  2. {$r+}
  3. {$c+}
  4. {$U+}
  5. {
  6.  *******************************************
  7.  * DCAT - Catalog Listing Of Disk Programs *
  8.  *        Grouped By Disk                  *
  9.  *                                         *
  10.  *   Program to make List Of all disks     *
  11.  *      from the MAST.CAT file             *
  12.  *     built by the MCAT program.          *
  13.  *                                         *
  14.  *   The programs will be grouped          *
  15.  *     by disk and in alphabetical order.  *
  16.  *     This program differs from the XCAT  *
  17.  *     program in that XCAT orders its     *
  18.  *     output based on file name regardless*
  19.  *     of which disks the files reside on. *
  20.  *******************************************
  21.  
  22.  This program is placed in the public domain.  It may be updated
  23.  or altered but should again be placed in the public domain.
  24.  
  25.   9/08/85 * Initial release of the program.  It is written in
  26.    V10      Turbo Pascal.
  27.           * The program is hardcoded to expect that no file names
  28.             (or at most one file name) is to be overlooked by the 
  29.             MCAT program.
  30.           * The program also relies on the parameter "NumberOfDisks"
  31.             which must be set large enough to cover the largest 
  32.             disk number.  A value of 7 will cover disks 1 through
  33.             79 and a value of 9 would cover all disks up to 99.
  34.                              - Lew Edinburg
  35.                                Sunnyvale, CA
  36. }
  37.  
  38. CONST
  39.   Version:        String[4] = '1.0';
  40.   Blank:          String[78] = '                          ';
  41.   FormFeed        =#12;
  42.   PageSize:       Integer = 60;
  43.   NumberOfDisks:  Integer = 7;   {set to indicate how many disks are
  44.                                   cataloged in MAST.CAT.  
  45.                                                    Number Of Disks 
  46.                                    NumberOfDisks     Cataloged
  47.                                    --------------  ----------------
  48.                                         5               59
  49.                                         7               79
  50.                                         9               99  }
  51.   NumberToProces  = 10;
  52.  
  53. VAR
  54.   CR:             string[1];
  55.   CurrLine:       Integer;
  56.   InputData:      text;
  57.   TempLine:       string[30];
  58.   Temp:           string[14];
  59.   LineOut:        string[60];
  60.   Group:          Integer;
  61.   I:              Integer;
  62.   II:             Integer;
  63.   III:            Integer;
  64.   IV:             Integer;
  65.   Files:          ARRAY [0..450] OF STRING[20];
  66.   DiskNumber:     string[10];
  67.   DiskIndex:      Integer;
  68.   ResultCode:     Integer;
  69.   FilesList:      ARRAY [0..NumberToProces,1..65] OF STRING[12];
  70.   FileIndex:      ARRAY [0..NumberToProces] OF Integer;
  71.   LimitIndex:     Integer;
  72.   X:              Integer;
  73.   IMAX:           Integer;
  74. {****************************************************************}
  75.  
  76. BEGIN
  77.  
  78. {Print out initial query}
  79. ClrScr;
  80. Writeln;
  81. Writeln;
  82. Writeln('        DCAT Program        Version ',Version);
  83. Writeln;
  84. Writeln('The program will print out a listing of the files on all ');
  85. Writeln('  disks based on the file MAST.CAT.  They will be grouped');
  86. Writeln('  by disk. ');
  87. Writeln;
  88. WriteLn;
  89. WriteLn('Turn the printer on. ',^G);
  90. WriteLn;
  91. WriteLn('Press <CR> when the printer is ready.');
  92. ReadLn(CR);
  93. WriteLn;
  94.  
  95. CurrLine := 1;
  96. FOR Group := 0 TO NumberOfDisks DO BEGIN
  97.   { Read MAST.CAT into FILES tables (indexed by disk number) }  
  98.   ASSIGN(InputData,'MAST.CAT');
  99.   Reset(InputData);
  100.   ReadLn(InputData,TempLine); {This statement skips past the
  101.                                first entry in MAST.CAT, ie the
  102.                                assumption is that MCAT has been
  103.                                used to skip at most one file name
  104.                                when cataloging files}
  105.   I := 0 ;
  106.   IV := 0;
  107.   While NOT Eof(InputData) DO
  108.     Begin
  109.     Readln(InputData,TempLine);
  110.     IV := IV + 1;
  111.     II := POS(',',TempLine);
  112.     DiskNumber := COPY(TempLine,II+2,3);
  113.     VAL (DiskNumber,DiskIndex,ResultCode);
  114.     IF DiskIndex >= NumberToProces*Group THEN
  115.     IF DiskIndex <= NumberToProces * (Group + 1) THEN BEGIN
  116.        Files[I] := TempLine;
  117.        I := I +1;
  118.     End;
  119.   End;
  120.   Close(InputData);
  121.   IMAX := I-2;
  122.  
  123.   FOR I:= 0 TO NumberToProces DO BEGIN
  124.     FileIndex[I] := 0;
  125.   End;
  126.  
  127.   FOR I := 0 TO IMAX DO BEGIN
  128.     TempLine := Files[I];
  129.     II := POS(',',TempLine);
  130.     DiskNumber := COPY(TempLine,II+2,5);
  131.     VAL(DiskNumber,DiskIndex,ResultCode);
  132.     LimitIndex := DiskIndex - Group * NumberToProces;
  133.     FileIndex[LimitIndex] := FileIndex[LimitIndex] +1;
  134.     x := FileIndex[LimitIndex];
  135.     II := II - 1;
  136.     Temp := COPY(TempLine,1,II);
  137.     FilesList[LimitIndex][X] := Temp;
  138.   End;
  139.   FOR I := 1 TO NumberToProces DO
  140.   Begin
  141.     II := FileIndex[LimitIndex];
  142.     If CurrLine >= (PageSize-(2+II/4)) THEN BEGIN
  143.       WriteLn (Lst,FormFeed);
  144.       CurrLine := 1;
  145.     End;
  146.   WriteLn(Lst,'            Disk number: ',I + Group*NumberToProces,' has ',FileIndex[I],' files.');
  147.     CurrLine := CurrLine + 1;
  148.     III := 1;
  149.     LineOut := '                                          ';
  150.     FOR II := 1 TO FileIndex[I] DO BEGIN
  151.       IF III >4 THEN III := 1;
  152.       IV := III * 16 - 15;
  153.       INSERT (FilesList[I,II],LineOut,IV);
  154.       III := III +1;
  155.       IF III = 5 THEN
  156.       IF II <> FileIndex[I] THEN BEGIN
  157.         WriteLn(Lst,'            ',LineOut);
  158.         CurrLine := CurrLine + 1;
  159.       End;
  160.       IF II <> FileIndex[I] THEN
  161.      IF III = 5 THEN LineOut := '                                           ';
  162.   End;
  163.      WriteLn(Lst,'            ',LineOut);
  164.      CurrLine := CurrLine +2;
  165.      WriteLn(Lst,'    ');
  166.      END;
  167.    END;
  168. END.