home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 02 / tricks / space.pas < prev    next >
Pascal/Delphi Source File  |  1989-11-14  |  5KB  |  187 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     SPACE.PAS                          *)
  3. (*       Zeigt Platz auf vorhandenen Laufwerken           *)
  4. (*        (c) 1989  Peter Stehlik & TOOLBOX               *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM DiskSpaceInfo;
  7.  
  8. {$N-}
  9.  
  10. USES Dos;
  11.  
  12. VAR
  13.   Drive       : INTEGER;
  14.   Lw, Cmd     : STRING;
  15.   Platz          : LongInt;
  16.   ScanDirF,
  17.   ScanSubDirF,
  18.   ShowFlag,
  19.   AllFlag     : BOOLEAN;
  20.   Pfad          : STRING;
  21.  
  22. PROCEDURE Info;
  23. BEGIN
  24.   WriteLn('Gebrauch: space [Pfadname] [/a] [/d] [/s] [/l]');
  25.   WriteLn;
  26.   WriteLn('Pfadname  Laufwerk mit oder ohne Verzeichnisse');
  27.   WriteLn('/a        zeigt alle Laufwerke');
  28.   WriteLn('/d        Grösse des aktuellen Verzeichnis');
  29.   WriteLn('/s        Grösse des aktuellen Verzeichnis mit');
  30.   WriteLn('          der Grösse der Unterverzeichnisse');
  31.   WriteLn('/l        zeigt die Verzeichnisse');
  32.   Halt;
  33. END;
  34.  
  35. PROCEDURE UP (VAR EingabeText : STRING);
  36.                       { Wandelt Wort in Grossbuchstaben um }
  37. VAR
  38.   Drive : INTEGER;
  39. BEGIN
  40.   Drive := 1;
  41.   FOR Drive := 1 TO Length(EingabeText) DO
  42.     EingabeText[Drive] := UpCase(EingabeText[Drive]);
  43. END;
  44.  
  45. FUNCTION Size(pfad : STRING) : LongInt;
  46.                           { Errechnet Grösse aller Dateien }
  47. VAR
  48.   i      : LongInt;           { im momentanen Verzeichnis }
  49.   DirInfo : SearchRec;
  50. BEGIN
  51.   I := 0;
  52.   FindFirst(Pfad, anyfile, DirInfo);
  53.   WHILE DosError = 0 DO BEGIN
  54.     i := i + Dirinfo.Size;
  55.     FindNext(DirInfo);
  56.   END;
  57.   Size := i;
  58. END;
  59.  
  60. PROCEDURE More(pfad : STRING; show : BOOLEAN);
  61. VAR
  62.   dir  : SearchRec;
  63.   temp : STRING;
  64.   d    : DirStr;
  65.   n    : NameStr;
  66.   e    : ExtStr;
  67. BEGIN
  68.   FindFirst(pfad, directory, Dir);
  69.   WHILE DosError = 0 DO BEGIN
  70.     IF (Dir.attr = directory) AND
  71.        (Dir.name[1] <> '.') THEN BEGIN
  72.       Fsplit(pfad, d, n, e);
  73.       temp := d + n + e;
  74.       pfad := d + dir.name + '\*.*';
  75.       IF show THEN WriteLn(d + dir.name);
  76.       platz := Size(pfad) + platz;
  77.       More(pfad, show);
  78.       pfad := temp;
  79.     END;
  80.     FindNext(dir);
  81.   END;
  82. END;
  83.  
  84. PROCEDURE Eingabe;
  85. VAR
  86.   anzahl : BYTE;
  87. BEGIN
  88.   ScanDirF    := FALSE;
  89.   ScanSubDirF := FALSE;
  90.   AllFlag     := FALSE;
  91.   Showflag    := FALSE;
  92.   Drive       := 0;
  93.   Lw          := ParamStr(1);
  94.   up(Lw);
  95.   IF (ParamStr(1) = '?') THEN Info;
  96.   IF Length(lw) = 0 THEN Drive := 0
  97.                     ELSE Drive := Ord(Lw[1]) - 64;
  98.   FOR anzahl := 1 TO ParamCount DO BEGIN
  99.     Cmd := ParamStr(anzahl);
  100.     Up(Cmd);
  101.     IF (Cmd[1] = '/') OR (Cmd[1] = '\') THEN BEGIN
  102.       CASE Cmd[2] OF
  103.     'A' : AllFlag     := TRUE;
  104.     'D' : ScanDirF    := TRUE;
  105.     'S' : ScanSubDirF := TRUE;
  106.     'L' : ShowFlag    := TRUE;
  107.       END;
  108.     END;
  109.   END;
  110. END;
  111.  
  112. PROCEDURE all;
  113. VAR
  114.   Drive : INTEGER;
  115. BEGIN
  116.   WriteLn;
  117.   FOR Drive := 1 TO 26 DO BEGIN
  118.     IF DiskSize(Drive) <> -1 THEN BEGIN
  119.       Write('Laufwerk ', Chr(64+Drive), ': Gesamt ',
  120.             DiskSize(Drive), ' bytes');
  121.       WriteLn(', davon frei: ', DiskFree(Drive) , ' bytes');
  122.     END;
  123.   END;
  124. END;
  125.  
  126. PROCEDURE PreparePath;
  127. BEGIN
  128.   IF pos('/', lw) = 0 THEN BEGIN
  129.     pfad := FExpand(lw);
  130.     IF pfad[Length(pfad)] <> '\' THEN
  131.       Insert('\', pfad, Length(pfad)+1);
  132.     pfad := pfad + '*.*';
  133.   END ELSE
  134.     pfad:='*.*';
  135. END;
  136.  
  137. PROCEDURE ScanDir;        { Durchsucht aktuellen Pfad }
  138. VAR
  139.   d : DirStr;
  140.   N : NameStr;
  141.   e : ExtStr;
  142. BEGIN
  143.   WriteLn;
  144.   PreparePath;
  145.   Write('       ', Size(pfad));
  146.   Fsplit(pfad, d, n, e);
  147.   WriteLn(' bytes im Verzeichnis ', Fexpand(d));
  148. END;
  149.  
  150. PROCEDURE ScanSubDir;      { Durchsucht alle weitere Pfade }
  151. VAR
  152.   d : DirStr;
  153.   N : NameStr;
  154.   e : ExtStr;
  155.   p : STRING;
  156. BEGIN
  157.   WriteLn;
  158.   PreparePath;
  159.   Platz := Size('*.*');
  160.   IF ShowFlag THEN WriteLn('Verzeichnisse:');
  161.   More(pfad, ShowFlag);
  162.   Write('       ', Platz);
  163.   Fsplit(pfad, d, n, e);
  164.   WriteLn(' bytes im gesamten Verzeichnis ', Fexpand(d));
  165. END;
  166.  
  167. BEGIN
  168.   Platz := 0;
  169.   Eingabe;
  170.   IF AllFlag THEN All
  171.   ELSE
  172.     IF ScanSubDirF THEN ScanSubDir
  173.     ELSE
  174.       IF ScanDirF THEN ScanDir
  175.       ELSE
  176.         IF DiskSize(Drive) <> -1 THEN BEGIN
  177.           WriteLn;
  178.           Write('Total ', DiskSize(Drive),
  179.                 ' bytes, davon sind ');
  180.           WriteLn(DiskFree(Drive),
  181.                 ' bytes auf der Platte frei verfügbar');
  182.         END ELSE
  183.           WriteLn('Laufwerk nicht ansprechbar!');
  184. END.
  185. (* ------------------------------------------------------ *)
  186. (*                 Ende von SPACE.PAS                     *)
  187.