home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / V1DIR.ZIP / V1DIR.INC < prev   
Encoding:
Text File  |  1985-12-28  |  9.6 KB  |  274 lines
  1. {    FUNCTION v1dir came when I wanted to allow wild cards in the file
  2. designation for a Turbo Pascal lister.  Since Version 2.0 of Turbo does not
  3. allow path names in its file designation, I decided to use DOS functions 11
  4. and 12, so that the procedure would work with DOS 1.x as well as later
  5. versions.  As long as I was getting the directory for file names, I decided to
  6. also give the rest of the directory information, and to translate the date and
  7. time to standard integers.
  8.      v1dir uses a MARK(dir_mark) instruction.  As a result, page 13 of the
  9. addendum to the Turbo manual says that the calling program must not use the
  10. DISPOSE procedure.  On the other hand, you probably should RELEASE the space
  11. after you are done with the returned directory.
  12.  
  13. Lew Paper
  14. E-1212 First National Bank Building
  15. St. Paul, MN 55101
  16. 3/17/85                                                                   }
  17.  
  18.   TYPE
  19.  
  20.     dirpoint = ^dirtype;
  21.  
  22.     dirtype   =  RECORD
  23.                     full_name           : STRING[14];
  24.                     name                : STRING[8];
  25.                     ext                 : STRING[3];
  26.                     attribute           : BYTE;
  27.                     hours               : BYTE;
  28.                     minutes             : BYTE;
  29.                     seconds             : BYTE;
  30.                     year                : INTEGER;
  31.                     month               : BYTE;
  32.                     day                 : BYTE;
  33.                     size                : REAL;
  34.                                           {To avoid Turbo 2.0's small integer}
  35.                     next                : dirpoint;
  36.                   END; {RECORD dirtype}
  37.  
  38.     intpoint = ^INTEGER;
  39.  
  40.   FUNCTION v1dir(in_name:str255; VAR out_dir:dirpoint; VAR dir_mark:intpoint;
  41.                  VAR bad_spec: BOOLEAN): INTEGER;
  42.  
  43.     {v1dir     : Number of files which match in_name
  44.      in_name   : Input file name.  Can contain a drive letter and wild card
  45.                  characters.  Can not contain a DOS 2.0 path
  46.      out_dir   : Pointer to a chain of dirtype records for files found.  NIL
  47.                  if none found.
  48.      dir_mark  : Pointer MARKed.  Use RELEASE to return the chain of dirtype
  49.                  records.  NIL if none found.
  50.      bad_spec  : TRUE if an illegal drive letter or a bad file specification.
  51.  
  52.      Requires  :
  53.                  Function match_char.  In file MATCHCH.PAS.
  54.                  Type str255 = STRING[255];
  55.                                                                              }
  56.  
  57.     LABEL 1;
  58.  
  59.     TYPE
  60.       regtype       = RECORD
  61.                         ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
  62.                       END; {RECORD regtype}
  63.  
  64.       two_byte      = RECORD
  65.                         low               : BYTE;
  66.                         high              : BYTE;
  67.                       END; {RECORD two_byte}
  68.  
  69.       file_size_rec = RECORD
  70.                         low_order: two_byte;
  71.                         high_order: two_byte;
  72.                       END; {RECORD file_size_rec}
  73.  
  74.       DTA_dir_type  = RECORD
  75.                         drive_number      : BYTE;
  76.                         filename          : ARRAY [0..7] OF CHAR;
  77.                         filename_extension: ARRAY[8..10] OF CHAR;
  78.                         file_attribute    : BYTE;
  79.                         reserved          : ARRAY[12..21] OF BYTE;
  80.                         time              : INTEGER;
  81.                         date              : INTEGER;
  82.                         starting_cluster  : INTEGER;
  83.                         file_size         : file_size_rec;
  84.                       END; {RECORD DTA_dir_type}
  85.  
  86.     VAR
  87.       n_matches,
  88.       parse_lo_ax,
  89.       search_lo_ax,
  90.       i, j: INTEGER;
  91.       wild_file: STRING[15];
  92.       reg: regtype;
  93.       FCB: ARRAY[0..36] of BYTE;
  94.       dir_read: DTA_dir_type;
  95.       first_find: dirpoint;
  96.       first_mark: intpoint;
  97.  
  98.     PROCEDURE error_message(message: str255);
  99.  
  100.       BEGIN {PROCEDURE error_message}
  101.         WRITELN;
  102.         WRITELN('Error in call to FUNCTION v1dir.  ', in_name,
  103.                 ' has invalid ', message);
  104.         bad_spec := TRUE;
  105.         END; {PROCEDURE error_message}
  106.  
  107.     PROCEDURE convert_dir;
  108.  
  109.        FUNCTION float_byte(in_byte: BYTE): REAL;
  110.  
  111.         TYPE
  112.           real_half_type = ARRAY[0..$F] OF REAL;
  113.  
  114.         CONST
  115.           real_half_byte: real_half_type = (0.0, 1.0, 2.0, 3.0, 4.0, 5.0,
  116.                                             6.0, 7.0, 8.0, 9.0, 10.0, 11.0,
  117.                                             12.0, 13.0, 14.0, 15.0);
  118.  
  119.         BEGIN {FUNCTION float_byte}
  120.           float_byte := 16.0 * real_half_byte[in_byte SHR 4] +
  121.                         real_half_byte[in_byte AND $F];
  122.         END; {FUNCTION float_byte}
  123.  
  124.       BEGIN {PROCEDURE convert_dir}
  125.  
  126.         {Create full_name}
  127.         IF FCB[0] > 0
  128.           THEN first_find^.full_name := CHR(ORD('A') -1 + FCB[0]) + ':'
  129.           ELSE first_find^.full_name := '';
  130.         i := 0;
  131.         WHILE (i <= 7) AND (dir_read.filename[i] <> ' ') DO
  132.           BEGIN
  133.             first_find^.full_name := first_find^.full_name +
  134.                                      dir_read.filename[i];
  135.             i := i + 1;
  136.           END; {WHILE (i <= 7) AND (dir_read.filename[i] <> ' ')}
  137.         first_find^.full_name := first_find^.full_name + '.';
  138.         i := 8;
  139.         WHILE (i <= 10) AND (dir_read.filename_extension[i] <> ' ') DO
  140.           BEGIN
  141.             first_find^.full_name := first_find^.full_name +
  142.                                      dir_read.filename_extension[i];
  143.             i := i + 1;
  144.           END; {WHILE (i <= 10) AND (dir_read.filename_extension[i] <> ' ')}
  145.  
  146.         MOVE(dir_read.filename[0], first_find^.name[1], 8);
  147.         first_find^.name[0] := CHR(8);
  148.         MOVE(dir_read.filename_extension[8], first_find^.ext[1], 3);
  149.         first_find^.ext[0] := CHR(3);
  150.         first_find^.attribute := dir_read.file_attribute;
  151.  
  152.         {Get time of creation}
  153.         first_find^.hours := dir_read.time SHR 11;
  154.         first_find^.minutes := (dir_read.time SHR 5) AND $3F;
  155.         first_find^.seconds := (dir_read.time AND $1F) SHL 1;
  156.  
  157.         {Get date of creation}
  158.         first_find^.year := (dir_read.date SHR 9) + 1980;
  159.         first_find^.month := (dir_read.date SHR 5) AND $F;
  160.         first_find^.day := dir_read.date AND $1F;
  161.  
  162.         first_find^.size := 256.0 *
  163.                     (256.0 * float_byte(dir_read.file_size.high_order.low) +
  164.                      float_byte(dir_read.file_size.low_order.high)) +
  165.                      float_byte(dir_read.file_size.low_order.low);
  166.  
  167.         first_find^.next := NIL;
  168.  
  169.       END; {PROCEDURE convert_dir}
  170.  
  171.     BEGIN {FUNCTION v1dir}
  172.       out_dir := NIL;
  173.       dir_mark := NIL;
  174.       n_matches := 0;
  175.  
  176.       {Strip in_file of leading spaces, copy it to wild_file with space
  177.        separator}
  178.        i := match_char(in_name, 1, 32, next_unmatch);
  179.        IF i = 0 THEN
  180.          BEGIN
  181.            WRITELN;
  182.            WRITELN('Error in call to FUNCTION v1dir.  No file name');
  183.            bad_spec := TRUE;
  184.            GOTO 1;
  185.          END; {i = 0}
  186.        j := LENGTH(in_name) - i + 1;
  187.        IF j > 14 THEN j := 14; {Trim off superfluous characters}
  188.        wild_file := COPY(in_name, i, j) + ' ';
  189.  
  190.       {Parse file name}
  191.       WITH reg DO
  192.         BEGIN
  193.           AX := $2900;
  194.           DS := SEG(wild_file[1]);
  195.           SI := OFS(wild_file[1]);
  196.           ES := SEG(FCB);
  197.           DI := OFS(FCB);
  198.           MSDOS(reg);
  199.           parse_lo_ax := LO(AX);
  200.           IF parse_lo_ax = $FF THEN
  201.             BEGIN
  202.               error_message('drive specifier.');
  203.               GOTO 1;
  204.             END; {IF LO(AX) = $FF}
  205.  
  206. (*        {Debug parse}
  207.           WRITELN;
  208.           WRITELN('FCB[0] = ', FCB[0]);
  209.           FOR i := 1 TO 11 DO
  210.             BEGIN
  211.               WRITE('FCB[', i, ']  ');
  212.               IF (FCB[i] >= 33) AND (FCB[i] < 127)
  213.                 THEN
  214.                   WRITELN(CHR(FCB[I]))
  215.                 ELSE
  216.                   WRITELN('DECIMAL ', FCB[i]);
  217.             END; {FOR i := 1 TO 11}
  218.           WRITELN;
  219.           WRITELN('parse_lo_ax = ', parse_lo_ax);              *)
  220.  
  221.           IF FCB[1] = 32 THEN
  222.             BEGIN
  223.               error_message('file name.');
  224.               GOTO 1;
  225.             END; {FCB[1] = 32}
  226.           bad_spec := FALSE;
  227.  
  228.           {Set DTA}
  229.           AX := $1A00;
  230.           DS := SEG(dir_read);
  231.           DX := OFS(dir_read);
  232.           MSDOS(reg);
  233.  
  234.           {Get first directory entry}
  235.           AX := $1100;
  236.           DS := SEG(FCB);
  237.           DX := OFS(FCB);
  238.           MSDOS(reg);
  239.           search_lo_ax := LO(AX);
  240.  
  241.           IF search_lo_ax = 0 THEN
  242.             BEGIN
  243.               MARK(first_mark);
  244.               NEW(first_find);
  245.               convert_dir;
  246.               n_matches := n_matches + 1;
  247.               out_dir := first_find;
  248.               dir_mark := first_mark;
  249.  
  250.               {Get later directory entries}
  251.               WHILE search_lo_ax = 0 DO
  252.                 BEGIN
  253.                   AX := $1200;
  254.                   DS := SEG(FCB);
  255.                   DX := OFS(FCB);
  256.                   MSDOS(reg);
  257.                   search_lo_ax := LO(AX);
  258.                   IF search_lo_ax = 0 THEN
  259.                     BEGIN
  260.                       NEW(first_find^.next);
  261.                       first_find := first_find^.next;
  262.                       convert_dir;
  263.                       n_matches := n_matches + 1;
  264.                     END; {IF search_lo_ax = 0}
  265.                 END; {WHILE search_lo_ax = 0}
  266.  
  267.           END; {IF search_lo_ax = 0}
  268.  
  269.         END; {WITH reg}
  270.  
  271.     1: v1dir := n_matches;
  272.     END; {FUNCTION v1dir}
  273.  
  274.