home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Graphics / Graphics.zip / os2apipm.zip / APIEXAM / DIRLST.ADB < prev    next >
Text File  |  1996-07-19  |  3KB  |  76 lines
  1. -- read file list from FAT
  2. with Ada.text_io; use Ada.text_io;
  3. with builtin; use builtin;
  4. with os2;use os2;
  5. with os2.fm;use os2.fm;
  6. procedure dirlst is
  7. zero:constant character:=character'val(0);
  8. ind :integer;
  9. path_len     :constant integer:=80;   -- buffer length
  10. --                    |01234567890123456789012345678901
  11. --                    |          1         2         3
  12. --                    |   x  xx      xxxxxxxxxxxxxxxxxx - rezerv
  13. -- attr         :ulong:=2#11101100111111000000000000000000#; -- all attr
  14. attr         :ulong:=16#0037#;                 -- normal files
  15. NO_MORE_FILES:apiret:=18 ;            -- end of files list
  16.  
  17. buff         :aliased FILEFINDBUF3;   --  Os2-fm
  18. pbuff        :Pvoid       :=buff'address;
  19. path         :string(1..integer(PATH_LEN)):=(others=>zero);
  20. -- handle       :aliased HDIR := 16#FFFFFFFF#; -- or 1  -- start mean
  21. handle       :aliased HDIR := 16#1#;
  22. phandle      :PHDIR:=handle'unchecked_access;
  23. SearchCount  : aliased ulong:=1;
  24. pSearchCount :pulong:=SearchCount'unchecked_access;
  25. rc:apiret;
  26. l:natural;
  27. flag:boolean:=false;
  28. pp     :constant PCH  :=buff.achName'address;
  29. pdt    :constant PCH  :=buff.fdateLastWrite'address;
  30. file_Name:constant astring(1..CCHMAXPATHCOMP) :=( others => ' ');
  31. for file_Name'address use  pp;
  32. dt:os2.fm.fdate;
  33. for  dt'address use  pdt;
  34. -----------------------------------------------------------------------
  35. procedure pinfo(rc:apiret) is  --  print file or directory information
  36. rcc:apiret;
  37. begin
  38. if rc=NO_MORE_FILES then
  39.  new_line; put_edit("All file list. RC_close=",integer(rcc),4);
  40.  return;
  41. end if;
  42. if rc>0 then
  43.   new_line; put_edit("DosFindxxx error=",integer(rc),4); return;
  44. end if;
  45. ind:=integer(buff.cchName);
  46. set_col(20);
  47. for j in 1..ind loop put(File_name(j)); end loop;  -- file name
  48. set_col(40);
  49. put_edit(" ",integer(buff.attrFile),4);
  50. set_col(50);
  51. if buff.cbFile=0 then put (" <DIR>");
  52.                            else  put_edit(" ",integer(buff.cbFile),5);
  53. end if;
  54. -- put_edit(" write_day=",integer(dt.day),4);
  55. end pinfo;
  56. ------------------------------------------------------------------------
  57. begin
  58. put("Enter path or *.* => ");  get_line(path,l);
  59.  
  60. rc:=DosFindFirst(path,phandle,FILE_DIRECTORY,pbuff,buff'size,
  61.                  pSearchCount,FIL_STANDARD);
  62. if rc>0 then
  63.     new_line; put_edit("DosFindFirst error=",integer(rc),4); put(" xx ");
  64.     goto fin;
  65. end if;
  66. new_line; put("File #  1");
  67. pinfo(rc);                  -- print file/directory inform
  68. for j in 2..integer'last loop  exit when flag;
  69.  rc:=DosFindNext(handle,pbuff,buff'size,pSearchCount);
  70.  if rc>0 then flag:=true; else new_line; put_edit("File #",j,3); end if;
  71.  pinfo(rc);                  -- print file/directory inform
  72. end loop;
  73. <<fin>> new_line; put("End");
  74.   if  DosFindClose(handle) = 0 then null; end if; put('!');
  75. end dirlst;
  76.