home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / extra18 / doppelt / doppelt.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-12-09  |  20.5 KB  |  855 lines
  1. (* ------------------------------------------------- *)
  2. (*                    DOPPELT.PAS                    *)
  3. (*       (C) 1991 Frank Verwohl & DMV-Verlag         *)
  4. (* Funktion: Ermittelt Dateien, die mehrfach auf dem *)
  5. (*           Laufwerk sind.                          *)
  6. (* Sprache:  Turbo Pascal 6.0                        *)
  7. (* ------------------------------------------------- *)
  8. {$A+,B-,D-,E-,F-,G-,I+,L-,N-,O-,R-,S-,V-,X-}
  9. {$M 16384,0,655360}
  10.  
  11. PROGRAM Doppelte_Files;
  12.  
  13. USES 
  14.   Crt, Dos;
  15.  
  16. TYPE 
  17.   tDatZeiger = ^tDat;
  18.   tDirZeiger = ^tDir;
  19.   tDopZeiger = ^tDop;
  20.   tDatei     = RECORD
  21.                  Pfad: PathStr;
  22.                  Name: STRING[12];
  23.                  Dops: tDopZeiger;
  24.                END;
  25.   tDat       = RECORD
  26.                  Pfad: tDirZeiger;
  27.                  sr:   SearchRec;
  28.                  Dats: tDatZeiger;
  29.                END;
  30.   tDir       = RECORD
  31.                  Pfad: PathStr;
  32.                  Dirs: tDirZeiger;
  33.                END;
  34.   tDop       = RECORD
  35.                  Pfad: PathStr;
  36.                  sr:   SearchRec;
  37.                  Dops: tDopZeiger;
  38.                END;
  39.  
  40. VAR 
  41.   i, Anzahl, 
  42.   DateiAnzahl:  INTEGER;
  43.   Pfad:         PathStr;
  44.   Filter:       STRING;
  45.   Dat:          ARRAY[1..300] OF tDatei;
  46.   DatKopf:      tDatZeiger;
  47.   DirKopf:      tDirZeiger;
  48.   BildAddr:     WORD;
  49.   Screen:       ARRAY[0..7999] OF BYTE;
  50.   MarkHeap:     POINTER;
  51.   Esc, Neu:     BOOLEAN;
  52.   DoppelMode:   BOOLEAN;
  53.   AktLW, MaxLW: BYTE;
  54.  
  55. CONST 
  56.   LeerZeile = '                                    ' +
  57.               '                                    ' +
  58.               '        ';          (* 80 Leerzeichen *)
  59.   LeerDat   = '                                    ' +
  60.               '                          '; (* 60 LZ *)
  61.               
  62. PROCEDURE Init;
  63. BEGIN
  64.   FOR i := 1 TO 300 DO 
  65.     WITH Dat[i] DO BEGIN 
  66.       Pfad := '';
  67.       Name := '';
  68.       Dops := NIL;
  69.     END;
  70. END;
  71.  
  72. PROCEDURE Cursor(Flag: BOOLEAN);
  73. VAR 
  74.   Regs: Registers;
  75. BEGIN
  76.   Regs.AH := 3; 
  77.   Intr($10, Regs);
  78.   IF Flag THEN Regs.CH := Regs.CH AND NOT 32
  79.           ELSE Regs.CH := Regs.CH OR 32;
  80.   Regs.AH := 1; 
  81.   Intr($10, Regs);
  82. END;
  83.  
  84. PROCEDURE LaufwerkBest;
  85. VAR 
  86.   Regs: Registers;
  87. BEGIN
  88.   WITH Regs DO BEGIN
  89.     AH    := $19;
  90.     Intr($21, Regs);
  91.     AktLW := AL;
  92.     AH    := $0E;
  93.     DL    := AktLW; 
  94.     Intr($21, Regs); 
  95.     MaxLW := AL;
  96.   END;
  97. END;
  98.  
  99. FUNCTION St(Zahl: INTEGER): STRING;
  100. VAR 
  101.   s: STRING; 
  102. BEGIN 
  103.   Str(Zahl, s); 
  104.   St := s; 
  105. END;
  106.  
  107. PROCEDURE WriteXY(x, y: BYTE; St: STRING);
  108. BEGIN 
  109.   GotoXY(x,y); 
  110.   Write(St); 
  111. END;
  112.  
  113. PROCEDURE Normal; 
  114. BEGIN 
  115.   TextColor(LightGray);
  116.   TextBackground(Black);
  117. END;
  118.  
  119. PROCEDURE Invers; 
  120. BEGIN 
  121.   TextColor(Black);
  122.   TextBackground(LightGray);
  123. END;
  124.  
  125. PROCEDURE Hell;   
  126. BEGIN 
  127.   TextColor(Yellow);
  128.   TextBackground(Blue);
  129. END;
  130.  
  131. PROCEDURE Fenster(x1, y1, x2, y2: BYTE; Titel: STRING);
  132. VAR 
  133.   i, j: BYTE;
  134. BEGIN
  135.   Normal;
  136.   WriteXY(x1, y1, '╔');
  137.   WriteXY(x2, y1, '╗');
  138.   WriteXY(x1, y2, '╚');
  139.   WriteXY(x2, y2, '╝');
  140.   FOR i := x1 + 1 TO x2 - 1 DO BEGIN
  141.     WriteXY(i, y1, '═');
  142.     WriteXY(i, y2, '═');
  143.   END;
  144.   FOR i := y1 + 1 TO y2 - 1 DO BEGIN
  145.     WriteXY(x1, i, '║');
  146.     WriteXY(x2, i, '║');
  147.   END;
  148.   FOR i := x1 + 1 TO x2 - 1 DO 
  149.     FOR j := y1 + 1 TO y2 - 1 DO WriteXY(i, j, ' ');
  150.   WriteXY(x1 + 2, y1, Titel);
  151.   GotoXY(x1 + 1, y1 + 1);
  152. END;
  153.  
  154. PROCEDURE SaveScreen;
  155. BEGIN 
  156.   FOR i := 0 TO 7999 DO
  157.     Screen[i] := Mem[BildAddr:i];
  158. END;
  159.  
  160. PROCEDURE RestoreScreen;
  161. BEGIN 
  162.   FOR i := 0 TO 7999 DO Mem[BildAddr:i] := Screen[i]; 
  163. END;
  164.  
  165. PROCEDURE LaufwerkFilterAusgeben;
  166. BEGIN
  167.   LaufwerkBest; 
  168.   Pfad := Chr(65 + AktLW) + ':\';
  169.   WriteXY(50, 25, '                   ');
  170.   WriteXY(50, 25, 'LW: ' + Chr(65 + AktLW) + ':\' 
  171.                   + Filter);
  172. END;
  173.  
  174. PROCEDURE Hauptbild;
  175. BEGIN
  176.   IF Mem[$40:$49] = 7 THEN
  177.     BildAddr := $B000  (* Bildschirmsegment bei Mono *)
  178.   ELSE
  179.     BildAddr := $B800;              (* ... bei Color *)
  180.   Cursor(FALSE);
  181.   Invers;
  182.   WriteXY(1, 1,  LeerZeile);
  183.   WriteXY(11, 1, 'DOPPELT Version 2.0');
  184.   Write(' - Copyright 1991 F. Verwohl & DMV-Verlag ');
  185.   Normal;
  186.   Fenster( 1, 2, 80,  4, ' Aktuelle Datei ');
  187.   Fenster( 1, 5, 16, 24, ' Datei... ');
  188.   Fenster(17, 5, 80, 24, ' ...steht in den ' + 
  189.                          'Verzeichnissen... ');
  190.   Hell;
  191.   WriteXY( 1,25, 'F1');
  192.   Normal;
  193.   Write(' Hilfe');
  194.   Hell;
  195.   WriteXY(10,25, 'F2');
  196.   Normal;
  197.   Write(' Neu');
  198.   Hell;
  199.   WriteXY(18,25, 'F3');
  200.   Normal;
  201.   Write(' Laufwerk');
  202.   Hell;
  203.   WriteXY(72,25, 'F10');
  204.   Normal;
  205.   Write(' Ende');
  206.   LaufwerkFilterAusgeben;
  207. END;
  208.  
  209. PROCEDURE Hilfe;
  210. BEGIN
  211.   SaveScreen;
  212.   Fenster(1,  2, 80,24, ' Hilfe ');
  213.   Hell;
  214.   WriteXY(19, 4, 'DOPPELT,  (C) 1991 F. Verwohl & ' + 
  215.                  'DMV-Verlag');
  216.   Normal;
  217.   WriteXY(5,  9, 'TAB -   Switch: '  + 
  218.           'Umschalten zwischen den Fenstern');
  219.   WriteXY(5, 12, 'F1  -    Hilfe: '  + 
  220.           'Diese Hilfefunktion');
  221.   WriteXY(5, 14, 'F2  -      Neu: '  + 
  222.           'Nach Eingabe eines Datei' + 
  223.           'filters (z.B. "*.*") werden alle');
  224.   WriteXY(5, 15, '                '  + 
  225.           'Dateien, die sich mehrfach' + 
  226.           ' auf dem Laufwerk befinden und');
  227.   WriteXY(5, 16, '                ' + 
  228.           'auf die der Filter "paßt", angezeigt.');
  229.   WriteXY(5, 18, 'F3  - Laufwerk: ' + 
  230.           'Aktuelles Laufwerk ändern');
  231.   WriteXY(5, 20, 'F4  -  Löschen: ' + 
  232.           'Aktuelle Datei löschen (nur im ' +
  233.           'Verzeichnisfenster !)');
  234.   WriteXY(5, 22, 'F10 -     Ende: ' + 
  235.            'Programm beenden');
  236.   REPEAT UNTIL KeyPressed;
  237.   RestoreScreen;
  238. END;
  239.  
  240. PROCEDURE LaufwerkEingeben;
  241. VAR 
  242.   Path: PathStr;
  243.   Lw:   BYTE;
  244.  
  245.   PROCEDURE LaufwerkAendern;
  246.   VAR 
  247.     Regs: Registers;
  248.   BEGIN 
  249.     Regs.AH := $0E; 
  250.     Regs.DL := Lw; 
  251.     Intr($21, Regs); 
  252.   END;
  253.  
  254. BEGIN (* LaufwerkEingeben *)
  255.   REPEAT
  256.     SaveScreen;
  257.     Fenster(28, 7, 53, 10, ' Laufwerk eingeben ');
  258.     LaufwerkBest;
  259.     WriteXY(30, 8, 'Aktuell: ' +
  260.       Chr(65 + AktLW) + ':\');
  261.     WriteXY(30, 9, '    Neu: ');
  262.     Cursor(TRUE);
  263.     ReadLn(Path);
  264.     Cursor(FALSE);
  265.     IF Path = '' THEN Lw := AktLW
  266.                  ELSE Lw := Ord(UpCase(Path[1])) - 65;
  267.     Path := Chr(Lw + 65) + ':\';
  268.     {$I-} 
  269.     ChDir(Path);
  270.     {$I+}
  271.     RestoreScreen;
  272.   UNTIL (IOResult = 0);
  273.   IF IOResult = 0 THEN LaufwerkAendern;
  274.   LaufwerkFilterAusgeben;
  275. END;
  276.  
  277. PROCEDURE FilterEingeben;
  278. VAR 
  279.   s: STRING;
  280. BEGIN
  281.   SaveScreen;
  282.   Fenster(28, 7, 53, 9, ' Dateifilter eingeben ');
  283.   Cursor(TRUE); 
  284.   ReadLn(s); 
  285.   Cursor(FALSE);
  286.   IF s <> '' THEN Filter := s;
  287.   RestoreScreen;
  288.   LaufwerkFilterAusgeben;
  289. END;
  290.  
  291. PROCEDURE BaumEinlesen;
  292. VAR 
  293.   Attr:   BYTE;
  294.   AltDir: tDirZeiger;
  295.   AltDat: tDatZeiger;
  296.  
  297.   PROCEDURE DatSuchen(AktDir: tDirZeiger);
  298.   VAR 
  299.     Datei: SearchRec;
  300.     Blatt: tDatZeiger;
  301.   BEGIN
  302.     FindFirst(AktDir^.Pfad + Filter, Attr, Datei);
  303.     WHILE DosError = 0 DO
  304.     BEGIN
  305.       IF (Datei.Attr AND VolumeID <> VolumeID) AND 
  306.          (Datei.Name[1] <> '.') AND (Datei.Attr AND 
  307.           Directory <> Directory) THEN BEGIN
  308.         New(Blatt);
  309.         AltDat^.Pfad := AktDir; 
  310.         AltDat^.Dats := Blatt;
  311.         AltDat^.sr   := Datei;
  312.         Blatt^.Dats  := NIL; 
  313.         AltDat       := Blatt;
  314.         Inc(DateiAnzahl);
  315.       END;
  316.       FindNext(Datei);
  317.     END;
  318.   END;
  319.  
  320.   PROCEDURE DirSuchen(Pfad: PathStr);
  321.   VAR 
  322.     Datei: SearchRec;
  323.     Blatt: tDirZeiger;
  324.   BEGIN
  325.     FindFirst(Pfad + '*.*', Attr, Datei);
  326.     WHILE DosError = 0 DO BEGIN
  327.       IF (Datei.Attr AND VolumeID <> VolumeID) AND 
  328.          (Datei.Name[1] <> '.') AND (Datei.Attr AND
  329.           Directory = Directory) THEN BEGIN
  330.         New(Blatt);
  331.         Blatt^.Pfad  := Pfad + Datei.Name + '\';
  332.         Blatt^.Dirs  := NIL;
  333.         AltDir^.Dirs := Blatt;
  334.         DatSuchen(Blatt);
  335.         AltDir       := Blatt;
  336.         DirSuchen(Pfad + Datei.Name + '\');
  337.       END;
  338.       FindNext(Datei);
  339.     END;
  340.   END;
  341.  
  342.   BEGIN (* BaumEinlesen *)
  343.   Release(MarkHeap);
  344.   SaveScreen;
  345.   Fenster(29, 10, 52, 12, '');
  346.   WriteXY(31, 11, 'Lese Baumstruktur...');
  347.   Attr := $FF;                (* Alle Dateien suchen *)
  348.   DateiAnzahl := 0; 
  349.   GetDir(0, Pfad); 
  350.   Pfad := Pfad[1] + ':\';
  351.   New(DirKopf); 
  352.   New(DatKopf);
  353.   DirKopf^.Pfad := Pfad; 
  354.   DirKopf^.Dirs := NIL;
  355.   DatKopf^.Pfad := NIL; 
  356.   DatKopf^.Dats := NIL;
  357.   AltDat        := DatKopf; 
  358.   AltDir        := DirKopf;
  359.   DatSuchen(DirKopf); 
  360.   DirSuchen(Pfad);
  361.   RestoreScreen;
  362. END;
  363.  
  364. FUNCTION SchonDa(Name: PathStr): BOOLEAN;
  365. VAR 
  366.   i: INTEGER;
  367. BEGIN
  368.   SchonDa := FALSE;
  369.   IF Anzahl > 0 THEN 
  370.     FOR i := 1 TO Anzahl DO 
  371.      IF Dat[i].Name = Name THEN SchonDa := TRUE;
  372. END;
  373.  
  374. FUNCTION Doppelt(Path, Name: PathStr; 
  375.                      Anzahl: INTEGER): BOOLEAN;
  376. VAR 
  377.   Akt:     tDatZeiger;
  378.   DopDir,
  379.   DirMerk: tDopZeiger;
  380. BEGIN
  381.   Doppelt := FALSE; 
  382.   Akt     := DatKopf; 
  383.   DirMerk := NIL;
  384.   WHILE (Akt <> NIL) AND (Akt^.Dats <> NIL) DO BEGIN
  385.     IF (Akt^.sr.Name = Name) AND 
  386.        (Akt^.Pfad^.Pfad <> Path) THEN BEGIN
  387.       Doppelt:=TRUE;
  388.       IF Dat[Anzahl].Dops = NIL THEN BEGIN
  389.         New(DopDir);
  390.         DopDir^.Pfad     := Dat[Anzahl].Pfad;
  391.         DopDir^.sr       := Akt^.sr;
  392.         Dat[Anzahl].Dops := DopDir;
  393.         DirMerk          := DopDir;
  394.         New(DopDir);
  395.         DopDir^.Pfad     := Akt^.Pfad^.Pfad;
  396.         DopDir^.sr       := Akt^.sr;
  397.         DopDir^.Dops     := NIL;
  398.         DirMerk^.Dops    := DopDir;
  399.       END ELSE BEGIN
  400.         New(DopDir);
  401.         DopDir^.Pfad  := Akt^.Pfad^.Pfad;
  402.         DopDir^.sr    := Akt^.sr;
  403.         DopDir^.Dops  := NIL;
  404.         DirMerk^.Dops := DopDir;
  405.       END;
  406.       DirMerk := DopDir;
  407.     END;
  408.     Akt := Akt^.Dats;
  409.   END;
  410. END;
  411.  
  412. PROCEDURE DateienSuchen;
  413. VAR 
  414.   Posi:    INTEGER;
  415.   Prozent: BYTE;
  416.  
  417.   PROCEDURE ProzentAnzeige;
  418.   VAR 
  419.     NeuProzent: BYTE;
  420.   BEGIN
  421.     NeuProzent := Round((Posi / DateiAnzahl) * 100);
  422.     IF (Prozent <> NeuProzent) AND
  423.        (NeuProzent > 0) THEN BEGIN
  424.       GotoXY(3, 12); 
  425.       FOR i := 1 TO Round(NeuProzent / 100 * 72) DO 
  426.         Write('█');
  427.     END;
  428.     GotoXY(75, 12); 
  429.     Write(NeuProzent: 3, '%');
  430.   END;
  431.  
  432.   PROCEDURE Suchen(Akt: tDatZeiger);
  433.   VAR 
  434.     i:    BYTE;
  435.     Pfad: PathStr;
  436.   BEGIN
  437.     WHILE (Akt <> NIL) AND (Akt^.Dats <> NIL) DO BEGIN
  438.       Pfad := Akt^.Pfad^.Pfad;
  439.       FOR i := 2 TO 79 DO WriteXY(i, 11, ' ');
  440.       WriteXY(2,11, Pfad + Akt^.sr.Name);
  441.       Inc(Posi);
  442.       ProzentAnzeige;
  443.       IF NOT(SchonDa(Akt^.sr.Name)) AND Doppelt(Pfad, 
  444.          Akt^.sr.Name, Anzahl + 1) THEN BEGIN
  445.         Inc(Anzahl);
  446.         Dat[Anzahl].Pfad       := Pfad;
  447.         Dat[Anzahl].Name       := Akt^.sr.Name;
  448.         Dat[Anzahl].Dops^.Pfad := Pfad;
  449.         Dat[Anzahl].Dops^.sr   := Akt^.sr;
  450.       END;
  451.       Akt := Akt^.Dats;
  452.     END;
  453.   END;
  454.  
  455. BEGIN (* DateienSuchen *)
  456.   SaveScreen;
  457.   Init;
  458.   Fenster(1, 10, 80, 13, ' Teste... ');
  459.   FOR i := 3 TO 73 DO WriteXY(i, 12, '▒');
  460.   Posi := 0;
  461.   Prozent := 100;
  462.   ProzentAnzeige;
  463.   Anzahl := 0;
  464.   Suchen(DatKopf);
  465.   RestoreScreen;
  466. END;
  467.  
  468. FUNCTION SRecToStr(sr: SearchRec): STRING;
  469. VAR 
  470.   s: STRING;
  471. BEGIN
  472.   Str(sr.Size:8, s); 
  473.   s := s + ' ';
  474.   IF (sr.Attr AND ReadOnly) = ReadOnly THEN 
  475.     s := s + 'R' 
  476.   ELSE 
  477.     s := s + '.';
  478.   IF (sr.Attr AND Hidden) = ReadOnly THEN 
  479.     s := s + 'H' 
  480.   ELSE s := s + '.';
  481.   IF (sr.Attr AND SysFile) = SysFile THEN
  482.     s := s + 'S' 
  483.   ELSE 
  484.     s := s + '.';
  485.   IF (sr.Attr AND Archive) = Archive THEN 
  486.     s := s + 'A' 
  487.   ELSE 
  488.     s := s + '.';
  489.   SRecToStr := s;
  490. END;
  491.  
  492. FUNCTION Kuerze(s: PathStr; Le: BYTE): STRING;
  493. BEGIN
  494.   IF Length(s) > Le THEN BEGIN
  495.     s[4] := '.';
  496.     s[5] := '.';
  497.     s[6] := '.';
  498.     WHILE Length(s) > Le DO Delete(s, 7, 1);
  499.   END;
  500.   Kuerze := s;
  501. END;
  502.  
  503. FUNCTION LeadZero(w: WORD): STRING;
  504. VAR 
  505.   s: STRING;
  506. BEGIN 
  507.   Str(w, s); 
  508.   IF w < 10 THEN s := '0' + s; 
  509.   LeadZero := s;
  510. END;
  511.  
  512. FUNCTION AnzahlBestimmen(Akt: tDopZeiger): INTEGER;
  513. VAR
  514.   i: INTEGER;
  515. BEGIN
  516.   i := 0;
  517.   WHILE (Akt <> NIL) DO BEGIN
  518.     Akt := Akt^.Dops;
  519.     Inc(i);
  520.   END;
  521.   AnzahlBestimmen := i;
  522. END;
  523.  
  524. PROCEDURE AktuellAnzeige(s: PathStr; sr: SearchRec);
  525. VAR
  526.   i:  BYTE;
  527.   dt: DateTime;
  528. BEGIN
  529.   Normal;
  530.   FOR i := 2 TO 79 DO WriteXY(i, 3, ' ');
  531.   Hell;
  532.   WriteXY(2, 3, Kuerze(s, 46));
  533.   Normal;
  534.   UnPackTime(sr.Time, dt);
  535.   GotoXY(49, 3);
  536.   WITH dt DO
  537.     Write(LeadZero(Day), '.', LeadZero(Month), '.',
  538.         Year, ' ', LeadZero(Hour), ':', LeadZero(Min));
  539.   WriteXY(66, 3, SRecToStr(sr));
  540. END;
  541.  
  542. PROCEDURE MehrfachAnzeige(s: PathStr;
  543.          DatNr, An, En, Inv: INTEGER);
  544. VAR
  545.   i, j,
  546.   x, y : BYTE;
  547.   Akt  : tDopZeiger;
  548. BEGIN
  549.   Akt := Dat[DatNr].Dops;
  550.   IF DoppelMode = FALSE THEN
  551.     AktuellAnzeige(s, Akt^.sr);
  552.   FOR y := 6 TO 23 DO WriteXY(18, y, LeerDat);
  553.   i := 6;
  554.   j := 1;
  555.   WHILE (Akt <> NIL) DO WITH Akt^ DO BEGIN
  556.     IF (j >= An) AND (j <= En) THEN BEGIN
  557.       IF j = Inv THEN IF DoppelMode = TRUE THEN BEGIN
  558.          AktuellAnzeige(Pfad + sr.Name, sr);
  559.          Invers;
  560.         END ELSE Hell
  561.       ELSE Normal;
  562.       WriteXY(18, i, ' ' + Kuerze(Pfad, 46));
  563.       FOR x := 1 TO 47 - Length(Kuerze(Pfad, 46)) DO
  564.         Write(' ');
  565.       GotoXY(66, i);
  566.       Write(SRecToStr(sr), ' ');
  567.       Normal;
  568.       Inc(i);
  569.     END;
  570.     Akt := Dops;
  571.     Inc(j);
  572.   END;
  573.   Hell;
  574.   GotoXY(19, 23);
  575.   Write('Anzahl: ', AnzahlBestimmen(Dat[DatNr].Dops));
  576.   Normal;
  577. END;
  578.  
  579. PROCEDURE Anzeigen(EinAn, EinEn, EinAkt,
  580.                    DopAn, DopEn, DopAkt: INTEGER);
  581. VAR
  582.   i, x, y: BYTE;
  583.   d      : DirStr;
  584.   n      : NameStr;
  585.   e      : ExtStr;
  586.   Anz    : INTEGER;
  587. BEGIN
  588.   i := EinAn;
  589.   y := 6;
  590.   WHILE i <= EinEn DO BEGIN
  591.     FSplit(Dat[i].Pfad + Dat[i].Name, d, n, e);
  592.     IF i = EinAkt THEN BEGIN
  593.       MehrfachAnzeige(d + n + e, i, DopAn,
  594.                       DopEn, DopAkt);
  595.       IF DoppelMode = TRUE THEN Hell ELSE Invers;
  596.     END ELSE Normal;
  597.     WriteXY(2, y, ' ');
  598.     Write(n);
  599.     IF Length(n) < 8 THEN
  600.       FOR x := 1 TO 8 - Length(n) DO Write(' ');
  601.     Write(e);
  602.     FOR x := 1 TO 5 - Length(e) DO Write(' ');
  603.     Inc(i);
  604.     Inc(y);
  605.   END;
  606. END;
  607.  
  608. PROCEDURE Era(VAR EinAkt, DopAkt,
  609.                   EinAnzahl, DopAnzahl: INTEGER);
  610. VAR
  611.   f        : FILE;
  612.   FPfad    : PathStr;
  613.   FName    : STRING[12];
  614.   Vor, Akt : tDopZeiger;
  615.   i        : INTEGER;
  616. BEGIN
  617.   Akt   := Dat[EinAkt].Dops;
  618.   Vor   := Akt;
  619.   i     := 0;
  620.   FName := '';
  621.   WHILE (Akt <> NIL) AND (i <> DopAkt) DO BEGIN
  622.     FPfad := Akt^.Pfad;
  623.     FName := Akt^.sr.Name;
  624.     IF i > 1 THEN Vor := Vor^.Dops;
  625.     Akt := Akt^.Dops;
  626.     Inc(i);
  627.   END;
  628.   IF FPfad + FName <> '' THEN BEGIN
  629.     Assign(f, FPfad + FName);
  630.     Erase(f);
  631.     IF DopAnzahl = 1 THEN BEGIN
  632.       IF EinAnzahl > 1 THEN
  633.         FOR i := EinAkt TO EinAnzahl - 1 DO
  634.           Dat[i] := Dat[i + 1];
  635.       Dec(EinAnzahl);
  636.     END ELSE IF DopAkt = 1 THEN BEGIN
  637.       Dat[EinAkt].Pfad := Akt^.Pfad;
  638.       Dat[EinAkt].Dops := Akt;
  639.     END ELSE BEGIN
  640.       Vor^.Dops := Akt;
  641.       Dec(DopAkt);
  642.     END;
  643.     Dec(DopAnzahl);
  644.   END;
  645. END;
  646.  
  647. PROCEDURE Loeschen(VAR EinAkt, DopAkt,
  648.                        EinAnzahl, DopAnzahl: INTEGER);
  649. VAR
  650.   ch:    CHAR;
  651.   t:     BYTE;
  652.   Loesch,
  653.   Ret,
  654.   Esc:   BOOLEAN;
  655. BEGIN
  656.   SaveScreen;
  657.   Fenster(1, 4, 51, 6, ' ' + Chr(24)
  658.        + ' Wollen Sie diese Datei wirklich löschen ? '
  659.        + Chr(24) + ' ');
  660.   Loesch := FALSE;
  661.   Ret    := FALSE;
  662.   Esc    := FALSE;
  663.   REPEAT
  664.     IF Loesch = TRUE THEN Invers
  665.                      ELSE Normal;
  666.     WriteXY(14, 5, '   Ok   ');
  667.     IF Loesch = TRUE THEN Normal
  668.                      ELSE Invers;
  669.     WriteXY(30, 5, ' Abbruch ');
  670.     Normal;
  671.     REPEAT UNTIL KeyPressed;
  672.     ch := ReadKey;
  673.     t  := Ord(ch);
  674.     IF t = 0 THEN BEGIN
  675.       REPEAT UNTIL KeyPressed;
  676.       ch := ReadKey;
  677.       t  := Ord(ch);
  678.       IF (t = 75) OR (t = 77) THEN
  679.         Loesch := NOT(Loesch);
  680.     END ELSE
  681.       CASE t OF
  682.         13         : Ret    := TRUE;
  683.         27         : Esc    := TRUE;
  684.         32, 52, 54 : Loesch := NOT(Loesch);
  685.       END;
  686.   UNTIL (Ret = TRUE) OR (Esc = TRUE);
  687.   IF (Ret = TRUE) AND (Loesch = TRUE) THEN
  688.      Era(EinAkt, DopAkt, EinAnzahl, DopAnzahl);
  689.   RestoreScreen;
  690. END;
  691.  
  692. PROCEDURE DateiFenster;
  693. VAR
  694.   t, y         : BYTE;
  695.   EinAnzahl,
  696.   DopAnzahl,
  697.   An, En, Akt,
  698.   EinAn, EinEn,
  699.   EinAkt, DopAn,
  700.   DopEn, DopAkt: INTEGER;
  701. BEGIN
  702.   DoppelMode := FALSE;
  703.   Esc        := FALSE;
  704.   Neu        := FALSE;
  705.   EinAn      := 1;
  706.   EinEn      := 17;
  707.   EinAkt     := 1;
  708.   EinAnzahl  := Anzahl;
  709.   DopAn      := 1;
  710.   DopEn      := 17;
  711.   DopAkt     := 1;
  712.   Anzahl     := EinAnzahl;
  713.   An         := EinAn;
  714.   En         := EinEn;
  715.   Akt        := EinAkt;
  716.   IF Anzahl < 17 THEN EinEn := Anzahl;
  717.   REPEAT
  718.     IF EinAnzahl = 0 THEN BEGIN
  719.       Hell;
  720.       WriteXY(3, 7, 'Keine');
  721.       WriteXY(4, 9, 'Datei');
  722.       WriteXY(5, 11, 'gefunden !');
  723.       Normal;
  724.     END ELSE BEGIN
  725.       Hell;
  726.       WriteXY(3, 23, 'Anzahl: ' + St(EinAnzahl));
  727.       Normal;
  728.     END;
  729.     IF Anzahl > 0 THEN BEGIN
  730.       IF DoppelMode = FALSE THEN DopEn := 17;
  731.       DopAnzahl := AnzahlBestimmen(Dat[EinAkt].Dops);
  732.       IF DopAnzahl < 17 THEN DopEn := DopAnzahl;
  733.       Anzeigen(EinAn, EinEn, EinAkt,
  734.                DopAn, DopEn, DopAkt);
  735.     END;
  736.     REPEAT UNTIL KeyPressed;
  737.     t := Ord(ReadKey);
  738.     IF t = 0 THEN BEGIN
  739.       t := Ord(ReadKey);
  740.       CASE t OF
  741.         71: Akt := 1;
  742.         79: Akt := Anzahl;
  743.         72: Dec(Akt);
  744.         80: Inc(Akt);
  745.         73: Akt := Akt - 17;
  746.         81: Akt := Akt + 17;
  747.         59: Hilfe;
  748.         60: Neu := TRUE;
  749.         61: LaufwerkEingeben;
  750.         62: IF (DoppelMode = TRUE) AND
  751.                (DopAnzahl > 0) THEN BEGIN
  752.               Loeschen(EinAkt, DopAkt,
  753.                        EinAnzahl, DopAnzahl);
  754.               IF DopAnzahl = 0 THEN BEGIN
  755.                 Normal;
  756.                 WriteXY(31, 25, '          ');
  757.                 FOR y:=6 TO 23 DO
  758.                   WriteXY(2, y, '              ');
  759.                 DopAn      := 1;
  760.                 DopEn      := 17;
  761.                 DopAkt     := 1;
  762.                 An         := EinAn;
  763.                 En         := EinEn;
  764.                 Akt        := EinAkt;
  765.                 Anzahl     := EinAnzahl;
  766.                 DoppelMode := NOT(DoppelMode);
  767.               END ELSE Akt := DopAkt;
  768.             END;
  769.         68: Esc:=TRUE;
  770.       END{CASE};
  771.     END ELSE
  772.       CASE t OF
  773.         55: Akt:=1;
  774.         49: Akt:=Anzahl;
  775.         56: Dec(Akt);
  776.         50: Inc(Akt);
  777.         57: Akt:=Akt-17;
  778.         51: Akt:=Akt+17;
  779.          9: IF Anzahl>0 THEN BEGIN
  780.               IF DoppelMode = TRUE THEN BEGIN
  781.                 Normal;
  782.                 WriteXY(31, 25, '          ');
  783.                 DopAn  := 1;
  784.                 DopEn  := 17;
  785.                 DopAkt := 1;
  786.                 An     := EinAn;
  787.                 En     := EinEn;
  788.                 Akt    := EinAkt;
  789.                 Anzahl := EinAnzahl;
  790.               END ELSE BEGIN
  791.                 Hell;
  792.                 WriteXY(31, 25, 'F4');
  793.                 Normal;
  794.                 Write(' Löschen');
  795.                 EinAn     := An;
  796.                 EinEn     := En;
  797.                 EinAkt    := Akt;
  798.                 An        := DopAn;
  799.                 En        := DopEn;
  800.                 Akt       := DopAkt;
  801.                 DopAnzahl := AnzahlBestimmen(
  802.                              Dat[EinAkt].Dops);
  803.                 IF DopAnzahl < 17 THEN
  804.                   DopEn:=DopAnzahl;
  805.                 Anzahl    := DopAnzahl;
  806.               END;
  807.               DoppelMode := NOT(DoppelMode);
  808.             END;
  809.       END{CASE};
  810.     IF Akt < 1 THEN Akt := 1;
  811.     IF Akt < An THEN An := Akt;
  812.     IF Akt > Anzahl THEN Akt := Anzahl;
  813.     IF Akt > En THEN An := Akt - 16;
  814.     En := An + 16;
  815.     IF En > Anzahl THEN En := Anzahl;
  816.     IF DoppelMode = TRUE THEN BEGIN
  817.       Anzahl := DopAnzahl;
  818.       DopAn  := An;
  819.       DopEn  := En;
  820.       DopAkt := Akt;
  821.     END ELSE BEGIN
  822.       Anzahl := EinAnzahl;
  823.       EinAn  := An;
  824.       EinEn  := En;
  825.       EinAkt := Akt;
  826.     END;
  827.   UNTIL (Esc = TRUE) OR (Neu = TRUE);
  828. END;
  829.  
  830. BEGIN
  831.   Mark(MarkHeap);
  832.   Filter := '*.*';
  833.   DateiAnzahl := 0;
  834.   Anzahl := 0;
  835.   Normal;
  836.   ClrScr;
  837.   Hauptbild;
  838.   LaufwerkEingeben;
  839.   REPEAT
  840.     FilterEingeben;
  841.     BaumEinlesen;
  842.     IF DateiAnzahl > 0 THEN DateienSuchen;
  843.     DateiFenster;
  844.     Hauptbild;
  845.   UNTIL Esc = TRUE;
  846.   Cursor(TRUE);
  847.   ClrScr;
  848.   WriteLn('Vielen Dank für den Einsatz von DOPPELT!');
  849.   WriteLn;
  850. END.
  851.  
  852. (* ------------------------------------------------- *)
  853. (*                Ende von DOPPELT.PAS               *)
  854.  
  855.