home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tp_util / dirboxg.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-04-16  |  12.2 KB  |  450 lines
  1.  
  2. UNIT  DIRBOXG;
  3.  
  4. INTERFACE
  5.  
  6. {
  7.   FILE- SELECTOR- BOX AEHNLICH DER IM TURBO- PASCAL 4 EDITOR
  8.  
  9.   AUS C'T 12/88
  10.   DENNIS HERZBERG
  11. }
  12.  
  13. USES  TPCRT,DOS,GRAPH,GRAPHWIN,TPDOS;
  14.  
  15. CONST NOATTR     = $FF;
  16.       WWID       = 3;   { BREITE DES FENSTERS }
  17.       WHIG       = 8;   { HÖHE DES FENSTERS }
  18.  
  19.       NONSEL     = $07; { TEXTATTRIBUT NICHT SELEKTIERT }
  20.       SELECT     = $09; { TEXTATTRIBUT SELEKTIERT }
  21.       WILLNICHT  : ARRAY[1..5] OF STRING[12] = ('','','','','');
  22.  
  23. TYPE  STR6       = STRING[6];
  24.       STR12      = STRING[12];
  25.       STR80      = STRING[80];
  26.       DIRPTR     = ^DIRREC;
  27.       DIRREC     = RECORD
  28.         NAME       : STR12;
  29.         ATTR       : BYTE;
  30.         TIME,SIZE  : LONGINT;
  31.         NEXT       : DIRPTR;
  32.       END;
  33.  
  34.  
  35. FUNCTION  STRTOATTR(ST:STR6):BYTE;
  36. FUNCTION  ATTRTOSTR(ATTR:BYTE):STR6;
  37. PROCEDURE READDIR(PATH:STRING;JA,NEIN:BYTE;VAR FEHLER:BYTE;
  38.                   VAR ANZAHL:WORD;VAR START:DIRPTR);
  39. PROCEDURE FREEDIR(VAR DP:DIRPTR);
  40. FUNCTION  SELECTDIRREC(TITEL:STR80;START:DIRPTR;MAXANZ:WORD):DIRPTR;
  41. FUNCTION  SELECTFILE(PTH,NAME:STRING):STRING;
  42.  
  43.  
  44. IMPLEMENTATION
  45.  
  46.  
  47. VAR   REGS     : REGISTERS;
  48.  
  49.  
  50. FUNCTION UPSTR(ST : STRING):STRING;
  51. VAR   I : BYTE;
  52. BEGIN { UPSTR }
  53.   FOR I := 1 TO LENGTH(ST) DO ST[I] := UPCASE(ST[I]);
  54.   UPSTR := ST;
  55. END; { UPSTR }
  56.  
  57.  
  58. FUNCTION  STRTOATTR(ST:STR6):BYTE;
  59. VAR   B  : BYTE;
  60. BEGIN { STRTOATTR }
  61.   B := 0;
  62.   ST := UPSTR(ST);
  63.   IF POS('R',ST) > 0 THEN B := B + READONLY;
  64.   IF POS('H',ST) > 0 THEN B := B + HIDDEN;
  65.   IF POS('A',ST) > 0 THEN B := B + ARCHIVE;
  66.   IF POS('S',ST) > 0 THEN B := B + SYSFILE;
  67.   IF POS('D',ST) > 0 THEN B := B + DIRECTORY;
  68.   IF POS('V',ST) > 0 THEN B := B + VOLUMEID;
  69.   IF B = 0 THEN B := NOATTR;
  70.   STRTOATTR := B;
  71. END; { STRTOATTR }
  72.  
  73.  
  74. FUNCTION  ATTRTOSTR(ATTR:BYTE):STR6;
  75. VAR   ST  : STR6;
  76. BEGIN { ATTRTOSTR }
  77.   IF (ATTR AND READONLY ) = 0 THEN ST := '-' ELSE ST := 'R';
  78.   IF (ATTR AND HIDDEN   ) = 0 THEN ST := ST + '-' ELSE ST := ST + 'H';
  79.   IF (ATTR AND ARCHIVE  ) = 0 THEN ST := ST + '-' ELSE ST := ST + 'A';
  80.   IF (ATTR AND SYSFILE  ) = 0 THEN ST := ST + '-' ELSE ST := ST + 'S';
  81.   IF (ATTR AND DIRECTORY) = 0 THEN ST := ST + '-' ELSE ST := ST + 'D';
  82.   IF (ATTR AND VOLUMEID ) = 0 THEN ST := ST + '-' ELSE ST := ST + 'V';
  83.   ATTRTOSTR := ST;
  84. END; { ATTRTOSTR }
  85.  
  86.  
  87. FUNCTION EXPAND(NAME : STR12):STR12;
  88. VAR   A,B  : BYTE;
  89.       S    : STR12;
  90. BEGIN { EXPAND }
  91.   A := POS('.',NAME);
  92.   IF A > 1 THEN BEGIN
  93.     S := '';
  94.     FOR B := A TO 8 DO S := S + ' ';
  95.     INSERT(S,NAME,A);
  96.   END;
  97.   EXPAND := NAME;
  98. END; { EXPAND }
  99.  
  100.  
  101. PROCEDURE READDIR(PATH:STRING;JA,NEIN:BYTE;VAR FEHLER:BYTE;
  102.                   VAR ANZAHL:WORD;VAR START:DIRPTR);
  103. VAR   EINTRAG  : SEARCHREC;
  104.       NEU      : DIRPTR;
  105.       I        : WORD;
  106.  
  107. PROCEDURE INSERTLIST(VAR ALT,NEU:DIRPTR);
  108. VAR   P  : POINTER;
  109. BEGIN
  110.   IF ALT = NIL THEN ALT := NEU
  111.   ELSE BEGIN
  112.     IF ALT^.NAME > NEU^.NAME THEN BEGIN
  113.       P := ALT; ALT := NEU; NEU^.NEXT := P;
  114.     END ELSE
  115.       IF ALT^.NEXT = NIL THEN ALT^.NEXT := NEU
  116.                          ELSE INSERTLIST(ALT^.NEXT,NEU);
  117.   END;
  118. END; { INSERTLIST }
  119.  
  120. FUNCTION TEST(VAR EINTRAG:SEARCHREC):BOOLEAN;
  121. VAR   I  : BYTE;
  122. BEGIN
  123.   TEST := FALSE;
  124.   WITH EINTRAG DO BEGIN
  125.     FOR I := 1 TO 10 DO BEGIN
  126.       IF (WILLNICHT[I] <> '') AND
  127.          (POS(WILLNICHT[I],NAME) <> 0) THEN EXIT;
  128.     END;
  129.     TEST := (((ATTR AND JA) = JA) OR (JA = NOATTR)) AND
  130.             (((ATTR AND NEIN) = 0) OR (NEIN = NOATTR)) AND
  131.             (NAME <> '.');
  132.   END; { WITH EINTRAG }
  133. END; { TEST }
  134.  
  135. PROCEDURE SPEICHERN;
  136. BEGIN
  137.   IF (EINTRAG.ATTR = DIRECTORY) AND (EINTRAG.NAME[1] <> ' ') THEN BEGIN
  138.     IF LENGTH(EINTRAG.NAME) = 12 THEN DELETE(EINTRAG.NAME,9,1);
  139.     IF EINTRAG.NAME = '..' THEN INSERT(' ',EINTRAG.NAME,1)
  140.                            ELSE INSERT('\',EINTRAG.NAME,1);
  141.   END;
  142.   INC(ANZAHL);
  143.   NEW(NEU);
  144.   WITH NEU^ DO BEGIN
  145.     NAME := EINTRAG.NAME; ATTR := EINTRAG.ATTR;
  146.     TIME := EINTRAG.TIME; SIZE := EINTRAG.SIZE;
  147.     NEXT := NIL;
  148.   END; { WITH }
  149.   INSERTLIST(START,NEU);
  150. END; { SPEICHERN }
  151.  
  152. BEGIN { READDIR }
  153.   ANZAHL := 0;
  154.   I := LENGTH(PATH);
  155.   WHILE (I > 1) AND (PATH[I] <> '\') DO DEC(I);
  156.  
  157.   FINDFIRST(COPY(PATH,1,I)+'*.*',DIRECTORY,EINTRAG);
  158.   FEHLER := DOSERROR;
  159.   WHILE FEHLER = 0 DO BEGIN
  160.     IF (FEHLER = 0) AND
  161.        (EINTRAG.ATTR = DIRECTORY) AND
  162.        (EINTRAG.NAME <> '.') THEN SPEICHERN;
  163.     FINDNEXT(EINTRAG);
  164.     FEHLER := DOSERROR;
  165.   END; { WHILE }
  166.  
  167.   EINTRAG.ATTR := DIRECTORY;
  168.   IF I <= 3 THEN BEGIN
  169.     EINTRAG.NAME := ' A:';
  170.     FOR I := 1 TO NUMBEROFDRIVES DO BEGIN
  171.       EINTRAG.NAME[2] := CHR(I+$40);
  172.       SPEICHERN;
  173.     END; { NEXT I }
  174.   END;
  175.  
  176.   FINDFIRST(PATH,ANYFILE,EINTRAG);
  177.   FEHLER := DOSERROR;
  178.   WHILE FEHLER = 0 DO BEGIN
  179.     IF (FEHLER = 0) AND TEST(EINTRAG) THEN SPEICHERN;
  180.     FINDNEXT(EINTRAG);
  181.     FEHLER := DOSERROR;
  182.   END; { WHILE }
  183. END; { READDIR }
  184.  
  185.  
  186. PROCEDURE FREEDIR(VAR DP:DIRPTR);
  187. BEGIN { FREEDIR }
  188.   IF DP <> NIL THEN BEGIN
  189.     FREEDIR(DP^.NEXT);
  190.     DISPOSE(DP);
  191.   END;
  192. END; { FREEDIR }
  193.  
  194.  
  195. PROCEDURE CLS;
  196. VAR   TA  : BYTE;
  197. BEGIN
  198.   TA := TEXTATTR;
  199.   TEXTCOLOR(TA SHR 4);
  200.   CLRSCR;
  201.   TEXTATTR := TA;
  202. END;
  203.  
  204.  
  205. FUNCTION  SELECTDIRREC(TITEL:STR80;START:DIRPTR;MAXANZ:WORD):DIRPTR;
  206. VAR   ZEILE,SPALTE,XPOS,YPOS,
  207.       TAALT,AUSSCHN,MAXAUSSCHN  : BYTE;
  208.       WO,WU,I                   : WORD;
  209.       ANZAHL                    : INTEGER;
  210.       ENDE                      : BOOLEAN;
  211.       CH1,CH2                   : CHAR;
  212.       ST                        : STRING[14];
  213.       P                         : DIRPTR;
  214.       POINTERLIST               : ARRAY[0..WWID,1..WHIG] OF DIRPTR;
  215.  
  216. PROCEDURE BILDAUFBAU;
  217. VAR   I,S,Z   : WORD;
  218.       TEST    : BOOLEAN;
  219. BEGIN
  220.   FOR S := 0 TO WWID DO
  221.     FOR Z := 1 TO WHIG DO
  222.       POINTERLIST[S,Z] := NIL;
  223.   TEXTATTR := NONSEL;
  224.   P := START; S := 0; Z := 1;
  225.   CLS;
  226.  
  227.   FOR I := 1 TO AUSSCHN * SUCC(WWID) DO P := P^.NEXT;
  228.   REPEAT
  229.     GOTOXY(3+S*16,Z);
  230.     POINTERLIST[S,Z] := P;
  231.     IF (P^.ATTR AND DIRECTORY) = DIRECTORY
  232.       THEN WRITE(P^.NAME,'\')
  233.       ELSE WRITE(EXPAND(P^.NAME));
  234.     TEST := (P^.NEXT = NIL) OR ((Z = WHIG) AND (S = WWID));
  235.     IF NOT TEST THEN BEGIN
  236.       P := P^.NEXT;
  237.       INC(S);
  238.       IF S = SUCC(WWID) THEN BEGIN
  239.         S := 0;
  240.         INC(Z);
  241.       END;
  242.     END;
  243.   UNTIL TEST;
  244. END; { BILDAUFBAU }
  245.  
  246. PROCEDURE AUFWAERTS;
  247. BEGIN
  248.   IF ZEILE > 1 THEN DEC(ZEILE)
  249.   ELSE IF AUSSCHN > 0 THEN BEGIN
  250.       DEC(AUSSCHN);
  251.       BILDAUFBAU;
  252.     END;
  253. END;
  254.  
  255. PROCEDURE ABWAERTS;
  256. BEGIN
  257.   IF ZEILE < WHIG THEN BEGIN
  258.     IF (ZEILE*SUCC(WWID)+SUCC(SPALTE)) <= MAXANZ THEN INC(ZEILE);
  259.   END ELSE IF AUSSCHN < MAXAUSSCHN THEN BEGIN
  260.     INC(AUSSCHN);
  261.     BILDAUFBAU;
  262.   END;
  263.   WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(SPALTE);
  264. END;
  265.  
  266. BEGIN { SELECTDIRREC }
  267.   SELECTDIRREC := NIL;
  268.   IF START = NIL THEN EXIT;
  269.   TAALT := TEXTATTR; TEXTATTR := NONSEL;
  270.   WO := WINDMIN; WU := WINDMAX; XPOS := WHEREX; YPOS := WHEREY;
  271.  
  272.   GOTOXY(1,1); CLREOL;
  273.   GOTOXY((LO(WU)-LO(WO)-LENGTH(TITEL)+4) SHR 1,1);
  274.   TEXTATTR := TEXTATTR XOR($F0);
  275.   WRITE(TITEL);
  276.   TEXTATTR := TEXTATTR XOR($F0);
  277.   WINDOW(SUCC(LO(WO)),HI(WO)+2,SUCC(LO(WU)),SUCC(HI(WU)));
  278.  
  279.   ZEILE := 1; SPALTE := 0; AUSSCHN := 0;
  280.   P := START; ANZAHL := 1;
  281.   WHILE P^.NEXT <> NIL DO BEGIN
  282.     INC(ANZAHL);
  283.     P := P^.NEXT;
  284.   END; { WHILE }
  285.   ANZAHL := ANZAHL - (SUCC(WWID) * WHIG);
  286.   IF ANZAHL < 1 THEN MAXAUSSCHN := 0 ELSE BEGIN
  287.     MAXAUSSCHN := ANZAHL DIV SUCC(WWID);
  288.     IF ANZAHL MOD SUCC(WWID) > 0 THEN INC(MAXAUSSCHN);
  289.   END;
  290.   BILDAUFBAU;
  291.   ENDE := FALSE;
  292.  
  293.   REPEAT
  294.     GOTOXY(2+SPALTE*16,ZEILE); TEXTATTR := SELECT;
  295.     WITH POINTERLIST[SPALTE,ZEILE]^ DO
  296.       IF (ATTR AND DIRECTORY) = DIRECTORY
  297.         THEN ST := ' '+NAME+'\'
  298.         ELSE ST := ' '+EXPAND(NAME);
  299.       WRITE(ST,' ':14-LENGTH(ST));
  300.       CH1 := READKEY; IF CH1 = #0 THEN CH2 := READKEY ELSE CH2 := #0;
  301.       CASE CH1 OF
  302.         #27 : BEGIN { ESC }
  303.                 SELECTDIRREC := NIL;
  304.                 ENDE := TRUE;
  305.               END;
  306.         #13 : BEGIN { ENTER }
  307.                 SELECTDIRREC := POINTERLIST[SPALTE,ZEILE];
  308.                 ENDE := TRUE;
  309.               END;
  310.          #0 : BEGIN { FUNKTIONSTASTE }
  311.                 IF (CH2 <> #73) AND (CH2 <> #81) THEN BEGIN
  312.                   GOTOXY(2+SPALTE*16,ZEILE);
  313.                   TEXTATTR := NONSEL;
  314.                   WITH POINTERLIST[SPALTE,ZEILE]^ DO
  315.                     IF (ATTR AND DIRECTORY) = DIRECTORY
  316.                       THEN ST := ' '+NAME+'\'
  317.                       ELSE ST := ' '+EXPAND(NAME);
  318.                   WRITE(ST,' ':14-LENGTH(ST));
  319.                 END;
  320.               END;
  321.       END; { CASE CH1 }
  322.       CASE CH2 OF
  323.         #72 : BEGIN { AUF }
  324.                 AUFWAERTS;
  325.               END;
  326.         #80 : BEGIN { AB }
  327.                 ABWAERTS;
  328.               END;
  329.         #75 : BEGIN { LINKS }
  330.                 IF SPALTE > 0 THEN DEC(SPALTE) ELSE BEGIN
  331.                   IF (ZEILE + AUSSCHN) > 1 THEN BEGIN
  332.                     AUFWAERTS;
  333.                     SPALTE := WWID;
  334.                   END;
  335.                 END;
  336.               END;
  337.         #77 : BEGIN { RECHTS }
  338.                 IF SPALTE < WWID THEN BEGIN
  339.                   IF POINTERLIST[SUCC(SPALTE),ZEILE] <> NIL THEN INC(SPALTE);
  340.                 END ELSE BEGIN
  341.                   SPALTE := 0;
  342.                   ABWAERTS;
  343.                 END;
  344.               END;
  345.         #73 : BEGIN { PG UP }
  346.                 IF AUSSCHN > 0 THEN BEGIN
  347.                   DEC(AUSSCHN);
  348.                   BILDAUFBAU;
  349.                 END;
  350.               END;
  351.         #81 : BEGIN { PG DOWN }
  352.                 IF AUSSCHN < MAXAUSSCHN THEN BEGIN
  353.                   INC(AUSSCHN);
  354.                   BILDAUFBAU;
  355.                   WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(SPALTE);
  356.                 END;
  357.               END;
  358.         #71 : BEGIN { HOME }
  359.                 ZEILE := 1;
  360.                 SPALTE := 0;
  361.                 IF AUSSCHN > 0 THEN BEGIN
  362.                   AUSSCHN := 0;
  363.                   BILDAUFBAU;
  364.                 END;
  365.               END;
  366.         #79 : BEGIN { END }
  367.                 IF AUSSCHN < MAXAUSSCHN THEN BEGIN
  368.                   AUSSCHN := MAXAUSSCHN;
  369.                   BILDAUFBAU;
  370.                 END;
  371.                 ZEILE := WHIG;
  372.                 SPALTE := 0;
  373.                 WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(ZEILE);
  374.                 SPALTE := WWID;
  375.                 WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(SPALTE);
  376.               END;
  377.       END; { CASE CH2 }
  378.   UNTIL ENDE;
  379.  
  380.   WINDOW(SUCC(LO(WO)),SUCC(HI(WO)),SUCC(LO(WU)),SUCC(HI(WU)));
  381.   GOTOXY(XPOS,YPOS);
  382.   TEXTATTR := TAALT;
  383. END; { SELECTDIRREC }
  384.  
  385.  
  386. FUNCTION  SELECTFILE(PTH,NAME:STRING):STRING;
  387. VAR   EXECOM,DATEI      : DIRPTR;
  388.       I,DMB,DIRATTR,
  389.       SP,TA             : BYTE;
  390.       DMW               : WORD;
  391.       PATH,DATEINAME,
  392.       S1                : STRING;
  393.       DIRECTORY         : BOOLEAN;
  394.       CH                : CHAR;
  395.  
  396. BEGIN { SELECTFILE }
  397.   SELECTFILE := '';
  398.  
  399.   EXECOM := NIL;
  400.   DIRATTR := STRTOATTR('D');
  401.   IF PTH = '' THEN GETDIR(0,PATH) ELSE PATH := PTH;
  402.   REPEAT
  403.     IF PATH[LENGTH(PATH)] <> '\' THEN PATH := PATH + '\';
  404.     FREEDIR(EXECOM);
  405.     EXECOM := NIL;
  406.     TA := TEXTATTR;
  407.     TEXTATTR := $4E;
  408.     GOTOXY(2,1);
  409.     WRITE(' warten ');
  410.     TEXTATTR := TA;
  411.     READDIR(PATH+NAME,NOATTR,VOLUMEID,DMB,DMW,EXECOM);
  412.  
  413.     STR(DMW,S1);
  414.     DATEI := SELECTDIRREC(' '+PATH+NAME+' '+S1+' Files ',EXECOM,DMW);
  415.  
  416.     IF DATEI = NIL THEN BEGIN
  417.       IF DMW = 0 THEN BEGIN
  418.         CH := READKEY; IF CH = #0 THEN CH := READKEY;
  419.       END;
  420.       EXIT;
  421.     END;
  422.  
  423.     DIRECTORY := (DATEI^.ATTR AND DIRATTR) <> 0;
  424. { BEI NAME[1] = ' ' HANDELT ES SICH UM EINE LAUFWERKSBEZEICHNUNG }
  425.     IF DATEI^.NAME[1] = ' ' THEN BEGIN
  426.       DELETE(DATEI^.NAME,1,1);
  427.       IF DATEI^.NAME <> '..' THEN PATH := '';
  428.     END;
  429. { DIRECTORIES SIND MIT NAME[1] = '\' MARKIERT }
  430.     IF DATEI^.NAME[1] = '\' THEN BEGIN
  431.       DELETE(DATEI^.NAME,1,1);
  432.       IF LENGTH(DATEI^.NAME) > 8 THEN INSERT('.',DATEI^.NAME,9);
  433.     END;
  434.     PATH := PATH + DATEI^.NAME;
  435.  
  436.     IF (DATEI^.NAME = '..') THEN BEGIN
  437.       SP := LENGTH(PATH) - 3;
  438.       PATH := COPY(PATH,1,SP);
  439.       WHILE PATH[SP] <> '\' DO DEC(SP);
  440.       PATH := COPY(PATH,1,PRED(SP));
  441.     END;
  442.  
  443.   UNTIL (NOT DIRECTORY);
  444.   SELECTFILE := PATH;
  445. END; { SELECTFILE }
  446.  
  447.  
  448. END.
  449.  
  450.