home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FLIST.ZIP / FLIST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-06-22  |  2.0 KB  |  89 lines
  1. {$R-,S-,I-,D-,T-,F-,V+,B+,N-,L+ }
  2. {$M 65000,0,0}
  3.  
  4. program FList;  { program to list all the files on a disk to standard output }
  5.                 { FList 1.0 }
  6.  
  7. { this is a very simple, single purpose utility }
  8. { the source code is provided so you can change }
  9. { it if you want it to work differently, or     }
  10. { discover a bug                                }
  11.  
  12. uses Dos;
  13.  
  14. type
  15.   PathName = string[64];
  16.  
  17. var
  18.   StartDir : PathName;
  19.   DiskDrive : char;
  20.   DriveString, Param1 : PathName;
  21.   L, Level, PCount : Integer;
  22.  
  23.   function AddBack(FDir : PathName) : PathName;
  24.   begin
  25.     if FDir[Length(FDir)] = '\' then
  26.       AddBack := FDir
  27.     else
  28.       AddBack := FDir+'\';
  29.   end;
  30.  
  31.   procedure SetDta(var Frec);
  32.   var
  33.     regs : Registers;
  34.   begin
  35.     regs.AH := $1A;
  36.     regs.DX := Ofs(Frec);
  37.     regs.DS := Seg(Frec);
  38.     Intr($21, regs);
  39.   end;
  40.  
  41.   procedure TourDir(FDir : PathName);
  42.   var
  43.     Frec : SearchRec;
  44.   begin
  45.     FindFirst(AddBack(FDir)+'*.*', AnyFile, Frec);
  46.     while DosError = 0 do begin
  47.       with Frec do
  48.         if Name[1] <> '.' then begin
  49.           WriteLn(AddBack(FDir)+Name);
  50.           Inc(Level);
  51.           TourDir(AddBack(FDir)+Name);
  52.           Dec(Level);
  53.           SetDta(Frec);
  54.         end;
  55.       FindNext(Frec);
  56.     end;
  57.   end;
  58.  
  59. begin
  60.   PCount := ParamCount;
  61.   Param1 := ParamStr(1);
  62.   if (PCount = 1)
  63.   and (pos('?', Param1) > 0) then begin
  64.     writeln;
  65.     writeln('FList              version 1.0         6-17-88');
  66.     writeln;
  67.     writeln('Syntax:');
  68.     writeln('            FList [drive] [> list redirection]');
  69.     writeln;
  70.     writeln('Examples:');
  71.     writeln('            flist');
  72.     writeln('            flist d:');
  73.     writeln('            flist c: > a:\files.c');
  74.     writeln('            flist > a:\files.c');
  75.     writeln;
  76.     halt(0);
  77.   end;
  78.   if PCount = 0 then
  79.     GetDir(0, DriveString)
  80.   else
  81.     DriveString := Param1;
  82.   DiskDrive := UpCase(DriveString[1]);
  83.   Level := 0;
  84.   if PCount = 0 then
  85.     TourDir('\')
  86.   else
  87.     TourDir(DiskDrive+':'+'\');
  88. end.
  89.