home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / enterprs / cpm / utils / a / arc20.arc / ARCDIR.INC < prev    next >
Encoding:
Text File  |  1989-11-11  |  1.6 KB  |  64 lines
  1. (* ARCDIR.INC  TR 031189 *)
  2.  
  3. type fcbtype    = record
  4.                     nam   : string[11];  (* nam[0] == drv *)
  5.                     ext   : byte;
  6.                     fil   : array[13..27] of byte;
  7.                     date  : integer;     (* File Update Stamp *)
  8.                     h,m,s : byte;        (* BDOS Function 102 *)
  9.                     fil2  : array[33..39] of byte;
  10.                     end;
  11.      resulttype = record
  12.                     usr : byte;
  13.                     nam : array[1..11] of char;
  14.                     fil : array[1..20] of byte;
  15.                     end;
  16.  
  17. var  dma        : array[0..3] of resulttype;
  18.      dirfcb     : fcbtype;
  19.  
  20. (* Filenamen aus DMA-Array holen und in String-Form wandeln *)
  21.  
  22. function get_dir(n:byte):filenam;
  23. var fnam : filenam;
  24.     i    : byte;
  25. begin
  26.   if n>3 then get_dir:='' else begin
  27.     fnam:=dma[n].nam;
  28.     insert('.',fnam,9);
  29.     for i:=12 downto 1 do begin
  30.       fnam[i]:=chr(ord(fnam[i]) and $7F);
  31.       if fnam[i]=' ' then delete(fnam,i,1);
  32.       end;
  33.     get_dir:=fnam;
  34.     end;
  35.   end;
  36.  
  37. (* Globalen FCB "DIRFCB" aufbauen *)
  38.  
  39. procedure build_fcb(mask:filenam);
  40. var col,drv : byte;
  41. begin
  42.   col:=pos(':',mask);
  43.   if col=0 then drv:=0 else begin
  44.     drv:=ord(mask[1])-64;
  45.     delete(mask,1,col);
  46.     end;
  47.   astring(mask); dirfcb.nam:=mask;
  48.   dirfcb.nam[0]:=chr(drv); dirfcb.ext:=0;
  49.   end;
  50.  
  51. (* erstes File zu mitgelieferter Maske suchen *)
  52.  
  53. function first_dir(var mask:filenam):filenam;
  54. begin
  55.   build_fcb(mask);
  56.   bdos(26,addr(dma));
  57.   first_dir:=get_dir(bdos(17,addr(dirfcb)));
  58.   end;
  59.  
  60. function next_dir:filenam;
  61. begin
  62.   next_dir:=get_dir(bdos(18));
  63.   end;
  64.