home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 02 / tricks / getdat.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-14  |  6.8 KB  |  261 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      GETDAT.PAS                        *)
  3. (*               Datei- und Directorywahl                 *)
  4. (*          (c) 1989 Stefan Wagener & TOOLBOX             *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM GetDatei;
  7.  
  8. USES Crt, Dos;
  9.  
  10. VAR
  11.   Filename : STRING;
  12.  
  13.   PROCEDURE Directory(VAR Filename : STRING;
  14.                           suffix   : STRING);
  15.  
  16.   CONST
  17.     Spalten = 3; l_Rand = 5; r_Rand = 75;
  18.     Pen = 7;
  19.   TYPE
  20.     Zeiger = ^liste;
  21.     liste  = RECORD
  22.                name : STRING[20];
  23.                attr : BYTE;
  24.                vor  : Zeiger;
  25.                nach : Zeiger;
  26.              END;
  27.   VAR
  28.     dat             : Zeiger;
  29.     datanf, datend  : ARRAY [1..3] OF Zeiger;
  30.     Laufwerke, Pfad : STRING;
  31.     Abstand, Files,
  32.     Eintraege       : BYTE;
  33.     fertig          : BOOLEAN;
  34.  
  35.   FUNCTION rpos(zeichen : char; kette : STRING) : BYTE;
  36.   VAR
  37.     i : BYTE;
  38.   BEGIN
  39.     rpos := 0;
  40.     FOR i:=1 TO Length(kette)-1 DO
  41.       IF kette[i] = zeichen THEN rpos := i;
  42.   END;
  43.  
  44.   PROCEDURE Einfuegen(nr : BYTE; name : STRING;
  45.                                  attr : BYTE);
  46.   VAR
  47.     datei, mom : Zeiger;
  48.   BEGIN
  49.     New(datei);
  50.     datei^.name := name;
  51.     datei^.attr := attr;
  52.     IF datanf[nr] = NIL THEN BEGIN
  53.       datanf[nr]  := datei;
  54.       datend[nr]  := datei;
  55.       datei^.vor  := NIL;
  56.       datei^.nach := NIL;
  57.     END ELSE BEGIN
  58.       mom := datanf[nr];
  59.       WHILE (mom^.name<datei^.name) AND
  60.             (mom <> datend[nr]) DO mom := mom^.nach;
  61.       IF mom^.name < datei^.name THEN BEGIN
  62.                           { Datei ist die Letzte der Liste }
  63.         datei^.vor  := mom;
  64.         datei^.nach := NIL;
  65.         mom^.nach   := datei;
  66.         datend[nr]  := datei;
  67.       END ELSE BEGIN
  68.         datei^.vor  := mom^.vor;
  69.         datei^.nach := mom;
  70.         IF mom = datanf[nr] THEN datanf[nr] := datei
  71.                             ELSE mom^.vor^.nach := datei;
  72.         mom^.vor := datei;
  73.       END;
  74.     END;
  75.   END;
  76.  
  77.   PROCEDURE Laufwerke_erkennen(VAR namen : STRING);
  78.   VAR
  79.     i : BYTE;
  80.   BEGIN
  81.     namen := 'AB';
  82.     {$I-}
  83.     FOR i := 67 TO 71 DO BEGIN
  84.       ChDir(Chr(i) + ':\');
  85.       IF IOResult = 0 THEN namen := namen + Chr(i);
  86.     END;
  87.     {$I+}
  88.   END;
  89.  
  90.   PROCEDURE Verzeichnis_lesen(Pfad : STRING);
  91.   VAR
  92.     i : BYTE;
  93.     s : SearchRec;
  94.   BEGIN
  95.     FindFirst(Pfad + '*.*', $3F, s);
  96.     WHILE DosError = 0 DO BEGIN
  97.       IF (s.attr <> 16) AND (s.attr <> 18) AND
  98.          (s.name <> '.') AND (s.name <> '..') AND
  99.          ((suffix='*') OR (Copy(s.name, rpos('.', s.name)+1,
  100.                              Length(suffix)) = suffix)) THEN
  101.         Einfuegen(1, s.name, 1);
  102.       IF ((s.attr = 16) OR (s.attr = 18)) AND
  103.          (s.name <> '.') AND (s.name <> '..') THEN
  104.         Einfuegen(2, s.name, 2);
  105.       FindNext(s);
  106.     END;
  107.     IF Length(Pfad) > 3 THEN Einfuegen(3, '.. (Stamm)', 3);
  108.     FOR i := 1 TO Length(Laufwerke) DO
  109.       Einfuegen(3, Laufwerke[i] + ':\', 4);
  110.   END;
  111.  
  112.   PROCEDURE Verzeichnis_ausgeben;
  113.   VAR
  114.     x, y : BYTE;
  115.   BEGIN
  116.     ClrScr;
  117.     GotoXY(l_Rand, 1); WriteLn('Verzeichnis: ', Pfad);
  118.     datanf[1] := NIL;  datanf[2] := NIL;  datanf[3] := NIL;
  119.     Verzeichnis_lesen(Pfad);
  120.     IF datanf[1] = NIL THEN
  121.       IF datanf[2] = NIL THEN datanf[1] := datanf[3]
  122.       ELSE BEGIN
  123.         datanf[1] := datanf[2];
  124.         datend[2]^.nach := datanf[3];
  125.         datanf[3]^.vor  := datend[2];
  126.       END ELSE
  127.         IF datanf[2] = NIL THEN BEGIN
  128.           datend[1]^.nach := datanf[3];
  129.           datanf[3]^.vor  := datend[1];
  130.         END ELSE BEGIN
  131.           datend[1]^.nach := datanf[2];
  132.           datanf[2]^.vor  := datend[1];
  133.           datend[2]^.nach := datanf[3];
  134.           datanf[3]^.vor  := datend[1];
  135.         END;
  136.     dat := datanf[1];
  137.     Eintraege := 0;
  138.     x := l_Rand;  y := 3;
  139.     WHILE dat <> NIL DO BEGIN
  140.       GotoXY(x, y);  Write(dat^.name);
  141.       IF dat^.attr = 1 THEN Files := Eintraege;
  142.       dat := dat^.nach;
  143.       Inc(Eintraege);
  144.       Inc(x, Abstand);
  145.       IF x > r_Rand-Abstand THEN BEGIN
  146.         x := l_Rand;
  147.         Inc(y);
  148.       END;
  149.     END;
  150.   END;
  151.  
  152.   PROCEDURE Datei_auswaehlen;
  153.   VAR
  154.     i, wert : BYTE;
  155.  
  156.     PROCEDURE schreibe;
  157.     VAR
  158.       zahl, v, x, y : BYTE;
  159.     BEGIN
  160.       zahl := 1;
  161.       dat := datanf[1];
  162.       WHILE i > zahl DO BEGIN
  163.         dat := dat^.nach;
  164.         Inc(zahl);
  165.       END;
  166.       v := ((zahl-1) MOD Spalten);
  167.       x := l_Rand + v * Abstand;
  168.       y := 3 + ((zahl-1) DIV Spalten);
  169.       GotoXY(x, y);  Write(dat^.name);
  170.     END;
  171.  
  172.     PROCEDURE revers;
  173.     BEGIN
  174.       TextBackground(Pen);  TextColor(0);
  175.       schreibe;
  176.       TextBackground(0);  TextColor(Pen);
  177.     END;
  178.  
  179.     PROCEDURE cursor;
  180.     VAR
  181.       wert : BYTE;
  182.     BEGIN
  183.       wert := Ord(ReadKey);
  184.       schreibe;
  185.       CASE wert OF
  186.         72 : BEGIN
  187.                IF i-Spalten >= 1 THEN
  188.                  Dec(i, Spalten)
  189.                ELSE
  190.                  i := i + Spalten *
  191.                                 ((Eintraege-i) DIV Spalten);
  192.              END;
  193.         75 : BEGIN
  194.                IF i > 1 THEN Dec(i, 1)
  195.                         ELSE i := Eintraege;
  196.              END;
  197.         77 : BEGIN
  198.                IF i < Eintraege THEN Inc(i, 1)
  199.                                 ELSE i := 1;
  200.              END;
  201.         80 : BEGIN
  202.                IF i+Spalten <= Eintraege THEN
  203.                  Inc(i, Spalten)
  204.                ELSE
  205.                  i := i-Spalten * ((i-1) DIV Spalten);
  206.              END;
  207.       END;
  208.       revers;
  209.     END;
  210.  
  211.   BEGIN
  212.     i := 1;
  213.     revers;
  214.     REPEAT
  215.       wert := Ord(ReadKey);
  216.       CASE wert OF
  217.          0 : cursor;
  218.         13 : BEGIN
  219.                IF dat^.attr = 1 THEN
  220.                  fertig := true
  221.                ELSE
  222.                  IF dat^.attr = 2 THEN
  223.                    Pfad := Pfad + dat^.name + '\'
  224.                  ELSE
  225.                    IF dat^.attr = 3 THEN
  226.                      Pfad := Copy(Pfad, 1, rpos('\', Pfad))
  227.                    ELSE
  228.                      Pfad := dat^.name;
  229.              END;
  230.       END;
  231.     UNTIL wert = 13;
  232.   END;
  233.  
  234. BEGIN
  235.   GetDir(0, Pfad);
  236.   Laufwerke_erkennen(Laufwerke);
  237.   ChDir(Pfad);
  238.   Abstand := (r_Rand-l_Rand) DIV Spalten;
  239.   fertig := FALSE;
  240.   REPEAT
  241.     Verzeichnis_ausgeben;
  242.     Datei_auswaehlen;
  243.     IF fertig THEN Filename := Pfad + dat^.name;
  244.     dat := datanf[1];
  245.     WHILE dat^.nach <> NIL DO BEGIN
  246.       dat := dat^.nach;
  247.       Dispose(dat^.vor);
  248.     END;
  249.     Dispose(dat);
  250.   UNTIL fertig;
  251.   ClrScr;
  252.   WriteLn(Filename);
  253. END;
  254.  
  255. BEGIN
  256.   Directory(Filename, 'EXE');
  257.   ClrScr;
  258.   WriteLn(Filename);
  259. END.
  260. (* ------------------------------------------------------ *)
  261. (*                Ende von GETDAT.PAS                     *)