home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 2 / crawlyvol2.bin / program / pascal / passrc / dirtest.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-18  |  2.6 KB  |  93 lines
  1. { -----------------------------------------------------------------------------
  2.  
  3.                                  NOTICE:
  4.  
  5.       THESE MATERIALS are UNSUPPORTED by OSS!  If you do not understand how to
  6.       use them do not contact OSS for help!  We will not teach you how to 
  7.       program in Pascal.  If you find an error in these materials, feel free
  8.       to SEND US A LETTER explaining the error, and how to fix it.
  9.  
  10.       THE BOTTOM LINE:
  11.  
  12.          Use it, enjoy it, but you are on your own when using these materials!
  13.  
  14.  
  15.                                DISCLAIMER:
  16.  
  17.       OSS makes no representations or warranties with respect to the contents
  18.       hereof and specifically disclaim all warranties of merchantability or
  19.       fitness for any particular purpose.   This document is subject to change
  20.       without notice.
  21.       
  22.       OSS provides these materials for use with Personal Pascal.  Use them in
  23.       any way you wish.
  24.  
  25.    -------------------------------------------------------------------------- }
  26.  
  27.  
  28. PROGRAM dir_test ;
  29.  
  30.   TYPE
  31.     fn_range = 1..14 ;
  32.     fname = PACKED ARRAY [ fn_range ] OF char ;
  33.     frec = PACKED RECORD
  34.              reserved : PACKED ARRAY [ 0..19 ] OF byte ;
  35.              resvd2 : byte ;
  36.              attrib : byte ;
  37.              time_stamp : integer ;
  38.              date_stamp : integer ;
  39.              size : long_integer ;
  40.              name : fname ;
  41.            END ;
  42.     path_name = PACKED ARRAY [ 1..80 ] OF char ;
  43.  
  44.   VAR
  45.     r : frec ;
  46.     i : fn_range ;
  47.     path_string : STRING ;
  48.     path : path_name ;
  49.  
  50.   PROCEDURE set_dta( VAR buf : frec ) ;
  51.     GEMDOS( $1a ) ;
  52.  
  53.   FUNCTION get_first( VAR path : path_name ; search_attrib :integer ):integer ;
  54.     GEMDOS( $4e ) ;
  55.  
  56.   FUNCTION get_next : integer ;
  57.     GEMDOS( $4f ) ;
  58.  
  59.   PROCEDURE show_file( VAR r : frec ) ;
  60.  
  61.     VAR
  62.       i : fn_range ;
  63.  
  64.     BEGIN
  65.       WITH r DO
  66.         BEGIN
  67.           write( attrib:2:h, ' ', time_stamp:4:h, ' ', date_stamp:4:h, ' ',
  68.                 size:8:h, ' ' ) ;
  69.           i := 1 ;
  70.           WHILE (i <= 14) AND (name[i] <> chr(0)) DO
  71.             BEGIN
  72.               write( name[i] ) ;
  73.               i := i + 1
  74.             END ;
  75.           writeln ;
  76.         END ;
  77.     END ;
  78.  
  79.   BEGIN
  80.     write( 'search path: ' ) ;
  81.     readln( path_string ) ;
  82.     FOR i := 1 TO length( path_string ) DO
  83.       path[i] := path_string[i] ;
  84.     path[ length(path_string)+1 ] := chr(0) ;
  85.     set_dta( r ) ;
  86.     IF get_first( path, 0 ) < 0 THEN
  87.       writeln( 'no files match specification!' )
  88.     ELSE
  89.       REPEAT
  90.         show_file( r ) ;
  91.       UNTIL get_next < 0 ;
  92.   END.
  93.