home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 03 / wdir.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-02-03  |  7.8 KB  |  262 lines
  1. (*****************************************************************************)
  2. (*     Programm : WDIR   Dieses Programm gibt Ihnen anhand der Windowtechnik *)
  3. (*                       eine Direktorie-Uebersicht aus.                     *)
  4. (*                                                                           *)
  5. (*---------------------------------------------------------------------------*)
  6. (*  Date : 14.10.1986   Ersteller : K. Feller                                *)
  7. (*****************************************************************************)
  8.  
  9. PROGRAM wdir (Input, Output);
  10.  
  11. TYPE st3   = STRING (.3.);                              (* globale Groessen: *)
  12.      st8   = STRING (.8.);
  13.      st20  = STRING (.20.);
  14.  
  15. VAR filename: st20;
  16.     lfile   : TEXT;
  17.     i       : INTEGER;
  18.     ch      : CHAR;
  19.     buffer  : STRING (.255.);
  20.     ext     : st3;
  21.  
  22. (*---------------------------------------------------------------------------*)
  23. (*                      Auflisten des Direktories:                           *)
  24.  
  25. FUNCTION fname (was:st3; dev:BYTE; selectflag:BOOLEAN) : st20;
  26.  
  27. CONST lenx = 22;               (* Breite, Hoehe, x-, y-Position des Window's *)
  28.       leny = 14;
  29.       x    = 30;
  30.       y    = 9;
  31.  
  32. LABEL 1;
  33.  
  34. TYPE regpack = RECORD                                      (* 8088  Register *)
  35.                  ax, bx, cx, dx, bp, di, si, ds, es, flags:INTEGER;
  36.                END;
  37.  
  38. VAR reg : regpack;
  39.     such : STRING (.128.);                                    (* Such String *)
  40.     name : STRING (.128.);                               (* Direktorie Entry *)
  41.     retflag, endflag, flag : BOOLEAN;                          (* div. Flags *)
  42.     i, j : INTEGER;
  43.     exist : BOOLEAN;
  44.     namefield : ARRAY (.1..12.) OF st8;                  (* Filenamen Buffer *)
  45.     extfield : ARRAY (.1..12.) OF st3;                   (* Extension Buffer *)
  46.     ch : CHAR;
  47.  
  48.   (*-------------------------------------------------------------------------*)
  49.   (*                             Gibt 'Bell' aus:                            *)
  50.  
  51.   PROCEDURE beep;
  52.  
  53.     BEGIN
  54.       Write (Chr(7));
  55.     END;
  56.  
  57.   (*-------------------------------------------------------------------------*)
  58.   (*                         Setzt Video auf Normal:                         *)
  59.  
  60.   PROCEDURE lowv;
  61.  
  62.     BEGIN
  63.       TextColor (lightgreen);
  64.       TextBackGround (black);
  65.     END;
  66.  
  67.   (*-------------------------------------------------------------------------*)
  68.   (*                       Setzt Video auf Reverse:                          *)
  69.  
  70.   PROCEDURE highv;
  71.  
  72.     BEGIN
  73.       TextColor (yellow);
  74.       TextBackGround (lightblue);
  75.     END;
  76.  
  77.   (*-------------------------------------------------------------------------*)
  78.   (*                      Sucht ersten Eintrag im Directory:                 *)
  79.  
  80.   FUNCTION SearchFirst: BOOLEAN;
  81.  
  82.   BEGIN
  83.     reg.ax := $1a00;                 (* Diskettenuebertragungsadresse setzen *)
  84.     reg.dx := Ofs(name(.1.));
  85.     reg.ds := Seg(name(.1.));
  86.     MSDos(reg);
  87.     reg.ax := $1100;                                (* ersten Eintrag suchen *)
  88.     reg.dx := Ofs(such(.1.));
  89.     reg.ds := Seg(such(.1.));
  90.     MSDos(reg);
  91.     SearchFirst := (Lo(reg.ax) = 0);
  92.   END;
  93.  
  94.   (*-------------------------------------------------------------------------*)
  95.   (*                      Sucht naechsten Eintrag im Directory:              *)
  96.  
  97.   FUNCTION SearchNext: BOOLEAN;
  98.  
  99.   BEGIN
  100.     reg.ax := $1200;
  101.     reg.dx := Ofs(such(.1.));
  102.     reg.ds := Seg(such(.1.));
  103.     MSDos(reg);
  104.     SearchNext := (Lo(reg.ax) = 0);
  105.   END;
  106.  
  107.   (*-------------------------------------------------------------------------*)
  108.   (*              definiert und zeichnet DIR-Window:                         *)
  109.  
  110.   PROCEDURE CatWindow;
  111.  
  112.   VAR i: INTEGER;
  113.  
  114.   BEGIN
  115.     Window(x, y, x+lenx, y+leny);
  116.     TextColor(yellow);
  117.     ClrScr;
  118.     GotoXY(1,1); Write(Chr(201));                       (* linke, obere Ecke *)
  119.     FOR i := 2 TO lenx-1 DO Write(Chr(205));          (* oberer Doppelstrich *)
  120.     Write(Chr(187));                                   (* rechte, obere Ecke *)
  121.     FOR i := 2 TO leny-1 DO
  122.     BEGIN
  123.       GotoXY(1,i); Write(Chr(186));             (* linker und rechter Strich *)
  124.       GotoXY(lenx,i); Write(Chr(186));
  125.     END;
  126.     WriteLn; Write(Chr(200));                          (* linke, untere Ecke *)
  127.     FOR i := 2 TO lenx-1 DO Write(Chr(205));               (* unterer Strich *)
  128.     Write(Chr(188));                                  (* rechte, untere Ecke *)
  129.     Window(x+1, y+1, x+lenx-2, y+leny-2);    (* Window innerhalb des Rahmens *)
  130.     highv;
  131.     ClrScr;
  132.   END;
  133.  
  134.   (*-------------------------------------------------------------------------*)
  135.   (*                      Bedienungsanweisung anzeigen:                      *)
  136.  
  137.   PROCEDURE prompt;
  138.  
  139.   VAR i: INTEGER;
  140.  
  141.   BEGIN
  142.     WriteLn;
  143.     IF j <= 11 THEN
  144.       FOR i := 1 TO 11-j DO WriteLn;
  145.     Write(' ');
  146.     TextColor(white);
  147.     TextBackGround(green);
  148.     IF selectflag THEN
  149.       Write(' CURSOR     SPACE ')
  150.     ELSE
  151.       Write('       SPACE      ');
  152.     TextColor(yellow);
  153.   END;
  154.  
  155.   (*-------------------------------------------------------------------------*)
  156.   (*                    Selektion des gewuenschten Files:                    *)
  157.  
  158.   PROCEDURE select;
  159.  
  160.   BEGIN
  161.     endflag := FALSE;
  162.     retflag := FALSE;
  163.     i := 1;
  164.     REPEAT
  165.       TextColor(white);
  166.       TextBackGround (yellow);
  167.       GotoXY (1,i);
  168.       Write (namefield(.i.):12,'.',extfield(.i.),'    ');
  169.       Read (Kbd,ch);
  170.       highv;
  171.       GotoXY (1,i);
  172.       Write (namefield(.i.):12,'.',extfield(.i.),'    ');
  173.       CASE ch OF
  174.         #32 : endflag := TRUE;                      (* SPACE: naechste Seite *)
  175.         #13 : BEGIN                                     (* RETURN: Selektion *)
  176.                 name := Copy(namefield(.i.),1,Pos(' ',namefield(.i.))-1);
  177.                 name := Concat(name,'.',extfield(.i.));
  178.                 endflag := TRUE;
  179.                 retflag := TRUE;
  180.               END;
  181.         #27 : BEGIN                                        (* Cursor-Tasten: *)
  182.                 Read (Kbd,ch);
  183.                 CASE ch OF
  184.                   #72 : IF i > 1 THEN i := Pred(i) ELSE i := j-2;  (* runter *)
  185.                   #80 : IF i < j-2 THEN i := Succ(i) ELSE i := 1;  (* hoch   *)
  186.                 ELSE
  187.                   beep;
  188.                 END;
  189.               END;
  190.       ELSE
  191.         beep;
  192.       END;
  193.     UNTIL endflag;
  194.     namefield (.1.) := namefield(.j-1.);
  195.     extfield(.1.) := extfield(.j-1.);
  196.     j := 2;
  197.     i := 1;
  198.   END;
  199.  
  200. (*---------------------------------------------------------------------------*)
  201.  
  202. BEGIN (* fname *)
  203.   flag := FALSE;
  204.   such := Chr(dev) + '????????' + was + Chr(0);
  205.   name := '????????????';
  206.   IF SearchFirst THEN
  207.   BEGIN
  208.     CatWindow;
  209.     flag := TRUE;
  210.     j := 1;
  211.     REPEAT
  212.       namefield(.j.) := Copy(name,2,8);
  213.       extfield(.j.) := Copy(name,10,3);
  214.       j := Succ(j);
  215.       IF j > 11 THEN
  216.       BEGIN
  217.         prompt;
  218.         IF selectflag THEN
  219.           select
  220.         ELSE
  221.           BEGIN
  222.             REPEAT
  223.               Read (Kbd,ch);
  224.             UNTIL ch = ' ';
  225.             j := 1;
  226.           END;
  227.         IF endflag AND retflag THEN GOTO 1;
  228.         highv;
  229.         ClrScr;
  230.       END;
  231.       Write(Copy(name,2,8):12,'.',Copy(name,10,3),'    ');
  232.     UNTIL NOT SearchNext;
  233.     IF flag THEN
  234.     BEGIN
  235.       j := Succ(j);
  236.       prompt;
  237.       IF selectflag THEN
  238.         select
  239.       ELSE
  240.         REPEAT
  241.           Read (Kbd,ch);
  242.         UNTIL ch=' ';
  243.     END;
  244.   END;
  245. 1:lowv;
  246.   Window (x,y,x+lenx,y+leny);
  247.   ClrScr;
  248.   Window (1,1,80,25);
  249.   fname:=name;
  250. END;
  251.  
  252. (*---------------------------------------------------------------------------*)
  253.  
  254. (* DEMO: z.B. Selecktion eines Files *)
  255.  
  256. BEGIN
  257.  ClrScr;
  258.  filename:=fname ('???',3,TRUE);
  259.  WriteLn(filename);
  260.  REPEAT UNTIL KeyPressed;
  261. END.
  262.