home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / TEST / DIRTEST.M < prev    next >
Encoding:
Text File  |  1989-08-13  |  888 b   |  43 lines
  1. (*$c-*)
  2. module Dirtest;
  3.  
  4. from inout import OpenOutput, writeln, WriteString, readstring, write, read,
  5.         CloseOutput, writeint;
  6. from directory import dirquery, direntry, fileattr, fileattrset;
  7. import strings;
  8. from system import val;
  9. var ch:char;
  10.     res:INTEGER;
  11.     level:CARDINAL;
  12.     b: BOOLEAN;
  13.  
  14.  
  15. PROCEDURE showentry (path:ARRAY OF CHAR; e:direntry):BOOLEAN;
  16.   var res:integer; i:CARDINAL; p:ARRAY [0..142] of char; b:BOOLEAN; c:char;
  17.   begin
  18.     with e do
  19.       writestring (name);
  20.       IF subdirAttr IN attr THEN
  21.         write ('\')
  22.       end;
  23.       writeln;
  24.     end;
  25.     return true
  26.   end showentry;
  27.  
  28. VAR p: ARRAY [0..127] of char;
  29.  
  30. begin
  31.   level:=0;
  32.   dirquery ('*.*',
  33.   FileAttrSet{
  34.     archiveattr
  35.   },showentry,res);
  36.   if res<0 then
  37.     writeint (res,0); writeln;
  38.   else
  39.     writestring ('OK...');
  40.   end;
  41.   read(ch)
  42. end dirtest.
  43.