home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 01 / tricks / dirunit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-10-10  |  3.4 KB  |  117 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      DIRUNIT.PAS                       *)
  3. (*        (c) 1989 Achim Bergmeister  &  TOOLBOX          *)
  4. (* ------------------------------------------------------ *)
  5. UNIT DirUnit;
  6.  
  7. INTERFACE
  8.  
  9. USES Crt, Dos;
  10.  
  11. TYPE
  12.   s12    = STRING[12];
  13.   s30    = STRING[30];
  14.   zeilen = ARRAY [1..200] OF s30;
  15.  
  16.   PROCEDURE Dir(VAR zeile : zeilen; VAR zaehler : INTEGER;
  17.                 VAR summe : LONGINT; msk : s12);
  18.  
  19. IMPLEMENTATION
  20.  
  21.   PROCEDURE Dir(VAR zeile : zeilen; VAR zaehler : INTEGER;
  22.                 VAR summe : LONGINT; msk : s12);
  23.   VAR
  24.     srec : SearchRec;
  25.     nix  : BOOLEAN;
  26.     i    : INTEGER;
  27.     pfad : STRING[80];
  28.  
  29.     PROCEDURE QS(links, rechts : INTEGER; VAR dat : zeilen);
  30.     VAR
  31.       i, j : INTEGER;  x, y : s30;
  32.     BEGIN
  33.       i := links;  j := rechts;
  34.       x := dat[(links + rechts) DIV 2];
  35.       REPEAT
  36.         WHILE dat[i] < x DO Inc(i);
  37.         WHILE x < dat[j] DO Dec(j);
  38.         IF i <= j THEN BEGIN
  39.           y := dat[i];  dat[i] := dat[j];
  40.           dat[j] := y;  Inc(i);  Dec(j);
  41.        END;
  42.      UNTIL i > j;
  43.      IF links < j THEN qs(links, j, dat);
  44.      IF links < rechts THEN qs(i, rechts, dat);
  45.    END;
  46.  
  47.    PROCEDURE Einlesen(eintrag : SearchRec; x : INTEGER);
  48.    VAR
  49.      dt         : DateTime;
  50.      d1, d2, d3 : STRING[2];
  51.      ppos, i    : INTEGER;
  52.      suffix     : STRING[3];
  53.      dummy      : STRING[7];
  54.    BEGIN
  55.      WITH eintrag DO BEGIN
  56.        ppos := Pos('.', name);
  57.        IF ppos <> 0 THEN BEGIN
  58.          suffix := copy(name, ppos+1, Length(name) - ppos);
  59.          Delete(name, ppos, 1+Length(name)-ppos);
  60.        END ELSE suffix := '';
  61.        zeile[x] := name;
  62.        FOR i := Length(name) TO 7 DO
  63.          zeile[x] := zeile[x] + ' ';
  64.        zeile[x] := zeile[x] + '.' + suffix;
  65.        FOR i := Length(suffix) TO 3 DO
  66.          zeile[x] := zeile[x] + ' ';
  67.        IF (attr AND directory) <> 0 THEN
  68.          zeile[x] := ' ' + zeile[x] + '  <DIR>           '
  69.        ELSE BEGIN
  70.          summe := summe + size;
  71.          str(size, dummy);
  72.          WHILE Length(dummy) < 7 DO dummy := ' ' + dummy;
  73.          zeile[x] := zeile[x] + dummy;
  74.          UnpackTime(time, dt);
  75.          WITH dt DO BEGIN
  76.            Str(day, d1);
  77.            IF Length(d1) < 2 THEN d1 := '0' + d1;
  78.            Str(month, d2);
  79.            IF Length(d2) < 2 THEN d2 := '0' + d2;
  80.            Str(year MOD 100, d3);
  81.          END;
  82.          zeile[x] := zeile[x] + '  ' + d1 + '.' + d2 +
  83.                                             '.' + d3;
  84.        END;
  85.      END;
  86.    END;
  87.  
  88. BEGIN { Dir }
  89.   nix := TRUE;  zaehler := 1;  summe := 0;
  90.   FOR i := 1 TO 200 DO zeile[i] := '';
  91.   FindFirst(msk, $31, srec);
  92.   WHILE DosError = 0 DO BEGIN
  93.     einlesen(srec, zaehler);
  94.     FindNext(srec);
  95.     nix := FALSE;
  96.     Inc(zaehler);
  97.   END;
  98.   IF nix THEN zeile[1] := 'Leeres Verzeichnis';
  99.   qs(1, zaehler, zeile);
  100.   IF msk = '*.*' THEN BEGIN
  101.     GetDir(0, pfad);
  102.     IF Length(pfad) = 3 THEN BEGIN
  103.       FOR i := 2 TO zaehler DO zeile[i-1] := zeile[i];
  104.       Dec(zaehler, 1);
  105.     END ELSE BEGIN
  106.       FOR i := 3 TO zaehler DO zeile[i-2] := zeile[i];
  107.       Dec(zaehler, 2);
  108.     END;
  109.   END;
  110.   FOR i := 1 TO zaehler DO
  111.     IF Copy(zeile[i], 1, 1) = ' ' THEN
  112.       zeile[i] := Copy(zeile[i],2,Length(zeile[i])-1)+' ';
  113. END;
  114.  
  115. END.
  116. (* ------------------------------------------------------ *)
  117. (*                Ende von DIRUNIT.PAS                    *)