home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol094 / dirscan.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-02-10  |  2.1 KB  |  78 lines
  1.  
  2.  
  3. program dir_scan;
  4.  
  5. const
  6.    def_fcb = 92;   (* default file control block address (5Ch *)
  7.    def_dma = 128;  (* default direct memory address (80h) *)
  8.  
  9. type
  10.    peek_poke = char;       
  11.    byteptr   = ^peek_poke;
  12.  
  13. var 
  14.    (* variant record user to circumvent type conflicts *)
  15.  
  16.    abs_mem_adr : record case Boolean of  
  17.                     true : (i : integer);    
  18.                    false : (p : byteptr);
  19.                  end;
  20.  
  21.    i,j,return_code : integer;
  22.  
  23. function dirfrst :integer; external; (* search for first directory entry *)
  24. function dirnext :integer; external; (* search for next entry *)
  25.  
  26. procedure request_all; 
  27. (* filename and filetype are assigned all ?'s, select currently logged drive *)
  28. begin                  
  29.    abs_mem_adr.i:=def_fcb;
  30.    abs_mem_adr.p^:=chr(0);  (* binary zeros for fcb drive code *)
  31.    for i:=1 to 11 do 
  32.    begin
  33.        abs_mem_adr.i:=abs_mem_adr.i + 1;
  34.        abs_mem_adr.p^:='?'
  35.    end
  36. end;
  37.  
  38. procedure write_entry(disp: integer);
  39. (* display filename and filetype from dma + (32 X relative displacement *)
  40. begin
  41.    abs_mem_adr.i:=def_dma + (disp * 32); 
  42.    for i:=1 to 8 do                  
  43.    begin
  44.       abs_mem_adr.i:=abs_mem_adr.i + 1; 
  45.       write(abs_mem_adr.p^)          
  46.    end;
  47.    write(' ');
  48.    for i:=1 to 3 do
  49.    begin
  50.       abs_mem_adr.i:=abs_mem_adr.i + 1;
  51.       write(abs_mem_adr.p^)          
  52.    end
  53. end;
  54.  
  55. (*   M A I N   P R O G R A M   *)
  56.  
  57. beginè   writeln('DIRCTORY LISTING:');
  58.    request_all;
  59.    return_code:=dirfrst;                           
  60.    if return_code=255 then writeln('**Disk is empty**') 
  61.       else                               
  62.       begin
  63.          j:=1;
  64.          while return_code <> 255 do 
  65.          begin         
  66.             write_entry(return_code);              
  67.             write('    ');               
  68.             j:=j+1;
  69.             if j > 4 then                
  70.             begin
  71.                writeln; (* four entries displayed per line *)
  72.                j:=1
  73.             end; (* end if *) 
  74.             return_code:=dirnext                   
  75.          end; (* end while *)
  76.       end; (* end else *)
  77. end.
  78.