ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/CPM/TURBOPAS/SQZTURBO.LBR/DOS.INC

Text File | 2000-06-30 | 6KB | 165 lines

 {
 [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
 []                                                                    []
 [] The Squeeze/UnSqueeze MsDos routines.                              []
 []                                                                    []
 []   DOS files are "file of char", which keeps read/write procedures  []
 []   simple. DOS Turbo 3.0 must close all file (handles), even if     []
 []   read only. File sizes are determined with LongFileSize function. []
 []                                                                    []
 [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
 }

Const CommandLineLoc                  = $80;
      DisplayCharacter                = $0200;
      PrintCharacter                  = $0500;
      ReturnLoggedDrive               = $1900;
      SetDTA                          = $1A00;
      FindFirstFile                   = $4E00;
      FindNextFile                    = $4F00;

Type  AFile                           = File of Char;
      FlagType       = (CarryFlag,     NoFlag2,
                        ParityFlag,    NoFlag8,
                        AuxCarryFlag,  NoFlag20,
                        ZeroFlag,      SignFlag,
                        StepTrapFlag,  InterruptFlag,
                        DirectionFlag, OverflowFlag,
                        NoFlag100,     NoFlag200,
                        NoFlag400,     NoFlag800);
      FlagSet        = Set of FlagType;
      MsDosRegisters = Record Case Byte of
                         0: (Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Flags: Integer);
                         1: (Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh:          Byte);
                         2: (RegArray: Array[1..9] of          Integer;
                             FlagRegister:                     FlagSet);
                       end;

      DTAType                         = Record
                                          Reserved:  Array[1..21] of Byte;
                                          Attribute: Byte;
                                          FileTime,
                                          FileDate:  Integer;
                                          FileSize:  Array[0..1] of Integer;
                                          FName:     Array[1..13] of Char;
                                        end;

Var   CommandLine:                      String[127]
                                               Absolute CSeg:CommandLineLoc;
      InFile, OutFile:                  AFile;
      DTA:                              DTAType;
      DosRec:                           MsDosRegisters;

Procedure GetLoggedDrive;
  begin
    With DosRec do
      begin
        Ax:=ReturnLoggedDrive; MsDos(DosRec);
        LoggedDrive:=chr(Lo(ax)+65);
      end;
  end; { Procedure GetLoggedDrive }

Procedure FindFiles(FileMask: FileName);
  Var FindFile, FoundFile: FileName;
  begin
    With DosRec do
      begin
        Ax:=SetDTA; Ds:=Seg(DTA); Dx:=Ofs(DTA); MsDos(DosRec);
        FindFile:=FileMask+#0;
        FFirst:=Nil; FLast:=Nil;

        Ax:=FindFirstFile;
        Repeat { Until CarryFlag in FlagRegister }
          Ds:=Seg(FindFile[1]); Dx:=Ofs(FindFile[1]); Cx:=0; MsDos(DosRec);
          If not (CarryFlag in FlagRegister) then
            begin
              FoundFile[0]:=#30;
              Move(DTA.FName,FoundFile[1],13);
              FoundFile[0]:=Chr(Pred(Pos(#0,FoundFile)));
              New(FCurrent);
              FCurrent^.FNme:=FoundFile; FCurrent^.NxtF:=Nil;
              If FFirst=Nil then FFirst:=      FCurrent
              else               FLast^.NxtF:= FCurrent;
              FLast:=FCurrent;
            end;
          Ax:=FindNextFile;
        Until CarryFlag in FlagRegister;

        FCurrent:=FFirst;
      end;
  end;   { Procedure FindFiles }

Function NextFile: FileName;
  begin
    If FCurrent=Nil then NextFile:=''
    else
      begin
        NextFile:=FCurrent^.FNme; FCurrent:=FCurrent^.NxtF;
      end;
  end;   { Function NextFile }

Procedure WriteCharToCon(AChar: Char);
  begin
    With DosRec do
      begin
        Ax:=DisplayCharacter; Dl:=Ord(AChar); MsDos(DosRec);
        Ax:=PrintCharacter;   Dl:=Ord(AChar); MsDos(DosRec);
      end;
  end;   { Procedure WriteCharToCon }

Procedure SetEchoToPrinter;
  begin
    ConOutPtr:=Ofs(WriteCharToCon);
  end;   { Procedure SetEchoToPrinter }

Function TheSizeOf(Var TheFile: AFile): Real;      { DOS can use LongFileSize }
  begin
    TheSizeOf:=LongFileSize(TheFile);
  end; { Function TheSizeOf }

Procedure ResetInFile;                               { DOS reads file of char }
  begin
    Reset(InFile);
  end; { Procedure ResetInFile }

Procedure ReadInFile(Var C: Char);             { DOS just reads the next char }
  begin
    Read(InFile,C);
  end; { Procedure ReadInFile }

Function GetC: Char;                                 { DOS get next character }
  var C: Char;
  begin
    If EOF(InFile) then EOFile:=true
    else begin ReadInFile(c); crc:=crc+ord(C); end;
    GetC:=C;
  end; { Function GetC }

Procedure CloseInFile;              { DOS Turbo 3.0 needs to close the handle }
  begin
    Close(InFile);
  end;   { Procedure CloseInFile }

Procedure ReWriteOutFile;                    { DOS just writes a file of char }
  begin
    ReWrite(OutFile);
  end; { Procedure ReWriteOutFile }

Procedure WriteOutFile(Var C: Char);                 { DOS just writes a char }
  begin
    Write(OutFile,C);
  end; { Procedure WriteOutFile }

Procedure CloseOutFile;                                     { DOS just closes }
  begin
    Close(OutFile);
  end; { Procedure CloseOutFile }

Function GetSizeOfOutFile: Real;    { DOS Turbo 3.0 needs to close the handle }
  begin
    Reset(OutFile);
    GetSizeOfOutFile:=TheSizeOf(OutFile);
    CloseOutFile;
  end;   { Function GetSizeOfOutFile }