home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9101 / diskarch / readdir.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-10-02  |  3.6 KB  |  123 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      READDIR.PAS                       *)
  3. (*                                                        *)
  4. (* Aufruf : READDIR <StartDir> <BufferFile>               *)
  5. (*                                                        *)
  6. (*          StartDir   : Laufwerk  (z.B. 'A:')            *)
  7. (*          BufferFile : Dateiname (z.B. 'Alldirs.asc')   *)
  8. (*                                                        *)
  9. (*          das Bufferfile ist im aktuellen Verzeichnis   *)
  10. (*          und wird auf jeden Fall überschrieben.        *)
  11. (*                                                        *)
  12. (*             (c) 1991 W.Rinke & DMV-Verlag              *)
  13. (* ------------------------------------------------------ *)
  14. PROGRAM ReadDir;
  15.  
  16. USES Dos;
  17.  
  18. VAR
  19.   StartDir : PathStr;
  20.   Volume   : STRING [12];
  21.   SR       : SearchRec;
  22.   FName    : PathStr;
  23.   f        : TEXT;
  24.  
  25.   FUNCTION Spaces(L : INTEGER) : STRING;
  26.   VAR
  27.     i : INTEGER;
  28.     s : STRING;
  29.   BEGIN
  30.     s := '';  FOR i := 1 TO L DO s := s + ' ';  Spaces := s;
  31.   END;
  32.  
  33.   PROCEDURE Emit(Path : PathStr; SR : SearchRec);
  34.   VAR
  35.     DT             : DateTime;
  36.     Dir            : DirStr;
  37.     Name           : NameStr;
  38.     Ext            : ExtStr;
  39.     Date           : STRING [10];
  40.     Time           : STRING [ 8];
  41.     Attr           : STRING [ 4];
  42.     y              : STRING [ 4];
  43.     mo, d, h, m, s : STRING [ 2];
  44.   BEGIN
  45.     FSplit(Path, Dir, Name, Ext);
  46.     Dir  := Dir  + Spaces(67 - Length(Dir));
  47.     Name := Name + Spaces( 8 - Length(Name));
  48.     Ext  := Ext  + Spaces( 4 - Length(Ext));
  49.  
  50.     UnpackTime(SR.Time, DT);
  51.     Str(DT.Year, y);
  52.     Str(DT.Month, mo);
  53.     IF Length(mo) = 1 THEN mo := '0' + mo;
  54.     Str(DT.Day, d);
  55.     IF Length(d)  = 1 THEN  d := '0' +  d;
  56.     Str(DT.Hour, h);
  57.     IF Length(h)  = 1 THEN  h := '0' +  h;
  58.     Str(DT.Min, m);
  59.     IF Length(m)  = 1 THEN  m := '0' +  m;
  60.     Str(DT.Sec, s);
  61.     IF Length(s)  = 1 THEN  s := '0' +  s;
  62.     Date := d + '.' + mo + '.' + y;
  63.     Time := h + ':' + m  + ':' + s;
  64.  
  65.     Attr := '    ';  (* 4 Spaces *)
  66.     IF (SR.Attr AND ReadOnly) <> 0 THEN Attr[1] := 'R';
  67.     IF (SR.Attr AND Hidden)   <> 0 THEN Attr[2] := 'H';
  68.     IF (SR.Attr AND SysFile)  <> 0 THEN Attr[3] := 'S';
  69.     IF (SR.Attr AND Archive)  <> 0 THEN Attr[4] := 'A';
  70.  
  71.     WriteLn(f, Dir, Name, Ext, SR.Size:8, Date, Time, Attr,' ',Volume);
  72.   END;
  73.  
  74.   PROCEDURE GetDirs(Path : PathStr);
  75.   VAR
  76.     P    : PathStr;
  77.     Dir  : DirStr;
  78.     Name : NameStr;
  79.     Ext  : ExtStr;
  80.     SR   : SearchRec;
  81.   BEGIN
  82.     FindFirst(Path + '*.*', VolumeID, SR);
  83.     IF DosError = 0 THEN
  84.       Volume := SR.Name
  85.     ELSE
  86.       Volume := '';
  87.     FindFirst(Path + '*.*', AnyFile, SR);
  88.     WHILE DosError = 0 DO BEGIN
  89.       IF (SR.Attr AND Directory) <> 0 THEN BEGIN
  90.         IF SR.Name[1] <> '.' THEN BEGIN
  91.           P := Path + SR.Name;
  92.           GetDirs(P + '\');
  93.         END;
  94.       END ELSE Emit(Path + SR.Name, SR);
  95.       FindNext(SR);
  96.     END;
  97.   END;
  98.  
  99. BEGIN
  100.   IF ParamCount = 2 THEN BEGIN
  101.     StartDir := ParamStr(1);
  102.     FName    := ParamStr(2);
  103.   END ELSE
  104.     Halt(1);
  105.       (* Errorlevel = 1, wenn falsche Parameter *)
  106.  
  107.   FindFirst(StartDir + '\' + '*.*', AnyFile, SR);
  108.   IF DosError <> 0 THEN Halt(2);
  109.       (* Errorlevel = 2, wenn DOS Error         *)
  110.  
  111.   Assign(f, FName);
  112.   {$I-} Rewrite(f); {$I+}
  113.   IF IOResult <> 0 THEN Halt(2);
  114.       (* Errorlevel = 2, wenn DOS Error         *)
  115.  
  116.   GetDirs(StartDir + '\');
  117.  
  118.   Close(f);
  119. END.
  120. (* ------------------------------------------------------ *)
  121. (*               Ende von READDIR.PAS                     *)
  122.  
  123.