home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / dos / xrd.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1993-05-13  |  19.1 KB  |  506 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,M 65384,0,0}
  2. (*===================================================================*)
  3. (*                         XRD.PAS Version 3.00                      *)
  4. (*            Copyright (C) 1993 te-wi Verlag, München               *)
  5. (*          Compiler: Turbo/Borland Pascal Real-Mode-Target          *)
  6. (*===================================================================*)
  7. (*                                                                   *)
  8. (*Beschreibung:                                                      *)
  9. (*─────────────                                                      *)
  10. (* Das Programm löscht alle in einem Verzeichnis befindlichen        *)
  11. (* Dateien und Unterverzeichnisse; es scheitert nicht an schreib-    *)
  12. (* geschützten und versteckten Dateien. Optional wird das Startver-  *)
  13. (* zeichnis selbst ebenfalls gelöscht.                               *)
  14. (*                                                                   *)
  15. (* Ein Laufwerk kann vollständig gelöscht werden, bei Festplatten ab *)
  16. (* C: wird nochmals nachgefragt und wie bei FORMAT zur Sicherheit    *)
  17. (* das Volume-Label abgefragt, wenn vollständiges Löschen verlangt   *)
  18. (* wird. Bei vollständigem Löschen wird auch das Label entfernt.     *)
  19. (*                                                                   *)
  20. (* Es kann auch das aktuelle Verzeichnis mit gelöscht werden. Es     *)
  21. (* wird dann eine entsprechende Meldung ausgegeben.                  *)
  22. (*                                                                   *)
  23. (*Einschränkungen:                                                   *)
  24. (*- Das Programm läuft nur unter DOS-Versionen ab 3.00 und bricht    *)
  25. (*  bei älteren DOS-Versionen ab.                                    *)
  26. (*- 4DOS-'EXCEPT' ist auf XDEL nicht anwendbar!                      *)
  27. (*- Das Programm ist nur nach Compilierung im Real-Mode lauffähig!   *)
  28. (*-------------------------------------------------------------------*)
  29. PROGRAM eXtendendRmDir;
  30.  
  31. {$IFNDEF DMPI}
  32.  
  33. USES
  34.   Dos, DosUtil, Crt, ReadUnit, Cursor, Ansi, UPPER;
  35.  
  36. (*-------------------------------------------------------------------*)
  37. (*                        globale Deklarationen                      *)
  38. (*-------------------------------------------------------------------*)
  39.  
  40. CONST
  41.   AllFiles : STRING[3]  = '*.*';                    (* Suchkriterium *)
  42.   UBreak   : STRING[17] = '*** USERBREAK ***';
  43.   PathNFnd : STRING[20] = 'Pfad nicht gefunden!';
  44.   Copyrght : STRING[56] = 'eXtendend Remove-Directory '
  45.                       + 'v.3.00, (C) 1993 te-wi-Verlag';
  46.  
  47. VAR
  48.   result,                                                (* IOResult *)
  49.   FCount,                                             (* Dateizähler *)
  50.   VCount   : WORD;                              (* Verzeichniszähler *)
  51.   sr       : SearchRec;                            (* siehe Unit DOS *)
  52.   WorkDir  : ARRAY[0..15] OF STRING;
  53.                                             (* bis 15 Ebenen erlaubt *)
  54.   Depth,                                         (* Verzeichnistiefe *)
  55.   count    : BYTE;                                (* Schleifenzähler *)
  56.   check    : STRING[1];                           (* ReadLn-Variable *)
  57.   CON      : Text;                          (* Std-Ausgabe wegen CRT *)
  58.   Drive    : STRING;                             (* Laufwerkskennung *)
  59.   VolName  : STRING[12];                          (* Punkt beachten! *)
  60.   InStr    : STRING[11];                     (* Label für HD-Löschen *)
  61.   ActualDir: STRING;                       (*  Rücksprungverzeichnis *)
  62.   LeaveIt,                                  (* ja/nein für Start-DIR *)
  63.   LastFile,                                 (* zuletzt File oder DIR *)
  64.   BreakRO  : BOOLEAN;                       (* Break wenn R/H/S-Attr *)
  65.   TestCh   : INTEGER;                              (* für ReadString *)
  66.   AnsiInst : BOOLEAN;
  67.   Buffer   : ARRAY[0..$200] OF BYTE;  (* Puffer für Bootblock-Kontr. *)
  68.   BootBlock: tBootBlock ABSOLUTE Buffer;         (* Bootsektor-Daten *)
  69.  
  70. (*-------------------------------------------------------------------*)
  71. (*                   Funktionen und Prozeduren                       *)
  72. (*-------------------------------------------------------------------*)
  73.  
  74. PROCEDURE NewLine;          (* Zeilensprung an Standardausgabe geben *)
  75. BEGIN
  76.   WriteLn(CON, '');
  77. END;
  78.  
  79. (*-------------------------------------------------------------------*)
  80.  
  81. PROCEDURE Statistics;
  82. (* Am Programmende Informationen über gelöschte Dateien und          *)
  83. (* Verzeichnisse ausgeben                                            *)
  84. BEGIN
  85.   IF (FCount = 0) AND (VCount = 0) THEN
  86.     WriteLn(CON, 'Keine Dateien/Verzeichnisse gelöscht.')
  87.   ELSE
  88.   BEGIN
  89.     IF LastFile THEN NewLine;
  90.     IF VCount > 0 THEN Write (CON, VCount) ELSE Write(CON, 'Keine');
  91.     Write(CON, ' Verzeichnis');
  92.     IF VCount <> 1 THEN Write(CON, 'se');
  93.     WriteLn(CON, ' gelöscht');
  94.     IF FCount > 0 THEN Write(CON, FCount) ELSE Write(CON, 'Keine');
  95.     Write(CON, ' Datei');
  96.     IF FCount <> 1 THEN Write(CON, 'en');
  97.     WriteLn(CON, ' gelöscht');
  98.   END;
  99. END;
  100.  
  101. (*-------------------------------------------------------------------*)
  102.  
  103. PROCEDURE Home;
  104. (* Rücksprung zum Startverzeichnis wenn es noch vorhanden ist        *)
  105. BEGIN
  106.   ChDir(ActualDir);
  107.   IF IOResult <> 0 THEN
  108.   WriteLn(CON, 'Aktuelles Verzeichnis existiert nicht mehr!'^M^J);
  109. END;
  110.  
  111. (*-------------------------------------------------------------------*)
  112.  
  113. PROCEDURE Errorhalt(s: STRING);
  114. BEGIN
  115.   AnsiWhite;
  116.   IF s <> '' THEN WriteLn(CON, s);
  117.   AnsiGray;
  118.   Close(CON);
  119.   Halt(1);
  120. END;
  121.  
  122. (*-------------------------------------------------------------------*)
  123.  
  124. PROCEDURE UserBreakCheck;
  125. VAR
  126.   ch : CHAR;
  127. BEGIN
  128.   IF KeyPressed THEN
  129.   BEGIN
  130.     ch := ReadKey;
  131.     IF ch IN [^C, ^S, ' '] THEN
  132.     BEGIN
  133.       IF ch = ^C THEN
  134.       BEGIN
  135.         Home;
  136.         Statistics;
  137.         Errorhalt(^M^J + UBreak)
  138.       END
  139.       ELSE
  140.       BEGIN
  141.         AnsiYellow;
  142.         Write(CON, 'PAUSE --- Weiter mit beliebiger Taste ...');
  143.         AnsiGray;
  144.         REPEAT
  145.           ch := ReadKey;
  146.           IF ch = Chr(0) THEN IF KeyPressed THEN ch := ReadKey;
  147.         UNTIL ch <> '';
  148.         GotoXY(1, WhereY);
  149.         ClrEoL;
  150.       END;
  151.     END;
  152.   END;
  153. END;
  154.  
  155. (*-------------------------------------------------------------------*)
  156.  
  157. PROCEDURE Break;
  158. BEGIN
  159.   Errorhalt('XRD wird nicht ausgeführt.');
  160. END;
  161.  
  162. (*-------------------------------------------------------------------*)
  163.  
  164. PROCEDURE Request(s: STRING);
  165. VAR                        (* Ja/Nein-Abfrage, Umleitung ist möglich *)
  166.   kbd  : Text;
  167.   chk  : CHAR;
  168. BEGIN
  169.   Assign(kbd, '');
  170.   Reset(kbd);
  171.   REPEAT
  172.     Write(CON, s);
  173.     Read(kbd, chk);                             (* Grüße von Turbo-3 *)
  174.   UNTIL UpCase(chk) IN ['J', 'N'];
  175.   Close(kbd);
  176.   check := chk;
  177. END;
  178.  
  179. (*-------------------------------------------------------------------*)
  180.  
  181. PROCEDURE DeleteFiles;
  182. VAR
  183.   DelFile : FILE;
  184. BEGIN
  185.   FindFirst(AllFiles, Anyfile, sr);
  186.   WHILE DosError <> 18 DO
  187.   BEGIN
  188.     IF sr.Attr IN [$0..$7, $20..$27] THEN
  189.                                     (* alle Kombinationen für Files, *)
  190.                                     (* nicht: Directory, VolumeID    *)
  191.     BEGIN
  192.       IF BreakRO THEN IF NOT sr.Attr IN [0, Archive] THEN
  193.       BEGIN
  194.         Home;
  195.         WriteLn(CON, 'Nicht-löschbare Datei gefunden!');
  196.         LastFile := TRUE;
  197.         Statistics;
  198.         Errorhalt('');
  199.       END;
  200.       UserBreakCheck;
  201.       Assign(DelFile, sr.Name);
  202.       WriteLn(CON, 'Lösche Datei:', ' ': 8, FExpand(sr.Name));
  203.       SetFAttr(DelFile, Archive);
  204.       Erase(DelFile);
  205.       Inc(FCount);
  206.     END;
  207.     FindNext(sr);
  208.   END;
  209.   LastFile := TRUE;
  210. END;
  211.  
  212. (*-------------------------------------------------------------------*)
  213.  
  214. PROCEDURE ChangeDirectories;   (* Verzeichniswechsel solange es geht *)
  215. BEGIN
  216.   FindFirst(AllFiles, Directory, sr);          (* Verzeichnis suchen *)
  217.   WHILE DosError <> 18 DO
  218.   BEGIN
  219.     IF (sr.Name[1] <> '.') AND (sr.Attr AND $10 = $10) THEN
  220.     BEGIN                   (* Pseudoeinträge '.' und '..' übergehen *)
  221.       Inc(Depth);                                (* Dirtiefe erhöhen *)
  222.       WorkDir[Depth] := sr.Name;                 (* Namen zuordnen   *)
  223.       ChDir(sr.Name);                            (* DIR wechseln     *)
  224.       FindFirst(AllFiles, Directory, sr);        (* weitersuchen     *)
  225.     END;
  226.     FindNext(sr);           (* bis im tiefsten Verzeichnis angelangt *)
  227.   END;
  228. END;
  229.  
  230. (*-------------------------------------------------------------------*)
  231.  
  232. PROCEDURE RemoveDirectory;  (* Verzeichnisse löschen solange es geht *)
  233. BEGIN
  234.   IF (LeaveIt) AND (Depth = 1) THEN
  235.   BEGIN
  236.     Depth := 0;
  237.     IF FExpand(WorkDir[Depth]) <> Drive + '\' THEN ChDir(Drive + '..');
  238.     Exit
  239.   END;
  240.   UserBreakCheck;
  241.   ChDir(Drive + '..');                          (* eine Ebene zurück *)
  242.   WriteLn(CON, 'Lösche Verzeichnis:', '  ',
  243.           FExpand(WorkDir[Depth]),^M^J);
  244.   RmDir(WorkDir[Depth]);                      (* Verzeichnis löschen *)
  245.   Inc(VCount);                            (* Statistikzähler erhöhen *)
  246.   Dec(Depth);                                (* Dirtiefe erniedrigen *)
  247.   LastFile := FALSE;
  248. END;
  249.  
  250. (*-------------------------------------------------------------------*)
  251.  
  252. PROCEDURE TextOut;      (* Programmabhängiger Teil der Prozedur Help *)
  253. BEGIN
  254.   TextAttr := LightGray;                  (* 2. Fenster für Schrift: *)
  255.   Window(2, 2, 79, 24);
  256.   TextAttr := Yellow;
  257.   WriteLn(' ':12, Copyrght);
  258.   TextAttr := LightGray;
  259.   WriteLn(' ':6, 'Aufruf: XRD [d:][\]PFAD [/x] [/b],' +
  260.           ' Parameter in [] sind optional.'^M^J^J);
  261.   Write(' ':30);
  262.   TextAttr := 112;
  263.   WriteLn(' ':3, 'H I L F E', ' ':3, ^M^J);
  264.   TextAttr := LightGray;
  265.  
  266.   WriteLn(' Das Programm löscht in einem anzugebenden'
  267.        + ' Verzeichnis alle Unterverzeichnis-'^M^J' se und Dateien.'
  268.        + ^M^J' Wird der zusätzliche  Parameter /X angeben,'
  269.        + ' wird  das angegebene Verzeichnis'^M^J' ebenfalls gelöscht.');
  270.   WriteLn(' XRD  löscht auch schreibgeschützte und '
  271.         + ' versteckte Dateien.  Soll dies nicht'^M^J
  272.         + ' erfolgen, muß der Kommandozeilenparameter'
  273.         + ' /B angegeben werden. Ist /B  ange-'^M^J
  274.         + ' geben,  so wird beim ersten Antreffen'
  275.         + ' einer schreibgeschützten und/oder ver-');
  276.   WriteLn(' steckten Datei das Programm abgebrochen.'^M^J^J
  277.         + ' XRD ist in der Lage, eine Diskette oder'
  278.         + ' Platte  vollständig zu löschen. Wird'^M^J
  279.         + ' als Ziellaufwerk ein Laufwerk ab C: '
  280.         + ' angegeben und als Startverzeichnis  das');
  281.   WriteLn(' Hauptverzeichnis (\), so verlangt XRD  zur'
  282.         + ' Sicherheit die Eingabe der Daten-'^M^J
  283.         + ' trägerkennung (Volume-Label). Die Eingabe'
  284.         + ' kann frei  editiert werden, Klein-'^M^J
  285.         + ' schreibung (auch Umlaute) wird umgewandelt.');
  286. END;
  287.  
  288. (*-------------------------------------------------------------------*)
  289.  
  290. PROCEDURE Help;
  291.  
  292. VAR
  293.   OldX, OldY, CrtMode, count: BYTE;
  294.   ch                        : CHAR;
  295.   ScrType                   : BYTE;
  296.   ScrArray                  : ARRAY[0..3999] OF BYTE; (* BS-Speicher *)
  297.   ScrSeg, Attrib, Cursor    : WORD;
  298.  
  299.   PROCEDURE SaveScreen;
  300.  (* Bildschirminhalt in dem ARRAY ScrArray speichern, Cursorposition *)
  301.  (* in OldX/OldY und altes Text-Attribut in attrib merken.           *)
  302.  (* Da das Fenster aus dem DOS gestartet wird, wurde auf das Sichern *)
  303.  (* der alten Fensterkoordinaten (WindMin/WindMax) verzichtet.       *)
  304.   BEGIN
  305.     OldX := WhereX;
  306.     OldY := WhereY;
  307.     Attrib := TextAttr;
  308.     Move(Mem[ScrSeg:0], ScrArray, 4000);
  309.    END;
  310.  
  311. (*-------------------------------------------------------------------*)
  312.  
  313.   PROCEDURE RestoreScreen;
  314.  (* Bildschirminhalt aus dem ARRAY ScrArray restaurieren, Cursor auf *)
  315.  (* OldX/OldY setzen und urspr. Text-Attribut aus attrib holen.      *)
  316.   BEGIN
  317.     Move(ScrArray, Mem[ScrSeg:0], 4000);
  318.     TextAttr := Attrib;
  319.     GotoXY(OldX, OldY);
  320.   END;
  321.  
  322. (*-------------------------------------------------------------------*)
  323.  
  324.   PROCEDURE DrawLine;
  325.   VAR
  326.     count: BYTE;
  327.   BEGIN
  328.     FOR count := 2 TO 79 DO Write(Chr(205));
  329.   END;
  330.  
  331. (*-------------------------------------------------------------------*)
  332.  
  333. BEGIN                                                (* Vorarbeiten: *)
  334.   ScrType := BYTE(Ptr(Seg0040, $0049)^);             (* BS-Modus     *)
  335.   IF ScrType = 7 THEN ScrSeg := SegB000 ELSE ScrSeg := SegB800;
  336.   SaveScreen;
  337.   IF ScrType IN [0..1, 4..6, 8..$50] THEN TextMode(CO80);
  338.   Cursor := StartCursor;
  339.   HideCursor;                                  (* Cursor ausschalten *)
  340.   Window(1, 1, 80, 25);                        (*            Rahmen: *)
  341.   TextAttr := LightGray;
  342.   GotoXY(1, 1);
  343.   TextAttr := Red;
  344.   Write(Chr(201));
  345.   DrawLine;
  346.   Write(Chr(187));
  347.   FOR count := 2 TO 24 DO Write(Chr(186), ' ':78, Chr(186));
  348.   Write(Chr(200));
  349.   DrawLine;
  350.       (* Letztes Zeichen direkt schreiben um Scrolling zu vermeiden: *)
  351.   MemW[ScrSeg:$F9E] := Red * $100 + 188;  (* HiByte = Farbe,         *)
  352.                                           (* LoByte = Ord(Zeichen)   *)
  353.                                           (* Hilfebildschirm:        *)
  354.   TextOut;                                (* Text holen und ausgeben *)
  355.   GotoXY(22, 23);
  356.   TextAttr := Yellow;
  357.   Write('Zurück zum DOS mit beliebiger Taste');
  358.   REPEAT                         (* Auf Taste warten und Eingabe ver *)
  359.     ch := ReadKey;               (* schlucken. Bei 'KeyPressed' wird *)
  360.   UNTIL ch <> '';                (* das Zeichen nicht verschluckt!   *)
  361.   IF ch = #0 THEN ch := ReadKey;
  362.   Window(1, 1, 80, 25);                 (* Restaurierungen und Ende: *)
  363.   IF ScrType IN [0, 1] THEN TextMode(ScrType);
  364.                    (* nur 40-Zeichen-Modi, nicht Grafik restaurieren *)
  365.   RestoreScreen;
  366.   SetCursor(StartCursor);           (* Original-Cursor restaurieren: *)
  367.   Halt(0);                          (*            Programm abbrechen *)
  368. END;
  369.  
  370. (*-------------------------------------------------------------------*)
  371. {                           Hauptprogramm                             }
  372. (*-------------------------------------------------------------------*)
  373.  
  374. BEGIN
  375.   Assign(CON, '');                          (* Bildschirmausgabe auf *)
  376.   Append(CON);                             (* Standardausgabe setzen *)
  377.                  (* ANSI-Sequenzen nur mit Append, nicht mit Rewrite *)
  378.                                                 (* Voreinstellungen: *)
  379.   AnsiInst := AnsiSys;                                 (* ANSI-Check *)
  380.   BreakRO  := FALSE;                          (* kein Break wenn R/O *)
  381.   LastFile := TRUE;                             (* kein Zeilensprung *)
  382.   LeaveIt  := TRUE;                     (* Verzeichnis nicht löschen *)
  383.   FCount   := 0;                                  (* Dateizähler und *)
  384.   VCount   := 0;                              (* Verzeichniszähler 0 *)
  385.   VolName  := '';
  386.   IF Lo(DosVersion) < 3 THEN Errorhalt('Falsche DOS-Version');
  387.   IF (ParamCount < 1) OR (Pos('/?', ParamStr(1)) > 0) THEN Help;
  388.   AnsiYellow;
  389.   WriteLn(CON, 'XRD - Turbo ' + Copyrght);
  390.   AnsiGray;
  391.   IF (Length (ParamStr(1)) = 2) AND (Pos(':', ParamStr(1)) = 2) THEN
  392.     Errorhalt(^M^J'Kein Verzeichnis angegeben!');
  393.  
  394.   IF ParamCount > 1 THEN FOR count := 2 TO ParamCount DO
  395.   BEGIN
  396.     IF (Pos('/x', ParamStr(count)) > 0)
  397.     OR (Pos('/X', ParamStr(count)) > 0) THEN
  398.     LeaveIt := FALSE;
  399.     IF (Pos('/b', ParamStr(count)) > 0)
  400.     OR (Pos('/B', ParamStr(count)) > 0) THEN
  401.     BreakRO := TRUE;
  402.     IF Pos('/?', ParamStr(count)) > 0 THEN Help;
  403.   END;
  404.  
  405.   WriteLn(CON, ^M^J'Sämtliche Unterverzeichnisse und'^M^J
  406.                + 'Dateien  (auch schreibgeschützte'^M^J
  407.                + 'und versteckte) werden gelöscht!');
  408.   Request('Wirklich fortfahren (J/N)? ');
  409.   NewLine;
  410.   IF check[1] IN ['J', 'j'] THEN
  411.   BEGIN
  412.     Depth := 1;
  413.     WorkDir[1] := UpString(ParamStr(1));
  414.     (* Turbo Pascal verlangt in der Kommandozeile zwischen den Para- *)
  415.     (* metern Leerzeichen sonst wird alles an den ersten Parameter   *)
  416.     (* angehängt. Hier erfolgt die Korrektur                         *)
  417.     WHILE Pos('/', WorkDir[1]) > 0 DO
  418.     BEGIN
  419.       IF Pos('/X', UpString(WorkDir[1])) > 0 THEN LeaveIt := FALSE;
  420.       IF Pos('/B', UpString(WorkDir[1])) > 0 THEN BreakRO := TRUE;
  421.       WorkDir[1] := Copy(WorkDir[1], 1, Pos('/', WorkDir[1]) - 1);
  422.     END;
  423.  
  424.     IF WorkDir[1][1] = '\' THEN
  425.     BEGIN
  426.       GetDir(0, Drive);
  427.       WorkDir[1] := Drive[1] + ':' + WorkDir[1];
  428.       Drive := '';
  429.     END;
  430.     IF Pos (':', WorkDir[1]) = 2 THEN Drive := Copy(WorkDir[1], 1, 2)
  431.                                  ELSE Drive := '';
  432.     IF ((Length(WorkDir[1]) = 3)) AND (Pos(':\', WorkDir[1]) = 2) THEN
  433.     BEGIN
  434.       IF WorkDir[1][1] > 'B' THEN               (* Plattenlaufwerk ! *)
  435.       BEGIN
  436.         ReadBootSector(BYTE(WorkDir[1][1]) - 64, Buffer);
  437.         IF BootBlock.Data.MediaDescriptor = $F8 THEN BEGIN
  438.           Write(CON, ^G'Es werden alle Verzeichnisse und'^M^J
  439.               + 'Dateien der Platte ' + WorkDir[1][1], ': gelöscht. ');
  440.           Request('Sind Sie absolut sicher (J/N)? ');
  441.           IF UpCase(check[1]) = 'J' THEN
  442.           BEGIN
  443.             VolName := GetLabel(BYTE(WorkDir[1][1]) - 64);
  444.             IF VolName = '' THEN FindFirst(WorkDir[1] + AllFiles,
  445.                                          VolumeID + Archive, sr);
  446.             IF Length(VolName) > 0 THEN
  447.             BEGIN
  448.               IF Pos('.', VolName) > 0 THEN
  449.                 Delete(VolName, Pos('.', VolName), 1);
  450.               Write(CON, ^M^J'Datenträgerkennsatz von Platte '
  451.                     + WorkDir[1][1] + ': eingeben: ');
  452.               InStr := UpString(ReadString(12, TestCh));
  453.               IF TestCh = 27 THEN
  454.               BEGIN
  455.                 NewLine;
  456.                 Break;                                    (* Abbruch *)
  457.               END;
  458.               IF InStr <> VolName THEN
  459.                 Errorhalt(^M^J^J'Falscher Datenträgerkennsatz!');
  460.             END;
  461.           END ELSE Break;                                   (* Abbruch *)
  462.         END;
  463.       END;
  464.     END;
  465.   END ELSE Break;                                         (* Abbruch *)
  466.  
  467.   GetDir(0, ActualDir);
  468.   ChDir(WorkDir[1]);
  469.   IF IOResult <> 0 THEN
  470.   BEGIN
  471.     Home;
  472.     Errorhalt(PathNFnd);
  473.   END;
  474.   CheckBreak := FALSE;
  475.  
  476.   REPEAT                                            (* Hauptschleife *)
  477.     ChangeDirectories;
  478.     DeleteFiles;
  479.     IF (WorkDir[Depth] = Drive + '\') THEN
  480.     BEGIN
  481.       DeleteFiles;
  482.       Statistics;
  483.       IF GetLabel(BYTE(WorkDir[1][1]) - 64) <> '' THEN
  484.       BEGIN
  485.         WriteLn(CON, 'Datenträgerkennung gelöscht');
  486.         SetLabel(BYTE(WorkDir[1][1]) - 64, '');
  487.       END;
  488.       Home;
  489.       Errorhalt('');
  490.     END;
  491.     WHILE Pos('\', WorkDir[1]) > 0 DO
  492.       Delete(WorkDir[1], 1, Pos('\', WorkDir[1]));
  493.     RemoveDirectory;
  494.   UNTIL Depth = 0;                         (* Ende der Hauptschleife *)
  495.   Home;
  496.   Statistics;
  497.   Close(CON);
  498. {$ELSE}
  499. BEGIN
  500.   WriteLn('Das Programm wurde fälschlicherweise im Protected Mode ',
  501.           'compiliert!');
  502. {$ENDIF}
  503. END.
  504.  
  505. (*===================================================================*)
  506.