home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
1990
/
02
/
tricks
/
getdat.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-11-13
|
7KB
|
261 lines
(* ------------------------------------------------------ *)
(* GETDAT.PAS *)
(* Datei- und Directorywahl *)
(* (c) 1989 Stefan Wagener & TOOLBOX *)
(* ------------------------------------------------------ *)
PROGRAM GetDatei;
USES Crt, Dos;
VAR
Filename : STRING;
PROCEDURE Directory(VAR Filename : STRING;
suffix : STRING);
CONST
Spalten = 3; l_Rand = 5; r_Rand = 75;
Pen = 7;
TYPE
Zeiger = ^liste;
liste = RECORD
name : STRING[20];
attr : BYTE;
vor : Zeiger;
nach : Zeiger;
END;
VAR
dat : Zeiger;
datanf, datend : ARRAY [1..3] OF Zeiger;
Laufwerke, Pfad : STRING;
Abstand, Files,
Eintraege : BYTE;
fertig : BOOLEAN;
FUNCTION rpos(zeichen : char; kette : STRING) : BYTE;
VAR
i : BYTE;
BEGIN
rpos := 0;
FOR i:=1 TO Length(kette)-1 DO
IF kette[i] = zeichen THEN rpos := i;
END;
PROCEDURE Einfuegen(nr : BYTE; name : STRING;
attr : BYTE);
VAR
datei, mom : Zeiger;
BEGIN
New(datei);
datei^.name := name;
datei^.attr := attr;
IF datanf[nr] = NIL THEN BEGIN
datanf[nr] := datei;
datend[nr] := datei;
datei^.vor := NIL;
datei^.nach := NIL;
END ELSE BEGIN
mom := datanf[nr];
WHILE (mom^.name<datei^.name) AND
(mom <> datend[nr]) DO mom := mom^.nach;
IF mom^.name < datei^.name THEN BEGIN
{ Datei ist die Letzte der Liste }
datei^.vor := mom;
datei^.nach := NIL;
mom^.nach := datei;
datend[nr] := datei;
END ELSE BEGIN
datei^.vor := mom^.vor;
datei^.nach := mom;
IF mom = datanf[nr] THEN datanf[nr] := datei
ELSE mom^.vor^.nach := datei;
mom^.vor := datei;
END;
END;
END;
PROCEDURE Laufwerke_erkennen(VAR namen : STRING);
VAR
i : BYTE;
BEGIN
namen := 'AB';
{$I-}
FOR i := 67 TO 71 DO BEGIN
ChDir(Chr(i) + ':\');
IF IOResult = 0 THEN namen := namen + Chr(i);
END;
{$I+}
END;
PROCEDURE Verzeichnis_lesen(Pfad : STRING);
VAR
i : BYTE;
s : SearchRec;
BEGIN
FindFirst(Pfad + '*.*', $3F, s);
WHILE DosError = 0 DO BEGIN
IF (s.attr <> 16) AND (s.attr <> 18) AND
(s.name <> '.') AND (s.name <> '..') AND
((suffix='*') OR (Copy(s.name, rpos('.', s.name)+1,
Length(suffix)) = suffix)) THEN
Einfuegen(1, s.name, 1);
IF ((s.attr = 16) OR (s.attr = 18)) AND
(s.name <> '.') AND (s.name <> '..') THEN
Einfuegen(2, s.name, 2);
FindNext(s);
END;
IF Length(Pfad) > 3 THEN Einfuegen(3, '.. (Stamm)', 3);
FOR i := 1 TO Length(Laufwerke) DO
Einfuegen(3, Laufwerke[i] + ':\', 4);
END;
PROCEDURE Verzeichnis_ausgeben;
VAR
x, y : BYTE;
BEGIN
ClrScr;
GotoXY(l_Rand, 1); WriteLn('Verzeichnis: ', Pfad);
datanf[1] := NIL; datanf[2] := NIL; datanf[3] := NIL;
Verzeichnis_lesen(Pfad);
IF datanf[1] = NIL THEN
IF datanf[2] = NIL THEN datanf[1] := datanf[3]
ELSE BEGIN
datanf[1] := datanf[2];
datend[2]^.nach := datanf[3];
datanf[3]^.vor := datend[2];
END ELSE
IF datanf[2] = NIL THEN BEGIN
datend[1]^.nach := datanf[3];
datanf[3]^.vor := datend[1];
END ELSE BEGIN
datend[1]^.nach := datanf[2];
datanf[2]^.vor := datend[1];
datend[2]^.nach := datanf[3];
datanf[3]^.vor := datend[1];
END;
dat := datanf[1];
Eintraege := 0;
x := l_Rand; y := 3;
WHILE dat <> NIL DO BEGIN
GotoXY(x, y); Write(dat^.name);
IF dat^.attr = 1 THEN Files := Eintraege;
dat := dat^.nach;
Inc(Eintraege);
Inc(x, Abstand);
IF x > r_Rand-Abstand THEN BEGIN
x := l_Rand;
Inc(y);
END;
END;
END;
PROCEDURE Datei_auswaehlen;
VAR
i, wert : BYTE;
PROCEDURE schreibe;
VAR
zahl, v, x, y : BYTE;
BEGIN
zahl := 1;
dat := datanf[1];
WHILE i > zahl DO BEGIN
dat := dat^.nach;
Inc(zahl);
END;
v := ((zahl-1) MOD Spalten);
x := l_Rand + v * Abstand;
y := 3 + ((zahl-1) DIV Spalten);
GotoXY(x, y); Write(dat^.name);
END;
PROCEDURE revers;
BEGIN
TextBackground(Pen); TextColor(0);
schreibe;
TextBackground(0); TextColor(Pen);
END;
PROCEDURE cursor;
VAR
wert : BYTE;
BEGIN
wert := Ord(ReadKey);
schreibe;
CASE wert OF
72 : BEGIN
IF i-Spalten >= 1 THEN
Dec(i, Spalten)
ELSE
i := i + Spalten *
((Eintraege-i) DIV Spalten);
END;
75 : BEGIN
IF i > 1 THEN Dec(i, 1)
ELSE i := Eintraege;
END;
77 : BEGIN
IF i < Eintraege THEN Inc(i, 1)
ELSE i := 1;
END;
80 : BEGIN
IF i+Spalten <= Eintraege THEN
Inc(i, Spalten)
ELSE
i := i-Spalten * ((i-1) DIV Spalten);
END;
END;
revers;
END;
BEGIN
i := 1;
revers;
REPEAT
wert := Ord(ReadKey);
CASE wert OF
0 : cursor;
13 : BEGIN
IF dat^.attr = 1 THEN
fertig := true
ELSE
IF dat^.attr = 2 THEN
Pfad := Pfad + dat^.name + '\'
ELSE
IF dat^.attr = 3 THEN
Pfad := Copy(Pfad, 1, rpos('\', Pfad))
ELSE
Pfad := dat^.name;
END;
END;
UNTIL wert = 13;
END;
BEGIN
GetDir(0, Pfad);
Laufwerke_erkennen(Laufwerke);
ChDir(Pfad);
Abstand := (r_Rand-l_Rand) DIV Spalten;
fertig := FALSE;
REPEAT
Verzeichnis_ausgeben;
Datei_auswaehlen;
IF fertig THEN Filename := Pfad + dat^.name;
dat := datanf[1];
WHILE dat^.nach <> NIL DO BEGIN
dat := dat^.nach;
Dispose(dat^.vor);
END;
Dispose(dat);
UNTIL fertig;
ClrScr;
WriteLn(Filename);
END;
BEGIN
Directory(Filename, 'EXE');
ClrScr;
WriteLn(Filename);
END.
(* ------------------------------------------------------ *)
(* Ende von GETDAT.PAS *)