Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TSRSRC29.ZIP/MARKNET.PAS

Pascal/Delphi Source File | 1993-01-04 | 17.6 KB | 660 lines

{**************************************************************************
*   MARKNET - stores system information in a file for later restoration.  *
*   Copyright (c) 1986,1989 Kim Kokkonen, TurboPower Software.            *
*   May be distributed freely, but not for a profit except with written   *
*   permission from TurboPower Software.                                  *
***************************************************************************
*   Version 2.7 3/4/89                                                    *
*     first public release                                                *
*     (based on FMARK 2.6)                                                *
*   Version 2.8 3/10/89                                                   *
*     store the DOS environment                                           *
*     store information about the async ports                             *
*   Version 2.9 5/4/89                                                    *
*     for consistency                                                     *
***************************************************************************
*   Telephone: [phone], CompuServe: 72457,2131.                      *
*   Requires Turbo version 5 to compile.                                  *
***************************************************************************}

{$R-,S-,I-}
{.$DEFINE Debug} {Activate for status messages}

program MarkNet;

uses
  Dos;

const
  Version = '2.9';
  NmarkID = 'MN2.9 TSR';          {Marking string for TSR file mark}
  NetMarkID = 'MN29';             {ID at start of net mark file}

  NmarkOffset = $60;              {Where NmarkID is found in MARKNET TSR}

  MaxHandles = 32;                {Max number of EMS allocation blocks supported}
  EMSinterrupt = $67;             {The vector used by the expanded memory manager}

  MarkFOpen : Boolean = False;    {True while mark file is open}

  Digits : array[0..$F] of Char = '0123456789ABCDEF';

  RBR = 0; {Receiver buffer register offset}
  THR = 0; {Transmitter buffer register offset}
  BRL = 0; {Baud rate low}
  BRH = 1; {Baud rate high}
  IER = 1; {Interrupt enable register}
  IIR = 2; {Interrupt identification register}
  LCR = 3; {Line control register}
  MCR = 4; {Modem control register}
  LSR = 5; {Line status register}
  MSR = 6; {Modem status register}

type
  DeviceHeader =
    record
      NextHeaderOffset : Word;    {Offset address of next device in chain}
      NextHeaderSegment : Word;   {Segment address of next device in chain}
      Attributes : Word;          {Device attributes}
      StrategyEntPt : Word;       {Offset in current segment - strategy}
      InterruptEntPt : Word;      {Offset in current segment - interrupt}
      DeviceName : array[1..8] of Char; {Name of the device}
    end;

  SO =
    record
      O, S : Word;
    end;

  FileRec =
    record
      OpenCnt : Word;
      OpenMode : Word;
      Attribute : Byte;
      Unknown1 : Word;
      DCB : Pointer;
      InitCluster : Word;
      Time : Word;
      Date : Word;
      Size : LongInt;
      Pos : LongInt;
      BeginCluster : Word;
      CurCluster : Word;
      Block : Word;
      Unknown2 : Byte;            {Varies with DOS version below here}
      Name : array[0..7] of Char;
      Ext : array[0..2] of Char;
      Unknown3 : array[0..5] of Byte;
      Owner : Word;
      Unknown4 : Word;
    end;

  SftRecPtr = ^SftRec;
  SftRec =
    record
      Next : SftRecPtr;
      Count : Word;
      Files : array[1..255] of FileRec;
    end;

  DosRec =
    record
      McbSeg : Word;
      FirstDPB : Pointer;
      FirstSFT : SftRecPtr;
      ClockDriver : Pointer;
      ConDriver : Pointer;
      MaxBlockBytes : Word;
      CachePtr : Pointer;
      DriveTable : Pointer;
      Unknown2 : Pointer;
      Unknown3 : Word;
      BlockDevices : Byte;
      LastDrive : Byte;
      NullDevice : DeviceHeader;
    end;

  HandlePageRecord =
    record
      Handle : Word;
      NumPages : Word;
    end;

  PageArray = array[1..MaxHandles] of HandlePageRecord;
  PageArrayPtr = ^PageArray;

var
  MarkName : String[79];          {Name of mark file}

  Regs : Registers;               {Machine registers for MS-DOS calls}
  DevicePtr : ^DeviceHeader;      {Pointer to the next device header}
  DeviceSegment : Word;           {Current device segment}
  DeviceOffset : Word;            {Current device offset}
  MarkF : file;                   {Dump file}
  DosPtr : ^DosRec;               {Pointer to internal DOS table}
  DosTableSize : Word;            {Bytes saved in DOS table}
  CommandSeg : Word;              {PSP segment of primary COMMAND.COM}
  CommandPsp : array[1..$100] of Byte;
  FileTableA : array[1..5] of SftRecPtr;
  FileTableCnt : Word;
  FileRecSize : Word;
  EmsHandles : Word;
  EmsPages : PageArrayPtr;

  SaveExit : Pointer;

  {$F+}
  procedure ExitHandler;
  begin
    ExitProc := SaveExit;
    if MarkFOpen then begin
      Close(MarkF);
      if IoResult = 0 then
        Erase(MarkF);
    end;
    {Turbo will swap back, so undo what we've done already}
    SwapVectors;
  end;
  {$F-}

  procedure Abort(Msg : String);
    {-Halt in case of error}
  begin
    WriteLn(Msg);
    Halt(255);
  end;

  function HexW(W : Word) : string;
    {-Return hex string for word}
  begin
    HexW[0] := #4;
    HexW[1] := Digits[hi(W) shr 4];
    HexW[2] := Digits[hi(W) and $F];
    HexW[3] := Digits[lo(W) shr 4];
    HexW[4] := Digits[lo(W) and $F];
  end;

  function HexPtr(P : Pointer) : string;
    {-Return hex string for pointer}
  begin
    HexPtr := HexW(SO(P).S)+':'+HexW(SO(P).O);
  end;

  function StUpcase(S : String) : string;
    {-Return uppercase for string}
  var
    I : Integer;
  begin
    for I := 1 to Length(S) do
      S[I] := Upcase(S[I]);
    StUpcase := S;
  end;

  procedure GetDosPtr;
    {-Return pointer to DOS internal variables table}
  begin
    with Regs do begin
      AH := $52;
      MsDos(Regs);
      Dec(BX, 2);
      DosPtr := Ptr(ES, BX);
    end;
  end;

  procedure FindDevChain;
    {-Return segment, offset and pointer to NUL device}
  begin
    GetDosPtr;
    DevicePtr := @DosPtr^.NullDevice;
    DeviceSegment := SO(DevicePtr).S;
    DeviceOffset := SO(DevicePtr).O;
  end;

  procedure CheckWriteError;
    {-Check for errors writing to mark file}
  begin
    if IoResult = 0 then
      Exit;
    Abort('Error writing to '+MarkName);
  end;

  function EMSpresent : Boolean;
    {-Return true if EMS memory manager is present}
  var
    F : file;
  begin
    {"file handle" defined by the expanded memory manager at installation}
    Assign(F, 'EMMXXXX0');
    Reset(F);
    if IoResult = 0 then begin
      EMSpresent := True;
      Close(F);
    end else
      EMSpresent := False;
  end;

  procedure EMSpageMap(var PageMap : PageArray; var EmsHandles : Word);
    {-Return an array of the allocated EMS memory blocks}
  begin
    Regs.AH := $4D;
    Regs.ES := Seg(PageMap);
    Regs.DI := Ofs(PageMap);
    Regs.BX := 0;
    Intr(EMSinterrupt, Regs);
    if Regs.AH <> 0 then
      EmsHandles := 0
    else
      EmsHandles := Regs.BX;
  end;

  procedure SaveStandardInfo;
    {-Save the ID string, the vectors, and so on}
  type
    IDArray = array[1..4] of Char;
  var
    ID : IDArray;
  begin
    {Write the ID string}
    {$IFDEF Debug}
    WriteLn('Writing mark file ID string');
    {$ENDIF}
    ID := NetMarkID;
    BlockWrite(MarkF, ID, SizeOf(IDArray));
    CheckWriteError;

    {Write the start address of the device chain}
    {$IFDEF Debug}
    WriteLn('Writing null device address');
    {$ENDIF}
    BlockWrite(MarkF, DevicePtr, SizeOf(Pointer));
    CheckWriteError;

    {Write the vector table}
    {$IFDEF Debug}
    WriteLn('Writing interrupt vector table');
    {$ENDIF}
    BlockWrite(MarkF, Mem[0:0], 1024);
    CheckWriteError;

    {Write miscellaneous save areas}
    {$IFDEF Debug}
    WriteLn('Writing EGA save table');
    {$ENDIF}
    BlockWrite(MarkF, Mem[$40:$A8], 8); {EGA save table}
    CheckWriteError;
    {$IFDEF Debug}
    WriteLn('Writing interapplications communication area');
    {$ENDIF}
    BlockWrite(MarkF, Mem[$40:$F0], 16); {Interapplications communication area}
    CheckWriteError;
    {$IFDEF Debug}
    WriteLn('Writing parent PSP segment');
    {$ENDIF}
    BlockWrite(MarkF, Mem[PrefixSeg:$16], 2); {Parent's PSP segment}
    CheckWriteError;

    {Write EMS information}
    if EMSpresent then begin
      GetMem(EmsPages, 2048);
      EMSpageMap(EmsPages^, EmsHandles);
    end else
      EmsHandles := 0;
    {$IFDEF Debug}
    WriteLn('Writing EMS handle information');
    {$ENDIF}
    BlockWrite(MarkF, EmsHandles, SizeOf(Word));
    if EmsHandles <> 0 then
      BlockWrite(MarkF, EmsPages^, 4*EmsHandles);
    CheckWriteError;
  end;

  procedure SaveDevChain;
    {-Save the device driver chain}
  begin
    {$IFDEF Debug}
    WriteLn('Saving device driver chain');
    {$ENDIF}
    while SO(DevicePtr).O <> $FFFF do begin
      BlockWrite(MarkF, DevicePtr^, SizeOf(DeviceHeader));
      CheckWriteError;
      with DevicePtr^ do
        DevicePtr := Ptr(NextHeaderSegment, NextHeaderOffset);
    end;
  end;

  procedure BufferFileTable;
    {-Save an image of the system file table}
  var
    S : SftRecPtr;
    Size : Word;
  begin
    with DosPtr^ do begin
      S := FirstSFT;
      FileTableCnt := 0;
      while SO(S).O <> $FFFF do begin
        Inc(FileTableCnt);
        Size := 6+S^.Count*FileRecSize;
        GetMem(FileTableA[FileTableCnt], Size);
        Move(S^, FileTableA[FileTableCnt]^, Size);
        S := S^.Next;
      end;
    end;
  end;

  procedure SaveDOSTable;
    {-Save the DOS internal variables table}
  var
    DosBase : Pointer;
    Size : Word;
  begin
    {$IFDEF Debug}
    WriteLn('Saving DOS data area at 0050:0000');
    {$ENDIF}
    BlockWrite(MarkF, mem[$50:$0], $200);
    CheckWriteError;
    DosBase := Ptr(SO(DosPtr).S, 0);
    {$IFDEF Debug}
    WriteLn('Saving DOS variables table at ', HexPtr(DosBase));
    {$ENDIF}
    Size := SO(DosPtr^.FirstSFT).O;
    BlockWrite(MarkF, Size, SizeOf(Word));
    BlockWrite(MarkF, DosBase^, Size);
    CheckWriteError;
  end;

  procedure SaveFileTable;
    {-Save the state of the file table}
  var
    I : Word;
    Size : Word;
  begin
    {$IFDEF Debug}
    WriteLn('Saving DOS file table at ', HexPtr(DosPtr^.FirstSFT));
    {$ENDIF}
    BlockWrite(MarkF, FileTableCnt, SizeOf(Word));
    for I := 1 to FileTableCnt do begin
      Size := 6+FileTableA[I]^.Count*FileRecSize;
      BlockWrite(MarkF, FileTableA[I]^, Size);
    end;
    CheckWriteError;
  end;

  procedure BufferCommandPSP;
    {-Save the PSP of COMMAND.COM}
  type
    McbRec =
      record
        ID : Char;
        PSPSeg : Word;
        Len : Word;
      end;
  var
    McbPtr : ^McbRec;
    PspPtr : Pointer;
  begin
    {First block}
    McbPtr := Ptr(DosPtr^.McbSeg, 0);
    {Next block, which is COMMAND.COM}
    McbPtr := Ptr(SO(McbPtr).S+McbPtr^.Len+1, 0);
    CommandSeg := McbPtr^.PSPSeg;
    PspPtr := Ptr(CommandSeg, 0);
    Move(PspPtr^, CommandPsp, $100);
  end;

  procedure SaveCommandPSP;
  begin
    {$IFDEF Debug}
    WriteLn('Saving COMMAND.COM PSP at ', HexW(CommandSeg), ':0000');
    {$ENDIF}
    BlockWrite(MarkF, CommandPsp, $100);
    CheckWriteError;
  end;

  procedure SaveCommandPatch;
    {-Restore the patch that NetWare applies to command.com}
  label
    ExitPoint;
  const
    Patch : array[0..14] of Char = ':/'#0'_______.___'#0;
  var
    Segm : Word;
    Ofst : Word;
    Indx : Word;
  begin
    for Segm := CommandSeg to PrefixSeg do
      for Ofst := 0 to 15 do begin
        Indx := 0;
        while (Indx <= 14) and (Patch[Indx] = Char(Mem[Segm:Ofst+Indx])) do
          Inc(Indx);
        if Indx > 14 then begin
          {$IFDEF Debug}
          WriteLn('Saving COMMAND patch address at ', HexW(Segm), ':', HexW(Ofst));
          {$ENDIF}
          goto ExitPoint;
        end;
      end;
    Segm := 0;
    Ofst := 0;
ExitPoint:
    BlockWrite(MarkF, Ofst, SizeOf(Word));
    BlockWrite(MarkF, Segm, SizeOf(Word));
    CheckWriteError;
  end;

  procedure FindEnv(CommandSeg : Word; var EnvSeg, EnvLen : Word);
    {-Return the segment and length of the master environment}
  var
    Mcb : Word;
  begin
    Mcb := CommandSeg-1;
    EnvSeg := MemW[CommandSeg:$2C];
    if EnvSeg = 0 then
      {Master environment is next block past COMMAND}
      EnvSeg := Commandseg+MemW[Mcb:3]+1;
    EnvLen := MemW[(EnvSeg-1):3] shl 4;
  end;

  procedure SaveDosEnvironment;
    {-Save the master copy of the DOS environment}
  var
    EnvSeg : Word;
    EnvLen : Word;
    P : Pointer;
  begin
    FindEnv(CommandSeg, EnvSeg, EnvLen);
    {$IFDEF Debug}
    WriteLn('Saving master environment, ', EnvLen, ' bytes at ', HexW(EnvSeg), ':0000');
    {$ENDIF}
    P := Ptr(EnvSeg, 0);
    BlockWrite(MarkF, EnvLen, SizeOf(Word));
    BlockWrite(MarkF, P^, EnvLen);
    CheckWriteError;
  end;

  procedure SaveCommState;
    {-Save the state of the communications controllers}
  var
    PicMask : Byte;
    Com : Byte;
    LCRSave : Byte;
    Base : Word;
    ComPortBase : array[1..2] of Word absolute $40:0; {Com port base addresses}

    procedure SaveReg(Offset : Byte);
      {-Save one communications register}
    var
      Reg : Byte;
    begin
      Reg := Port[Base+Offset];
      BlockWrite(MarkF, Reg, SizeOf(Byte));
      CheckWriteError;
    end;

  begin
    {$IFDEF Debug}
    WriteLn('Saving communications environment');
    {$ENDIF}

    {Save the 8259 interrupt enable mask}
    PicMask := Port[$21];
    BlockWrite(MarkF, PicMask, SizeOf(Byte));
    CheckWriteError;

    for Com := 1 to 2 do begin
      Base := ComPortBase[Com];

      {Save the Com port base address}
      BlockWrite(MarkF, Base, SizeOf(Word));
      CheckWriteError;

      if Base <> 0 then begin
        {Save the rest of the control state}
        SaveReg(IER);             {Interrupt enable register}
        SaveReg(LCR);             {Line control register}
        SaveReg(MCR);             {Modem control register}
        LCRSave := Port[Base+LCR]; {Save line control register}
        Port[Base+LCR] := LCRSave or $80; {Enable baud rate divisor registers}
        SaveReg(BRL);             {Baud rate divisor low}
        SaveReg(BRH);             {Baud rate divisor high}
        Port[Base+LCR] := LCRSave; {Restore line control register}
      end;
    end;
  end;

  function CompaqDOS30 : Boolean;
    {-Return true if Compaq DOS 3.0}
  begin
    with Regs do begin
      AH := $34;
      MsDos(Regs);
      CompaqDOS30 := (BX = $19C);
    end;
  end;

  procedure ValidateDosVersion;
    {-Assure supported version of DOS and compute size of DOS internal filerec}
  var
    DosVer : Word;
  begin
    DosVer := DosVersion;
    case Lo(DosVer) of
      3 : if (Hi(DosVer) < $0A) and not CompaqDOS30 then
            {IBM DOS 3.0}
            FileRecSize := 56
          else
            {DOS 3.1+ or Compaq DOS 3.0}
            FileRecSize := 53;
      4 : FileRecSize := 59;
    else
      Abort('Requires DOS 3.x or 4.x');
    end;
  end;

  procedure SaveIDStrings;
    {-Save identification strings within the PSP}
  var
    ID : String[10];
  begin
    Move(MarkName, Mem[PrefixSeg:$80], Length(MarkName)+1);
    Mem[PrefixSeg:$80+Length(MarkName)+1] := 13;
    ID := NmarkID;
    Move(ID[1], Mem[PrefixSeg:NmarkOffset], Length(ID));
  end;

  procedure CloseStandardFiles;
    {-Close all standard files}
  var
    H : Word;
  begin
    with Regs do
    for H := 0 to 4 do begin
      AH := $3E;
      BX := H;
      MsDos(Regs);
    end;
  end;

begin
  {Must run with standard DOS vectors}
  SwapVectors;
  SaveExit := ExitProc;
  ExitProc := @ExitHandler;

  WriteLn('MARKNET ', Version, ', by TurboPower Software');

  {Assure supported version of DOS}
  ValidateDosVersion;

  {Assure mark file specified}
  if ParamCount = 0 then
    Abort('Usage: MARKNET NetMarkFile');

  {Find the device driver chain and the DOS internal table}
  FindDevChain;

  {Save PSP region of COMMAND.COM}
  BufferCommandPSP;

  {Buffer the DOS file table}
  BufferFileTable;

  {Open the mark file}
  MarkName := StUpcase(ParamStr(1));
  Assign(MarkF, MarkName);
  Rewrite(MarkF, 1);
  if IoResult <> 0 then
    Abort('Error creating '+MarkName);
  MarkFOpen := True;

  {Save ID string, interrupt vectors and other standard state information}
  SaveStandardInfo;

  {Save the device driver chain}
  SaveDevChain;

  {Save the DOS internal variables table}
  SaveDOSTable;

  {Save the DOS internal file management table}
  SaveFileTable;

  {Save the PSP of COMMAND.COM}
  SaveCommandPSP;

  {Save the location that NetWare may patch in COMMAND.COM}
  SaveCommandPatch;

  {Save the master copy of the DOS environment}
  SaveDosEnvironment;

  {Save the state of the communications controllers}
  SaveCommState;

  {Close mark file}
  Close(MarkF);
  CheckWriteError;

  {Move ID strings into place}
  SaveIDStrings;

  {Deallocate environment}
  with Regs do begin
    ES := MemW[PrefixSeg:$2C];
    AH := $49;
    MsDos(Regs);
  end;

  WriteLn('Stored mark information in ', MarkName);
  Flush(Output);

  {Close file handles}
  CloseStandardFiles;

  {Go resident}
  with Regs do begin
    dx := ($90+Length(MarkName)) shr 4;
    ax := $3100;
    MsDos(Regs);
  end;
end.