home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB40.ZIP / DIREXT.INC < prev    next >
Encoding:
Text File  |  1986-05-18  |  4.1 KB  |  80 lines
  1.   Procedure ListDirectory;
  2.  
  3.   { This procedure lists out all the valid input data files with the declared
  4.     input data file extension constant in the directory window. }
  5.  
  6.   Type    { ListDirectory }
  7.     CharArray=Array [1..12] Of Char;   { array type of character used in looking for input data files }
  8.     WorkString=String[20];             { string type used for file names }
  9.     RecordOfRegisters=                 { a record type to store the integer values of the 8088 internal registers }
  10.       Record
  11.         AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;   { Registers }
  12.       End; { RecordOfRegisters }
  13.  
  14.   Var
  15.     Registers:RecordOfRegisters;       { record variable used to store the integer values of the 8088 internal registers }
  16.     DTA:Array [ 1..43 ] Of Byte;       { Data Transfer Area }
  17.     Mask:CharArray;                    { an array used to store the input file name mask }
  18.     FileName:WorkString;               { a variable used to store a filename found in the directory }
  19.     Error:Integer;                     { a variable used to store the returned error code }
  20.     I:Integer;                         { an index counter used in returning file names }
  21.     J:Integer;                         { an index counter used in placing spaces between the acquired file names }
  22.  
  23.   Begin
  24.     FillChar(DTA,SizeOf(DTA),0);       { initialize the DTA buffer }
  25.     FillChar(Mask,SizeOf(Mask),0);     { initialize the mask }
  26.     FillChar(FileName,SizeOf(FileName),0); { initialize the file name }
  27.     Registers.AX:=$1A00;               { function used to set the DTA }
  28.     Registers.DS:=Seg(DTA);            { store the parameter segment in the data egment register DS }
  29.     Registers.DX:=Ofs(DTA);            { stare the parameter offset in the data register DX }
  30.     MSDos(Registers);                  { set DTA location }
  31.     Error:=0;                          { initialize error flag }
  32.     Mask:='????????.???';              { use for search of input data files }
  33.     Mask[9]:=EXTENSION[1]; { used for looking for input files with a particular file name extension }
  34.     Mask[10]:=EXTENSION[2];
  35.     Mask[11]:=EXTENSION[3];
  36.     Mask[12]:=EXTENSION[4];
  37.     Registers.AX:=$4E00;               { get first directory entry }
  38.     Registers.DS:=Seg(Mask);           { point to the file Mask }
  39.     Registers.DX:=Ofs(Mask);
  40.     Registers.CX:=22;                  { store the option }
  41.     MSDos(Registers);                  { execute MSDos call }
  42.     Error:=Registers.AX and $FF;       { get Error return }
  43.     I:=1;                              { initialize 'I' to the first element }
  44.     If (Error=0) Then
  45.       Repeat
  46.         FileName[I]:=Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
  47.         I:=I+1;
  48.       Until Not (FileName[I-1] in [' '..'~']) or (I>20);
  49.     FileName[0] := Chr(I-1);           { set string length because assigning by element does not set length }
  50.     If (Error=0) Then
  51.       Begin                            { remove data file name extension }
  52.         Delete(FileName,Length(FileName)-4,4);
  53.         Write(FileName);
  54.         For J:=Length(FileName)+1 To 10 Do { place spaces between file names so that they line up vertically }
  55.           Write(' ');
  56.       End; { If Error }
  57.     While (Error=0) Do
  58.       Begin
  59.         Error:=0;                      { initialize error flag }
  60.         Registers.AX:=$4F00;           { function used to get the next directory entry }
  61.         Registers.CX:=22;              { set the file option }
  62.         MSDos(Registers);              { call MSDos }
  63.         Error:=Registers.AX and $FF;   { get the Error return }
  64.         I:=1;
  65.         Repeat
  66.           FileName[I]:=Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
  67.           I:=I+1;
  68.         Until Not (FileName[I-1] in [' '..'~'] ) or (I > 20);
  69.         FileName[0]:=Chr(I-1);
  70.         If (Error=0) Then
  71.           Begin                        { remove data file name extension }
  72.             Delete(FileName,Length(FileName)-4,4);
  73.             Write(FileName);
  74.             For J:=Length(FileName)+1 To 10 Do { place spaces between file names so that they line up vertically }
  75.               Write(' ');
  76.           End; { If Error }
  77.       End; { While Error }
  78.   End;    { ListDirectory }
  79.  
  80.