home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TURBDIR.ZIP / TURBDIR.PAS
Encoding:
Pascal/Delphi Source File  |  1986-11-08  |  4.7 KB  |  207 lines
  1. PROGRAM dir;
  2.  
  3. {$i-,u-,c-}
  4.  
  5.    TYPE
  6.      registers=RECORD
  7.                  ax,bx,cx,dx,bp,si,di,ds,es,flags:INTEGER;
  8.                END;
  9.  
  10.      char80arr=ARRAY[1..80] OF CHAR;
  11.      string80=STRING[80];
  12.  
  13.    VAR
  14.      dta:ARRAY[1..43] OF Byte;
  15.      dtaseg,
  16.      dtaofs,
  17.      setdtaseg,
  18.      setdtaofs,
  19.      error,
  20.      i,j,
  21.      att,option:INTEGER;
  22.      regs:registers;
  23.      buffer,
  24.      namr:string80;
  25.      mask:char80arr;
  26.  
  27. PROCEDURE setdta(segment,offset:INTEGER;VAR error:INTEGER);
  28.  
  29.   BEGIN
  30.     regs.ax:=$1a00;
  31.     regs.ds:=segment;
  32.     regs.dx:=offset;
  33.     MSDos(regs);
  34.     error:=regs.ax AND $ff;
  35.   END;
  36.  
  37. PROCEDURE getcurrentdta(VAR segment,offset:INTEGER; VAR error:INTEGER);
  38.  
  39.   BEGIN
  40.     regs.ax:=$2f00;
  41.     MSDos(regs);
  42.     segment:=regs.es;
  43.     offset:=regs.bx;
  44.     error:=regs.ax AND $ff;
  45.   END;
  46.  
  47. PROCEDURE getoption(VAR option:INTEGER);
  48.   VAR
  49.     ch:CHAR;
  50.  
  51.   BEGIN
  52.     ch:='?';
  53.     option:=1;
  54.     WHILE (ch='?') DO
  55.       BEGIN
  56.         WRITE('File option to use, [?] for list :');
  57.         READLN(ch);
  58.         WRITELN;
  59.         CASE(ch) OF
  60.           '1':option :=1;
  61.           '2':option :=7;
  62.           '3':option :=8;
  63.           '4':option :=16;
  64.           '5':option :=22;
  65.           '6':option :=31;
  66.           '?':BEGIN
  67.                 LowVideo;
  68.                 WRITELN('FIle options are : ');
  69.                 WRITELN;
  70.                 WRITELN('[1] for standard files [default].');
  71.                 WRITELN('[2] for system or hidden files');
  72.                 WRITELN('         and standard files');
  73.                 WRITELN('[3] for volume label');
  74.                 WRITELN('[4] for directories and standard files');
  75.                 WRITELN('[5] for directories,hidden or system');
  76.                 WRITELN('       files and standard files');
  77.                 WRITELN('[6] same as 5, but with volume');
  78.                 WRITELN('     label included');
  79.                 WRITELN;
  80.                 NormVideo
  81.               END;
  82.           ELSE
  83.             option :=1;
  84.          END; {case}
  85.     END;
  86.   END;
  87.  
  88. PROCEDURE getfirst(mask:char80arr;VAR namr:string80;segment,offset:INTEGER;
  89.                    option:INTEGER; VAR error:INTEGER);
  90.  
  91.    VAR
  92.      i:INTEGER;
  93.  
  94.   BEGIN
  95.     error:=0;
  96.     regs.ax:=$4e00;
  97.     regs.ds:=Seg(mask);
  98.     regs.dx:=Ofs(mask);
  99.     regs.cx:=option;
  100.     MSDos(regs);
  101.     error:=regs.ax AND $ff;
  102.     i:=1;
  103.     REPEAT
  104.       namr[i]:=CHR(Mem[segment:offset+29+i]);
  105.       i:=i+1;
  106.     UNTIL (NOT(namr[i-1] IN [' '..'~']));
  107.     att:=Mem[segment:offset+21];
  108.     namr[0]:=CHR(i-1);
  109.   END;
  110.  
  111. PROCEDURE getnextentry(VAR namr:string80; segment,offset:INTEGER;
  112.                        option:INTEGER;VAR error:INTEGER);
  113.  
  114.   VAR
  115.     i:INTEGER;
  116.  
  117.   BEGIN
  118.     error:=0;
  119.     regs.ax:=$4f00;
  120.     regs.cx:=option;
  121.     MSDos(regs);
  122.     error:=regs.ax AND $ff;
  123.     i:=1;
  124.     REPEAT
  125.       namr[i]:=CHR(Mem[segment:offset+29+i]);
  126.       i:=i+1;
  127.     UNTIL (NOT(namr[i-1] IN [' '..'~']));
  128.     att:=Mem[segment:offset+21];
  129.     namr[0]:=CHR(i-1);
  130.   END;
  131.  
  132. BEGIN
  133.   FOR i:=1 TO 21 DO dta[i]:=0;
  134.   FOR i:=1 TO 80 DO
  135.     BEGIN
  136.       mask[i]:=CHR(0);
  137.       namr[i]:=CHR(0);
  138.     END;
  139.   namr[0]:=CHR(0);
  140.   WRITELN('QDL version @.0A');
  141.   WRITELN;
  142.   getcurrentdta(dtaseg,dtaofs,error);
  143.   IF (error<>0 ) THEN
  144.     BEGIN
  145.       WRITELN('unable to get current dta');
  146.       WRITELN('program aborting');
  147.       HALT;
  148.     END;
  149.   setdtaseg:=Seg(dta);
  150.   setdtaofs:=Ofs(dta);
  151.   setdta(setdtaseg,setdtaofs,error);
  152.   IF (error<>0) THEN
  153.     BEGIN
  154.       WRITELN('Cannot reset dta');
  155.       WRITELN('Program aborting');
  156.       HALT;
  157.     END;
  158.   error:=0;
  159.   buffer[0]:=CHR(0);
  160.   getoption(option);
  161.   IF (option<>8) THEN
  162.     BEGIN
  163.       WRITE('file mask :');
  164.       READLN(buffer);
  165.       WRITELN;
  166.     END;
  167.   IF (LENGTH(buffer)=0 ) THEN
  168.     buffer:='????????.???';
  169.   FOR i:=1 TO LENGTH(buffer) DO
  170.     mask[i]:=buffer[i];
  171.   getfirst(mask,namr,setdtaseg,setdtaofs,option,error);
  172.   IF (error=0) THEN
  173.     BEGIN
  174.       IF (option <> 8) THEN
  175.         BEGIN
  176.           WRITELN('Directory of : ',buffer);
  177.           WRITELN;
  178.         END;
  179.           IF option<>16 THEN
  180.             WRITELN(namr)
  181.            ELSE
  182.               IF att=16 THEN
  183.                 WRITELN(namr);
  184.     END
  185.   ELSE
  186.     IF option=8 THEN
  187.       WRITELN('Volume label not found')
  188.      ELSE
  189.        WRITELN('File ''', buffer, ''' not found.');
  190.   WHILE (error=0) DO
  191.     BEGIN
  192.       getnextentry(namr,setdtaseg,setdtaofs,option,error);
  193.       IF (error=0) THEN
  194.         BEGIN
  195.           IF option<>16 THEN
  196.             BEGIN
  197.               WRITE(namr);
  198.               IF att=16 THEN WRITELN ('  <DIR>  ') ELSE WRITELN
  199.             END
  200.            ELSE
  201.               IF att=16 THEN
  202.                 WRITELN(namr);
  203.         END;
  204.     END;
  205.   setdta(dtaseg,dtaofs,error);
  206. END.
  207.