home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB11.ZIP / GETDIR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-08-05  |  4.2 KB  |  119 lines
  1. PROGRAM GetDir;
  2. {
  3. This program displays a directory for MS-DOS systems from within
  4. a TURBO pascal program. The following MS-DOS function calls are used:
  5.  
  6.     2F - Get Disk Transfer Address (DTA) in ES:BX
  7.     4E - Find first occurrance of file name at DS:DX
  8.     4F - Find next occurrance of file name at DS:DX
  9.  
  10. Source: "Displaying an MS-DOS Directory", TUG Lines Volume I Issue 6
  11. Author: Scott Freeman/Detroit, MI
  12. Application: PC-DOS, MS-DOS
  13. }
  14.  
  15. type
  16.  DirStr = string[12];
  17.  regpack = record
  18.             ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
  19.            end;
  20.  
  21. var name1, name2                      : dirstr;
  22.     found                             : boolean;
  23.  
  24. Procedure Find_DTA(VAR dtaseg,dtaofs : integer);
  25. { Find the address of the DTA with function 2F }
  26. { Both CP/M and Xenix style directory searches put results in the DTA }
  27.  
  28. var recpack                           : regpack;
  29. begin
  30.  with recpack do begin
  31.   ax := $2F shl 8;
  32.   MsDos(recpack);
  33.   dtaseg := es;
  34.   dtaofs := bx;
  35.  end;
  36. end;
  37.  
  38. Function Get_Filename_from_DTA : dirstr;
  39. { Extract the filename from the Data Transfer Area and return a string }
  40. { The name returned does NOT have a drive letter specification.        }
  41.  
  42. var i, dtaseg, dtaofs                 : integer;
  43.     ch                                : char;
  44.     result                            : dirstr;
  45. begin
  46.  find_DTA(dtaseg,dtaofs);             { Where did MSDOS leave the name?   }
  47.  result := '';                        { Avoid sending old garbage back    }
  48.  i := 30;                             { Name starts at position 30 of DTA }
  49.  ch := chr(mem[dtaseg:dtaofs+i]);     { Get the first character           }
  50.  while ch <> chr(0) do begin          { Get characters until null found   }
  51.   result := concat(result,ch);
  52.   i := i+1;
  53.   ch := chr(mem[dtaseg:dtaofs+i]); end;
  54.  get_filename_from_DTA := result;
  55. end;
  56.  
  57. Procedure Dir_First(    Source : dirstr;     { Pattern to search for    }
  58.                     VAR Result : dirstr;     { Entry found that matches }
  59.                     VAR Found  : boolean);   { True if pattern matched  }
  60. var
  61.  recpack                       : regpack;    {record for MSDOS call}
  62.  flg                           : byte;
  63. begin
  64.  { Add a terminating null so that it's an ASCIIZ string }
  65.  source := concat(source,chr(0));
  66.  with recpack do
  67.  begin
  68.   ax := $4E shl 8;           { Call Xenix-like Directory First function }
  69.   ds := (seg(source));
  70.   dx := (ofs(source)+1);     { Skip the length byte of a TURBO string   }
  71.  end;
  72.  MsDOS(recpack);
  73.  result := '';                  { Make the return string a null   }
  74.  flg := recpack.flags AND 1;    { Check to see if match was found }
  75.  if flg = 0 then begin          { Found a match                   }
  76.    found := true;
  77.    result := Get_Filename_From_DTA;
  78.  end
  79.    else found := false;         { No match found                  }
  80. end;
  81.  
  82. Procedure Dir_Next(     Source : dirstr;     { Pattern to search for      }
  83.                     VAR Result : dirstr;     { Entry found that matches   }
  84.                     VAR Found  : boolean);   { True if pattern matched    }
  85. {Calls to this procedure must be proceded by an initial call to Dir_First }
  86. var
  87.  recpack                       : regpack;    { record for MSDOS call      }
  88.  flg                           : byte;
  89. begin
  90.  { Add a terminating null so that it's an ASCIIZ string }
  91.  source := concat(source,chr(0));
  92.  with recpack do
  93.  begin
  94.   ax := $4F shl 8;           { Call Xenix-like Directory Next function }
  95.   ds := (seg(source));
  96.   dx := (ofs(source)+1);     { Skip the length byte of a TURBO string  }
  97.  end;
  98.  MsDOS(recpack);
  99.  result := '';                  { Make the return string a null   }
  100.  flg := recpack.flags AND 1;    { Check to see if match was found }
  101.  if flg = 0 then begin          { Found a match                   }
  102.    found := true;
  103.    result := Get_Filename_From_DTA;
  104.  end
  105.    else found := false;         { No match found                  }
  106. end;
  107.  
  108. begin { Main program - to test operation of directory procedures }
  109.  name1 := '*.*';  { Show all directory entries }
  110.  Dir_First(name1,name2,found);
  111.  if found then begin
  112.   writeln(name2);
  113.   repeat
  114.    Dir_Next(name1,name2,found);
  115.    if found then writeln(name2);
  116.   until NOT found;
  117.  end;
  118. end. { Main }
  119.