home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / beehive / zcat / tptool19.lbr / OS-MSDOS.PQS / OS-MSDOS.PAS
Pascal/Delphi Source File  |  1991-01-31  |  4KB  |  119 lines
  1.   { OS-MSDOS.PAS }
  2.   { put all MS-DOS specific code in this file }
  3.  
  4.  
  5.   procedure listcat;
  6.     { list MS-DOS directory filenames on current (logged) drive.       }
  7.     { Derived from DIRECTRY.PAS and QDL.PAS  in "Turbo Tutor", 1984.   }
  8.     { Mods by W. Kempton, Jan 1985--  Fix three bugs:  1) never found
  9.      first filename, 2) overflowed NamR, 3) added a null at end of name.
  10.      (For a textbook, that's mighty buggy.)  Save file names in buffer
  11.      before writing them.  Adapt to K&R Software Tools STDIO. Clean up
  12.      code.
  13.      }
  14.     { works under MS-DOS 2.0, but not 1.0 }
  15.  
  16.   const
  17.     SizeOfDTA = 43;
  18.     SizeOfMask= 12;
  19.     NameSize = 13;  { must be > longest filename }
  20.     MaxFiles = 255;
  21.  
  22.   type
  23.     RegRec =
  24.     record
  25.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  26.     end;
  27.     Name = packed array [1..NameSize] of char;
  28.  
  29.   var
  30.     Regs       : RegRec;
  31.     DTA        : array [ 1..SizeOfDTA ] of Byte;
  32.     Mask       : array [1..SizeOfMask] of Char;
  33.     DirBuf     : array [1..MaxFiles] of Name;
  34.     OutName    : XSTRING;
  35.     SaveDTASeg,
  36.     SaveDTAOfs,
  37.     NameCount,
  38.     ErrorNum, I,j : Integer;
  39.  
  40.  
  41.     procedure ErrorCheck;
  42.      begin
  43.       if ErrorNum <> 0 then  error('List: system call error');
  44.      end;
  45.  
  46.     procedure SetDTA( Segment, Offset : Integer; var Error : Integer );
  47.      begin
  48.       Regs.AX := $1A00;         { Function used to set the DTA }
  49.       Regs.DS := Segment;       { store the parameter Segment in DS }
  50.       Regs.DX := Offset;        {   "    "      "     Offset in DX }
  51.       MSDos( Regs );            { Set DTA location }
  52.       Error := Regs.AX and $FF; { get Error return }
  53.      end; { of proc SetDTA }
  54.  
  55.  
  56.     procedure GetCurrentDTA( var Segment, Offset : Integer;
  57.                             var Error : Integer );
  58.      begin
  59.       Regs.AX := $2F00;    { Function used to get current DTA address }
  60.       MSDos( Regs );       { Exicute MSDos function request }
  61.       Segment := Regs.ES;  { Segment of DTA returned by DOS }
  62.       Offset := Regs.BX;   { Offset of DTA returned }
  63.       Error := Regs.AX and $FF;
  64.      end; { GetCurrentDTA }
  65.  
  66.  
  67.     procedure GetName(var NameCount: integer);
  68.       { use MS-DOS call to get one name from system table--highly Turbo-specific }
  69.     var
  70.       I: integer; { char count }
  71.      begin
  72.       if NameCount = 0
  73.        then Regs.AX := $4e00    { get first directory entry }
  74.        else Regs.AX := $4f00;   { get next directory entry }
  75.       Regs.CX := 22;             { Store the option }
  76.       MSDos(Regs);               { Execute MSDos call }
  77.       ErrorNum := Regs.AX and $FF;  { Get Error return }
  78.       if (ErrorNum = 0) then
  79.          begin                     { valid filename; store in NamR }
  80.           I := 1;
  81.           NameCount := NameCount+1;
  82.           repeat
  83.             DirBuf[NameCount,I] := CHR(DTA[30+I]);
  84.             I := I + 1;
  85.           until not (DirBuf[NameCount,I-1] in [' '..'~']) or (I>=NameSize);
  86.           DirBuf[NameCount,I] := CHR(ENDSTR);   { mark end of name string }
  87.          end;
  88.      end { GetName };
  89.  
  90.  
  91.    begin { listcat }
  92.     GetCurrentDTA(SaveDTASeg,SaveDTAOfs, ErrorNum); { save DTA address }
  93.     ErrorCheck;
  94.     for i:= 1 to SizeOfDTA do DTA[i]:= 0;           { zero local DTA   }
  95.     SetDTA(Seg(DTA),Ofs(DTA),ErrorNum);  ErrorCheck;
  96.     ErrorNum := 0;
  97.     { FillChar(Mask,SizeOfMask,0);}          { Initialize mask }
  98.     Mask := '????????.???';                  { global search }
  99.     Regs.DX := Ofs(Mask);
  100.     Regs.DS := Seg(Mask);
  101.  
  102.     NameCount := 0;                          { get file names from system }
  103.     repeat
  104.       GetName(NameCount);
  105.     until ErrorNum <> 0;
  106.  
  107.     SetDTA(SaveDTASeg,SaveDTAOfs, ErrorNum); { restore original DTA  }
  108.     ErrorCheck;
  109.     for I := 1 to NameCount do               { write names from DirBuf }
  110.       begin
  111.        j := 1;
  112.        repeat
  113.          OutName[j] := ord(DirBuf[I,j]);  j := j+1;
  114.        until ord(DirBuf[I,(j-1)]) = ENDSTR;
  115.        PUTSTR(OutName,STDOUT);              { K&R output to STDOUT }
  116.        PUTC(NEWLINE);
  117.       end;
  118.    end { listcat };
  119.