home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB32.ZIP / STAYSUBS.300 < prev    next >
Encoding:
Text File  |  1985-08-23  |  4.3 KB  |  111 lines
  1. {****************************************************************************}
  2. {                         S T A Y S U B S  .  I N C                          }
  3. {                                                                            }
  4. {   Separate this file into "Staysubs.Inc" to provide Directory routines     }
  5. {       for the Stay-Resident Demo.                                          }
  6. {                                                                            }
  7. {****************************************************************************}
  8.  
  9.  
  10. {----------------------------------------------------------------------------}
  11. {                  F I L E         S U B R O U T I N E S                     }
  12. {----------------------------------------------------------------------------}
  13.   type
  14.     Dir_Entry   = record
  15.                       Reserved : array[1..21] of byte;
  16.                       Attribute: byte;
  17.                       Time, Date, FileSizeLo, FileSizeHi : integer;
  18.                       Name : string[13];
  19.                     end;
  20.   var
  21.     RetCode     : byte;
  22.     Filename  : filename_type;
  23.     Buffer    : Dir_Entry;
  24.     Attribute : byte;
  25. {----------------------------------------------------------------------------}
  26. {                S  E  T       Disk  Transfer  Address                       }
  27. {----------------------------------------------------------------------------}
  28. Procedure Disk_Trns_Addr(var Disk_Buf);
  29. var
  30.   Registers : regtype;
  31. Begin
  32.   with Registers do
  33.     begin
  34.       Ax := $1A shl 8;                 { Set disk transfer address to  }
  35.       Ds := seg(Disk_Buf);             { our disk buffer               }
  36.       Dx := ofs(Disk_Buf);
  37.       msdos(Registers);
  38.     end;
  39. end;
  40. {----------------------------------------------------------------------------}
  41. {                  F I N D   N E X T   F I L E   E N T R Y                   }
  42. {----------------------------------------------------------------------------}
  43. Procedure Find_Next(var Att:byte; var Filename : Filename_type;
  44.                                       var Next_RetCode : byte);
  45. var
  46.   Registers  : regtype;
  47.   Carry_flag : integer;
  48.   N          : byte;
  49.  
  50. Begin  {Find_Next}
  51.   Buffer.Name := '             ';     { Clear result buffer }
  52.   with Registers do
  53.       begin
  54.       Ax := $4F shl 8;                 { Dos Find next function }
  55.       MsDos(Registers);
  56.       Att := Buffer.Attribute;         { Set file attribute     }
  57.       Carry_flag := 1 and Flags;       { Isolate the Error flag }
  58.       Filename := '             ';
  59.       if Carry_flag = 1 then
  60.         Next_RetCode := Ax and $00FF
  61.       else
  62.         begin                          { Move file name         }
  63.         Next_RetCode := 0;
  64.         for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
  65.         end;
  66.     end;  {with}
  67. end;
  68. {----------------------------------------------------------------------------}
  69. {              F I N D   F I R S T   F I L E   F U N C T I O N               }
  70. {----------------------------------------------------------------------------}
  71. Procedure Find_First (var Att: byte;
  72.                       var Filename: Filename_type;
  73.                       var RetCode_code : byte);
  74.  
  75.   var
  76.       Registers        :regtype;
  77.       Carry_flag       :integer;
  78.       Mask, N          :byte;
  79.  
  80.   begin
  81.     Disk_Trns_Addr(buffer);
  82.     Filename[length(Filename) + 1] := chr(0);
  83.     Buffer.Name := '             ';
  84.     with Registers do
  85.       begin
  86.       Ax := $4E shl 8;                  { Dos Find First Function }
  87.       Cx := Att;                        { Attribute of file to fine }
  88.       Ds := seg(Filename);              { Ds:Dx Asciiz string to find }
  89.       Dx := ofs(Filename) + 1;
  90.       MsDos(Registers);
  91.       Att := Buffer.Attribute;          { set the file attribute byte  }
  92.  
  93.         { If error occured set, Return code. }
  94.  
  95.         Carry_flag := 1 and Flags;      { If Carry flag, error occured }
  96.                                         { and Ax will contain Return code }
  97.         if Carry_flag = 1 then
  98.           begin
  99.           RetCode_code := Ax and $00FF;
  100.           end
  101.  
  102.         else
  103.           begin
  104.           RetCode_code := 0;
  105.           Filename := '             ';
  106.           for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
  107.           end;
  108.  
  109.       end;  {with}
  110. end;
  111.