home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / HISOFTPASCAL2,0-2.DMS / in.adf / Demos / DirDemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-16  |  3.0 KB  |  99 lines
  1. Program Dirdemo;
  2. {$R+ Enables Ctrl-C breaks too}
  3.  
  4. Uses Dos;
  5.  
  6. { Filename: DirDemo.pas        }
  7. { Coder   : Jacob V. Pedersen  }
  8. { Coded   : 4-8-1990           }
  9. { Amiga   : Christen Fihl 1991 }
  10. { Purpose : Example            }
  11.  
  12. { Make a file listing with attributes shown }
  13.  
  14. {==========================================================================
  15.   Exercise for you:
  16.     Make code to calculate the total size of the directory,
  17.     and the total number of files in the directory
  18. ==========================================================================}
  19.  
  20. CONST
  21.   DisplayAttr:  Boolean = True;         { Show file attributes ?  }
  22.   DisplayTime:  Boolean = True;         { --------- time stamp ?  }
  23.   DisplayDate:  Boolean = True;         { --------- date stamp ?  }
  24.   OnlyArcFiles: Boolean = False;        { Only search for A flags }
  25.   PauseParam:   Boolean = False;        { Pause after each screen?}
  26.   DirName:      DirStr  = '';           { Current directory, initialized }
  27. VAR
  28.   DosData         : SearchRec;    { Information from DOS }
  29.   Dt              : DateTime;     { Holds the date and time }
  30.   N               : Integer;
  31.   S               : String;
  32.  
  33. {$Ifdef CPU86}        
  34. Const
  35.   DirFlags = '---vda----------';
  36. {$Endif}
  37.  
  38. { Traverse the directory while displaying the file information }
  39.  
  40. Procedure ShowDir( DirName : DirStr );
  41. Var
  42.   N,LineCounter : Integer;
  43.   Attr: Word;
  44.   Ch : Char;
  45.   DirFlag: String[16];
  46. Begin
  47.   DirFlag:=DirFlags;
  48.   LineCounter := 0;
  49.   If OnlyArcFiles then Attr:=Archive else Attr:=AnyFile;
  50.   FindFirst( DirName, Attr, DosData );
  51.   With DosData,Dt DO
  52.   While (DosError = 0) DO Begin
  53.     If (LineCounter = 24) AND PauseParam then Begin
  54.       LineCounter := 0;
  55.       Write('Press Return'); ReadLn;
  56.     End;
  57.     Inc(LineCounter);
  58.  
  59.     UnpackTime(Time,Dt);
  60.     Write(Name,'':20-Length(Name));
  61.     if Attr and VolumeID <> 0 then Write('<VOL>':10) else
  62.       If Attr and Directory <> 0 then Write('<DIR>' :10) else Write(Size:10);
  63.     If DisplayAttr then Begin
  64.       Write('  ');
  65.       for N:=Length(DirFlag) downto 1 do
  66.     if Attr and (1 shl (N-1)) <> 0 then
  67.       write(DirFlag[N]) else write('-');
  68.     End;
  69.     If DisplayDate then Write(Day:6,'-',Month div 10,Month mod 10,'/',Year);
  70.     If DisplayTime then Write(Hour:6,'.',Min div 10, Min mod 10);
  71.     Writeln;
  72.     FindNext(DosData);
  73.   End; { while doserror = 0 }
  74. End; { ShowDir }
  75.  
  76. BEGIN { main }
  77.   for N:=1 to ParamCount do begin {Read all parameters from command line}
  78.     S:=ParamStr(N);
  79.     if (Length(S)=2) and (S[1] in ['-','/']) then
  80.       case UpCase(S[2]) of
  81.       'A': OnlyArcFiles:=True;
  82.       'P': PauseParam :=True;
  83.       'D': {$Ifdef Amiga} PatternProc:=@PCDosPattern {$Endif};
  84.       'A': DisplayAttr:=False;
  85.       'T': begin DisplayTime:=False; DisplayDate:=False; end;
  86.       else Writeln('Bad parameter: ',S);
  87.       end
  88.     else DirName := S;
  89.   end;
  90.   {$Ifdef Amiga}
  91.     if DirName='' then
  92.       if PatternProc=@PCDosPattern then Dirname:='*.*' else DirName:='#?';
  93.   {$Else}
  94.     if DirName='' then DirName:='*.*';
  95.   {$Endif}
  96.   ShowDir(DirName);
  97. END.
  98. 
  99.