{
 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 Followin attributes added
 Functions  :
  Centered
  Dash
  ConstStr
 Procedures :
  PutItUp

 Changed Code to allow automatic display of logged DU directory will allow
 code to be included in Turbo Pascal Program or chaining from main turbo
 routine.

 Added prompt for which drive change source for your own system
 if you have more than two drives add something like ['A..P']; and
 change appropriate prompt.

 Added code to display total amount disk space used.

 Added header.

}

Program dir;
label start;
const
 columns   = 4;
 fence     = ' | ';
 header    = 'File     Ext Size   File     Ext Size   File     Ext Size   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
 CH : Char;
 entries: integer;                         { Count of directory entries }
 prototype: FileName;                      { Directory mask }
 first: FilePtr;                           { Start of linked list }
 searchblk: FileBlock;                     { Block for search }
 CtrPrg: File;

Function ConstStr(C : Char; N : Integer) : Str80;
var
 S : string[80];
begin
 if N < 0 then
   N := 0;
 S[0] := Chr(N);
 FillChar(S[1],N,C);
 ConstStr := S;
end;

Function Centered(TheString:Str80):Str80;
begin
 Centered := ConstStr(' ',((80 - Length(TheString)) Div 2)) +
 TheString;
end;

Function Dash(Spaces : Integer) : Str80;
var
 Column : Integer;
 Temp   : Str80;
begin
 Temp :='';
 For Column := 1 to Spaces do
 begin
   Temp := Temp + '-';
   Dash := Temp;
 end;
end;

Function Tab(Spaces : Integer) : Str80;
var
 Column : Integer;
 Temp   : Str80;
begin
 Temp :='';
 For Column := 1 to Spaces do
 begin
   Temp := Temp + '-';
   Dash := Temp;
 end;
end;

Procedure Choice(    Prompt : Str80;
                    Term   : CharSet;
                var TC     : Char    );
var
 Ch : Char;
begin
 GotoXY(1,23); Write(Prompt); ClrEol;
 repeat
   Read(Kbd,Ch);
   TC := Upcase(Ch);
   if not (TC in Term) then
     write(^G);
 until TC in Term;
 Write(Ch);
end;

Procedure ClearFrame;
var
 I : Integer;
begin
 for I := 20 downto 3  do
 begin
   GotoXY(1,I + 1); ClrEol ;
 end;
end;

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

   function trim(st: StrStd): StrStd;
   { Trim leading and trailing blanks }
     var
      i, j: integer;
     begin
       i := 1;
       j := length(st);
       while (st[i] = ' ') and (i <= j) do
         i := succ(i);
       while (st[j] = ' ') and (j >= i) do
         j := pred(j);
       trim := copy(st, i, j - i + 1)
     end;

   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
     repeat
       Choice('Directory for which drive ( A or B ) ? ',['A','B'],Ch);
     until Ch <> '';
     ClearFrame;
     line := Ch+':*.*';
     line := trim(line);
     for i := 1 to length(line) do
       line[i] := UpCase(line[i]);
     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
   end;

 procedure ReadDir(prototype: filename; var entries: integer; var first: FilePtr);
 { Create an alphabetized list of files which match the prototype }
   const
     findfirst = 17;                       { BDOS function - search for first file }
     findnext  = 18;                       { BDOS function - search for next file}
     setdma    = 26;                       { BDOS function - set dma buffer address }
     fcb       = $80;                      { Default dma buffer address }
   type
     dirblock  = array [0..3] of FileBlock;
     fileblptr = ^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,                                  { file name entry being created }
       this, previous: FilePtr;            { followers for insertion }
     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 { Non-system? }
             then
               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, size,totsize: integer;
     OldName: FilePtr;
   begin
     i := 0;
     totsize := 0;
     GotoXY(1,6);
     WriteLn(Header); WriteLn;
     while first <> nil do
       begin                               { Scan the whole list }
         size := first^.fsize shr 3;
         totsize := totsize + size;
         if 0 <> (first^.fsize mod 8)
           then size := succ(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
             end
       end;
       WriteLn;
       WriteLn;
       write('Total number of Files : ',entries);
       writeln('              Using a total of : ',totsize,' K');
   end;

 begin { main }
   ClrScr;
   GotoXY(1,1); Writeln(ConstStr('-',79)); WriteLn; Write(ConstStr('-',79));
   GotoXY(1,2); Write(Centered('Disk Directory Routine'));
   GotoXY(1,22); Writeln(ConstStr('-',79)); WriteLn; Write(ConstStr('-',79));
   start :
   clearFrame;
   GetMask(prototype);                     { Read mask }
   ReadDir(prototype, entries, first);     { Read directory }
   DispDir(entries, first);                { Display directory }
   repeat
     Choice('Do directory on another drive ( Y or N ) : ',['Y','N'],CH);
     if Ch = 'Y' then goto start;
   until Ch = 'N';
   ClrScr;
 end.


You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.