home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / turbopas / lcatcode.lbr / LCAT.PQS / LC.PAS
Encoding:
Pascal/Delphi Source File  |  1985-08-07  |  13.4 KB  |  371 lines
  1. { Turbo Pascal version of LCAT
  2.   by Paul Nance, October 6, 1984
  3.  
  4.   Compile at 8000
  5.  
  6.   Program designed to make a file called NAMESLBR.SUB with all files
  7.   from a given disk. Even the library files will be included in the
  8.   file. }
  9.  
  10.  
  11. program lcat;
  12.  
  13. {U+}
  14.  
  15. const
  16.    hfcbm      =    $39BF;
  17.    hfcb       =    $39C0;
  18.    hdmam      =    $39FF;
  19.    hdma       =    $3A00;
  20.  
  21. type
  22.    line       =    string[14];
  23.    lline      =    string[16];
  24.  
  25. var
  26.    filevar:                                  text;
  27.    list:                                     array[1..1000] of line;
  28.    hold:                                     lline;
  29.    lbrhold:                                  array[1..40] of lline;
  30.    lbrlbrhold:                               array[1..20] of lline;
  31.    lbrlbrlbrhold:                            array[1..20] of lline;
  32.    lbrlbrlbrlbrhold:                         array[1..20] of lline;
  33.    a,b,z,i,j,n,q,t,y,zz,drnum,entries, test: integer;
  34.    x:                                        byte;
  35.    base,base1,base2,base3,olddrive:          integer;
  36.    dr:                                       byte absolute $5C;
  37.    ext:                                      string[3];
  38.    drstr:                                    string[16];
  39.    dmastr:                                   byte absolute hdmam;
  40.    dma:                                      string[129] absolute hdmam;
  41.    fcb:                                      string[16] absolute hfcbm;
  42.    rl:                                       byte absolute $39E1;
  43.    rh:                                       byte absolute $39E2;
  44.    rz:                                       byte absolute $39E3;
  45.    loop,olduser,zzz,zzzz:                    integer;
  46.    user:                                     string[1];
  47.    done,sortdone:                            boolean;
  48.    lo, hi :                                  integer;
  49.  
  50.  
  51.  
  52. procedure setlr;
  53. begin
  54.    rl := base mod 256;
  55.    rh := base div 256;
  56.    rz := 0;
  57.    x := bdos($21, hfcb);
  58. end;
  59.  
  60. procedure despace;
  61. begin
  62.    for t := 1 to i do
  63.    begin
  64.       test := pos(' ', list[t]);
  65.       if test = 0 then
  66.          hold := copy(list[t], 1, 8) + '.' + copy(list[t], 9, length(list[t]) - 8)
  67.       else
  68.          hold := copy(list[t], 1, test-1) + '.' + copy(list[t], 9, length(list[t]) - 8);
  69.       test := pos('.', hold);
  70.       if (hold[1] = '-') and (test + 4 <= length(hold)) then
  71.       begin
  72.          repeat
  73.             test := ord(hold[1]);
  74.             if test = 45 then
  75.                hold := copy(hold, 2, length(hold) - 1);
  76.          until test <> 45;
  77.       end;
  78.       list[t] := hold;
  79.    end;
  80. end;
  81.  
  82.  
  83.  
  84.  
  85. begin  { main }
  86.    writeln('LCAT  v1.0  (c)  Paul Nance, 10/6/84');
  87.    writeln;
  88.    drnum := ord(dr);
  89.    olddrive := bdos($19);
  90.    olduser := bdos($20, $FF);
  91.    if drnum = 0 then
  92.    begin
  93.       writeln('LCAT v1.0 library cataloging system');
  94.       writeln('Usage:');
  95.       writeln('         LCAT d:');
  96.       writeln('Examples:');
  97.       writeln('         LCAT A:      catalogs A disk');
  98.       writeln('         LCAT B:      catalogs B disk');
  99.       writeln;
  100.       writeln('LCAT was designed to create a file called NAMESLBR.SUB,');
  101.       writeln('containing an alphabetized list of all the files on the disk.');
  102.       writeln('Library files in library files are also included if not squeezed.');
  103.       writeln('It is ok to squeeze regular files in libraries but not LBR files.');
  104.       writeln('This will work up to four levels deep. Required companion files');
  105.       writeln('are ULCAT.COM, CATL.COM and MASTL.CAT.');
  106.    end
  107.    else
  108.    begin
  109.       for z := 1 to 1000 do
  110.          list[z][0] := chr(0);
  111.       write('reading directory                           ');
  112.       bdos($E, drnum-1);
  113.       drstr := '????????????' + #0#0#0#0;
  114.       fcb := drstr;
  115.       bdos(26, hdma);
  116.       x := bdos($11, hfcb);
  117.       dmastr := $80;
  118.       hold := copy(dma, (x * 32) + 1, 12);
  119.       if (x <> $FF) and (hold[1] <> chr($E5)) then
  120.       begin
  121.          i := 1;
  122.          z := 0;
  123.          zz := 0;
  124.          list[i] := copy(hold, 2, 11);
  125.          if copy(list[i], 9, 3) = 'LBR' then
  126.          begin
  127.             z := z + 1;
  128.             lbrhold[z] := hold;
  129.          end;
  130.       end;
  131.       if x <> $FF then
  132.       begin
  133.          repeat
  134.             x := bdos($12, hfcb);
  135.             if x <> $FF then
  136.             begin
  137.                dmastr := $80;
  138.                hold := copy(dma, (x * 32) + 1, 12);
  139.                if hold[1] <> chr($E5) then
  140.                begin
  141.                   i := i + 1;
  142.                   n := i;
  143.                   list[i] := copy(hold, 2, 11);
  144.                   for y := 1 to i - 1 do
  145.                      if list[y] = list[i] then
  146.                         if i = n then
  147.                            i := i - 1;
  148.                   if copy(list[i], 9, 3) = 'LBR' then
  149.                      if i = n then
  150.                   begin
  151.                      z := z + 1;
  152.                      lbrhold[z] := hold;
  153.                   end;
  154.                end;
  155.             end;
  156.          until x = $FF;
  157.          j := i;
  158.          zz := 0;
  159.          for t := 1 to z do
  160.          begin
  161.             write(chr(13), 'reading LBR directory                       ');
  162.             bdos($20, ord(lbrhold[t][1]));
  163.             fcb := chr(drnum) + copy(lbrhold[t], 2, 11) + #0#0#0#0;
  164.             x := bdos($F, hfcb);
  165.             if x <> $FF then
  166.             begin
  167.                rl := 0;
  168.                rh := 0;
  169.                rz := 0;
  170.                bdos(26, hdma);
  171.                x := bdos($21, hfcb);
  172.                if x = 0 then
  173.                   if copy(dma, 2, 11) = '           ' then
  174.                begin
  175.                   entries := ord(dma[15]) * 4;
  176.                   for n := 2 to entries do
  177.                   begin
  178.                      if (n mod 4) = 1 then
  179.                      begin
  180.                         base := n div 4;
  181.                         setlr;
  182.                      end;
  183.                      dmastr := $80;
  184.                      hold := copy(dma, (((n mod 4) * 32) + 1), 16);
  185.                      if x = 0 then
  186.                         if ord(hold[1]) = 0 then
  187.                            if hold[2] <> ' ' then
  188.                      begin
  189.                         i := i + 1;
  190.                         list[i] := copy(hold, 2, 11) + 'L';
  191.                         if copy(list[i], 9, 3) = 'LBR' then
  192.                         begin
  193.                            zz := zz + 1;
  194.                            lbrlbrhold[zz] := hold;
  195.                         end;
  196.                      end;
  197.                   end;
  198.                   loop := zz;
  199.                   zz := 0;
  200.                   zzz := 0;
  201.                   for q := 1 to loop do
  202.                   begin
  203.                      write(chr(13), 'reading LBR LBR directory                 ');
  204.                      hold := lbrlbrhold[q];
  205.                      base1 := ord(hold[13]) + ord(hold[14]);
  206.                      base := base1;
  207.                      setlr;
  208.                      if x = 0 then
  209.                         if copy(dma, 2, 11) = '           ' then
  210.                      begin
  211.                         entries := ord(dma[15]) * 4;
  212.                         for n := 2 to entries do
  213.                         begin
  214.                            if (n mod 4) = 1 then
  215.                            begin
  216.                               base := base1 + n div 4;
  217.                               setlr;
  218.                            end;
  219.                            dmastr := $80;
  220.                            hold := copy(dma, (((n mod 4) * 32) + 1), 16);
  221.                            if x = 0 then
  222.                               if ord(hold[1]) = 0 then
  223.                                  if hold[2] <> ' ' then
  224.                            begin
  225.                               i := i + 1;
  226.                               list[i] := copy(hold, 2, 11) + 'L2';
  227.                               if copy(list[i], 9, 3) = 'LBR' then
  228.                               begin
  229.                                  zzz := zzz + 1;
  230.                                  hold[0] := chr(16);
  231.                                  hold[1] := chr(n mod 4);
  232.                                  hold[15] := chr(base1 mod 256);
  233.                                  hold[16] := chr(base1 div 256);
  234.                                  lbrlbrlbrhold[zzz] := hold;
  235.                               end;
  236.                            end;
  237.                         end;
  238.                      end;
  239.                   end;
  240.                   loop := zzz;
  241.                   zzz := 0;
  242.                   zzzz := 0;
  243.                   for q := 1 to loop do
  244.                   begin
  245.                      write(chr(13), 'reading LBR LBR LBR directory            ');
  246.                      hold := lbrlbrlbrhold[q];
  247.                      base2 := ord(hold[13]) + ord(hold[14]) * 256 + ord(hold[15]) + ord(hold[16]) * 256;
  248.                      base := base2;
  249.                      setlr;
  250.                      if x = 0 then
  251.                         if copy(dma, 2, 11) = '           ' then
  252.                      begin
  253.                         entries := ord(dma[15]) * 4;
  254.                         for n := 2 to entries do
  255.                         begin
  256.                            if (n mod 4) = 1 then
  257.                            begin
  258.                               base := base2 + n div 4;
  259.                               setlr;
  260.                            end;
  261.                            dmastr := $80;
  262.                            hold := copy(dma, (((n mod 4) * 32) + 1), 16);
  263.                            if x = 0 then
  264.                               if ord(hold[1]) = 0 then
  265.                                  if hold[2] <> ' ' then
  266.                            begin
  267.                               i := i + 1;
  268.                               list[i] := copy(hold, 2, 11) + 'L3';
  269.                               if copy(list[i], 9, 3) = 'LBR' then
  270.                               begin
  271.                                  zzzz := zzzz + 1;
  272.                                  hold[0] := chr(16);
  273.                                  hold[1] := chr(n mod 4);
  274.                                  hold[15] := chr(base2 mod 256);
  275.                                  hold[16] := chr(base2 div 256);
  276.                                  lbrlbrlbrlbrhold[zzzz] := hold;
  277.                               end;
  278.                            end;
  279.                         end;
  280.                      end;
  281.                   end;
  282.                   loop := zzzz;
  283.                   zzzz := 0;
  284.                   for q := 1 to loop do
  285.                   begin
  286.                      write(chr(13), 'reading LBR LBR LBR LBR directory        ');
  287.                      hold := lbrlbrlbrlbrhold[q];
  288.                      base3 := ord(hold[13]) + ord(hold[14]) * 256 + ord(hold[15]) + ord(hold[16]) * 256;
  289.                      base := base3;
  290.                      setlr;
  291.                      if x = 0 then
  292.                         if copy(dma, 2, 11) = '           ' then
  293.                      begin
  294.                         entries := ord(dma[15]) * 4;
  295.                         for n := 2 to entries do
  296.                         begin
  297.                            if (n mod 4) = 1 then
  298.                            begin
  299.                               base := base3 + n div 4;
  300.                               setlr;
  301.                            end;
  302.                            dmastr := $80;
  303.                            hold := copy(dma, (((n mod 4) * 32) + 1), 16);
  304.                            if x = 0 then
  305.                               if ord(hold[1]) = 0 then
  306.                                  if hold[2] <> ' ' then
  307.                            begin
  308.                               i := i + 1;
  309.                               list[i] := copy(hold, 2, 11) + 'L4';
  310.                               if copy(list[i], 9, 3) = 'LBR' then
  311.                               begin
  312.                                  writeln(chr(13), 'Can''t read a LBR, LBR, LBR, LBR, LBR dir!');
  313.                               end;
  314.                            end;
  315.                         end;
  316.                      end;
  317.                   end;
  318.                end;
  319.                bdos($20, olduser);
  320.             end;
  321.          end;
  322.       end;
  323.       despace;
  324.       write(chr(13), 'sorting list...                          ');
  325.       a := 1;
  326.       z := i;
  327.       if a < z then
  328.       begin
  329.          if list[a] > list[z] then
  330.          begin
  331.             hold := list[a];
  332.             list[a] := list[z];
  333.             list[z] := hold;
  334.          end;
  335.          repeat
  336.             for n := (a + 1) to (z - 1) do
  337.             begin
  338.                if list[a] > list[n] then
  339.                begin
  340.                   hold := list[a];
  341.                   list[a] := list[n];
  342.                   list[n] := hold;
  343.                end;
  344.                if list[n] > list[z] then
  345.                begin
  346.                   hold := list[n];
  347.                   list[n] := list[z];
  348.                   list[z] := hold;
  349.                end;
  350.             end;
  351.          a := a + 1;
  352.          z := z - 1;
  353.          until a >= z;
  354.       end;
  355.       write(chr(13), 'creating NAMESLBR.SUB file               ');
  356.       bdos($E, olddrive);
  357.       assign(filevar, chr(olddrive + 65) + ':NAMESLBR.SUB');
  358.       rewrite(filevar);
  359.       writeln;
  360.       for t := 1 to i do
  361.       begin
  362.          writeln(list[t]);
  363.          writeln(filevar, list[t]);
  364.       end;
  365.       close(filevar);
  366.       writeln;
  367.       writeln(i, ' files, including ', i - j, ' LBR files');
  368.    end;
  369. end.     { LCAT.PASCAL }
  370.  
  371.