{

CP/M-80 directory program written in Turbo Pascal 2.0.
Based loosely on wildcard.pas, author and compiler unknown.
Accepts ambiguous file names and displays sorted directory.
File sizes rounded to next 1k increment.
Steve Fox - Albuquerque RCP/M (505)299-5974
Version 1.0 29 Mar 1985

Revised 23 Apr 85 by : William L. Mabee, CRNA.

Changed code to allow automatic display of logged DU directory. Code can 
be included in a Turbo Pascal program or chained to from a main Turbo 
routine. Added code to display total amount of disk space used. Added 
header.

21 June 08 - removed unused functions, added command tail processing,
changed file size calculation to reflect 4K allocation block size, added
pause when more than 80 files are found, added S option (include System
files), added Usage text - Lee Bradley

}

program dir;
const
  columns   = 4;
  fence     = ' | ';
  h1        = 'File     Ext Size   ';
type
  CharSet   = set of char;
  FileName  = string[14];     { d:filename.ext }
  Str80     = string[80];
  StrStd    = string[127];
  FilePtr   = ^FileDescr;
  FileDescr =
    record
      fname: FileName;  { Name of a matching file }
      fsize: integer;   { Size of file }
      Next: FilePtr;    { Points to next name on linked list }
    end;
  FileBlock =
    record
      case boolean of
        true:
          (drive: byte;                     { Byte code }
           fname: array[1..11] of char;     { File name }
           extent,                          { Current extent }
           s1, s2, reccount: byte;          { Used to compute file size }
           dn: array[16..31] of byte);
        false:
          (init: array[1..32] of byte);
    end;
var
  entries: integer;                         { Count of directory entries }
  prototype: FileName;                      { Directory mask }
  first: FilePtr;                           { Start of linked list }
  searchblk: FileBlock;                     { Block for search }

{$I paramstb.inc}

procedure GetMask(var prototype: FileName);
  { Get ambiguous file name and expand into directory mask (prototype) }
    label label1;
    var
      i,j: integer;
      line: StrStd;

    function pad(line: StrStd; i: integer): StrStd;
    { Pad line with spaces to length of i }
      begin
        while length(line) < i do
          line := line + ' ';
        pad := line
      end;

    begin
      line := paramstr(1);
      if Pos('/',line) <> 0 then goto label1;
      if line = '' then line := '*.*';
      line := pad(line, 14);
      prototype := copy(line, 1, 14);
      FillChar(searchblk.init, 32, 0);
      with searchblk do
        begin
          if prototype[2] = ':'
            then
              begin
                drive := succ(ord(prototype[1]) - ord('A'));
                i := 3
              end
            else
              begin
                drive := 0;
                i := 1
              end;
          fname := '           ';
          j := 1;
          repeat
            begin
              if prototype[i] = '*'
                then while j <= 8 do
                  begin
                    fname[j] := '?';
                    j := succ(j)
                  end
                else
                  begin
                    fname[j] := prototype[i];
                    j := succ(j)
                  end
            end;
            i := succ(i)
          until (j > 8) or (prototype[i] = '.');

          while (prototype[i] <> '.') and (prototype[i] <> ' ') do
            i := succ(i);

          i := succ(i);
          j := 9;
          repeat
            begin
              if prototype[i] = '*'
                then while j <= 11 do
                  begin
                    fname[j] := '?';
                    j := succ(j)
                  end
                else
                  begin
                    fname[j] := prototype[i];
                    j := succ(j)
                  end
            end;
            i := succ(i)
          until (j > 11) or (prototype[i] = '.');
          extent := ord('?');
          s1     := ord('?');
          s2     := ord('?')
        end;
        label1:
    end;

procedure ReadDir(
  prototype: filename; var entries: integer; var first: FilePtr);
  { Create an alphabetized list of files which match the prototype }
    const
      findfirst = 17;   { search for first file }
      findnext  = 18;   { search for next file }
      setdma    = 26;   { set dma buffer address }
      fcb       = $80;  { Default dma buffer address }
    type
      dirblock  = array [0..3] of FileBlock;
    var
      off: integer;         { dir entry offset or end flag }
      fn: FileName;
      answerblk: dirblock;  { block to receive file name }

    procedure InsertFile(
      fn: FileName; fs: integer; var entries: integer; var first: FilePtr);
    { Insert a new file name in the alphabetic list }
      var
        f,this,previous: FilePtr;    { created, inserted }
      begin
        previous := nil;
        this := first;
        while (this <> nil) and (this^.fname < fn) do
          begin
            previous := this;
            this := this^.next
          end;
        if this^.fname <> fn then
          begin
            entries := succ(entries);
            new(f);
            f^.fname := fn;
            f^.fsize := fs;
            f^.next  := this;
            if previous = nil then first := f
            else previous^.next := f
          end
        else if this^.fsize < fs then this^.fsize := fs
      end;

    begin { ReadDir }
      entries := 0;
      first := nil;
      BDOS(setdma, addr(answerblk));
      off := BDOS(findfirst, addr(searchblk));
      while off <> 255 do
        begin
          with answerblk[off] do
            if (((ord(fname[10]) and $80) = 0) or
             (Pos('S',paramstr(2)) <> 0)) then
             { Non-system? or include System }
                begin
                  drive := 11;              { File name length }
                  move(drive, fn, 12);      { File name }
                  insert('.', fn, 9);
                  InsertFile(
                  fn, reccount + (extent + (s2 shl 5)) shl 7, entries, first);
                end;
          off := BDOS(findnext, addr(searchblk));
        end;
      BDOS(setdma, fcb)    { Restore DMA buffer }
    end;

procedure DispDir(entries: integer; first: FilePtr);
  { Display directory list }
    var
      i,j,size,totsize: integer;
      OldName: FilePtr;
      Ch: Char;
    begin
      i := 0;j := 0;
      totsize := 0;
      WriteLn;WriteLn(h1+h1+h1+h1);
      while first <> nil do
        begin                               { Scan the whole list }
          size := first^.fsize shr 3;
          if 0 <> (first^.fsize mod 8) then size := succ(size);
          if size mod 4 <> 0 then size := size + 4 - size mod 4;
          totsize := totsize + size;
          Write(first^.fname, size:4, 'K');
          i := succ(i);
          Oldname := first;
          first := first^.Next;             { Go to next on chain }
          dispose(Oldname);                 { Reclaim space }
          if i < columns then Write(fence)
          else begin WriteLn;i := 0;j := succ(j) end;
          if j=20 then begin
            j := 0;Write('Strike Any Key ... ');Read(Kbd,Ch);WriteLn
          end;
        end;
        WriteLn;WriteLn;Write('Total number of Files : ',entries);
        WriteLn('              Using a total of : ',totsize,'K');
    end;

  begin
    GetMask(prototype);                     { Read mask }
    if Pos('/',paramstr(1)) <> 0 then
      WriteLn(^J^M'Usage: TDIR [[d:]afn.aft [S]]')
    else begin
      ReadDir(prototype, entries, first);     { Read directory }
      DispDir(entries, first);                { Display directory }
    end;
  end .