CD Actual 14/CDACTUAL.iso/cdactual/demobin/share/program/Pascal/TSRSRC30.ZIP/DISABLE.PAS

Pascal/Delphi Source File | 1991-10-15 | 17.5 KB | 563 lines

{**************************************************************************
*   DISABLE - Activates or deactivates TSRs.                              *
*   Copyright (c) 1987,1991 Kim Kokkonen, TurboPower Software.            *
*   May be freely distributed and used but not sold except by permission. *
***************************************************************************
*   version 2.3 5/4/87                                                    *
*     first release. version number matches other TSR Utilities           *
*   :                                                                     *
*   long intervening history                                              *
*   :                                                                     *
*   version 3.0 9/24/91                                                   *
*     update for DOS 5                                                    *
*     add Quiet option                                                    *
*     add support for high memory                                         *
***************************************************************************
*   telephone: [phone], CompuServe: 76004,2611.                      *
*   requires Turbo Pascal version 6 to compile.                           *
***************************************************************************}

{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 2048,0,655360}

program DisableTSR;
  {-Deactivate and reactivate memory resident programs}
  {-Leaving them in memory all the while}

uses
  Dos,
  MemU;

const
  Version = '3.0';

var
  Blocks : BlockArray;
  BlockMax : BlockType;
  WatchPsp : Word;
  CommandSeg : Word;
  Changes : ChangeArray;
  ChangeMax, ActualMax, PspHex, StartMCB : Word;
  Action : (aDeactivate, aActivate, aCheckFor);
  Override : Boolean;
  Quiet : Boolean;
  ShowHiMem : Boolean;
  UmbLinkStatus : Boolean;
  TsrName : PathStr;
  SaveExit : Pointer;
  Status : Word;

  procedure SafeExit; far;
  var
    Status : Word;
  begin
    ExitProc := SaveExit;
    if HiMemAvailable(DosV) then
      Status := SetUmbLinkStatus(UmbLinkStatus);
  end;

  procedure Abort(msg : String; ErrorLevel : Byte);
    {-Halt in case of error}
  begin
    WriteLn(msg);
    Halt(ErrorLevel);
  end;

  function HasIdString(Segment, Offset : Word; Id : String) : Boolean;
    {-Return True if Id appears at Segment:Offset}
  var
    P : ^String;
  begin
    P := Ptr(Segment, Offset);
    HasIdString := (P^ = Id);
  end;

  function FindWatch(var WatchPsp : Word) : Boolean;
    {-Find copy of WATCH.COM in memory}
  label
    ExitPoint;
  var
    Status : Word;
    M : McbPtr;
    Done : Boolean;
  begin
    {Access high memory if available}
    if HiMemAvailable(DosV) then
      Status := SetUmbLinkStatus(True);
    M := Mcb1;
    repeat
      if HasIdString(M^.Psp, WatchOfs, WatchId) then begin
        WatchPsp := M^.Psp;
        FindWatch:= True;
        goto ExitPoint;
      end;
      Done := (M^.Id = 'Z');
      M := Ptr(OS(M).S+M^.Len+1, 0);
    until Done;
    {Not found if we get here}
    FindWatch := False;
ExitPoint:
    if HiMemAvailable(DosV) then
      Status := SetUmbLinkStatus(ShowHiMem);
  end;

  function ExecutableBlock(PspHex : Word) : Boolean;
    {-Return true if psphex corresponds to an executable code block}
  var
    b : BlockType;
  begin
    for b := BlockMax downto 1 do
      {Search back to find executable rather than environment block}
      if Blocks[b].psp = PspHex then begin
        ExecutableBlock := True;
        Exit;
      end;
    ExecutableBlock := False;
  end;

  procedure InitChangeArray(WatchPsp : Word);
    {-Initialize information regarding the WATCH data block}
  var
    watchindex : Word;
    p : ^ChangeBlock;
  begin
    {Maximum offset in WATCH data area}
    ActualMax := MemW[WatchPsp:NextChange];

    {Transfer changes from WATCH into a buffer array}
    watchindex := 0;
    ChangeMax := 0;
    while watchindex < ActualMax do begin
      p := Ptr(WatchPsp, ChangeVectors+watchindex);
      Move(p^, Changes[ChangeMax], SizeOf(ChangeBlock));
      Inc(watchindex, SizeOf(ChangeBlock));
      if watchindex < ActualMax then
        inc(ChangeMax);
    end;
  end;

  procedure PutWatch(chg : ChangeBlock; var watchindex : Word);
    {-Put a change block back into WATCH}
  var
    p : ^ChangeBlock;
  begin
    p := Ptr(WatchPsp, ChangeVectors+watchindex);
    Move(chg, p^, SizeOf(ChangeBlock));
    Inc(watchindex, SizeOf(ChangeBlock));
  end;

  procedure ActivateTSR(PspHex : Word);
    {-Patch out the active interrupt vectors of a specified TSR}
  var
    nextchg, chg, watchindex : Word;
    checking, didsomething : Boolean;
  begin
    didsomething := False;
    watchindex := 0;
    chg := 0;

    {Scan looking for the specified PSP}
    while chg <= ChangeMax do begin
      with Changes[chg] do
        case ID of

          $FF :               {This record starts a new PSP}
            begin
              checking := (PspAdd = PspHex);
              nextchg := Succ(chg);
              if checking then
                {Turn off interrupts}
                inline($FA)
              else
                {Turn on interrupts}
                inline($FB);
            end;

          $01 :               {This record has an inactive vector redefinition}
            if checking then begin
              {We're in the proper PSP}
              didsomething := True;
              {Change the ID to indicate that vector is active}
              ID := 0;
              {Put the original vector code back in place}
              nextchg := Succ(chg);
              if (Changes[nextchg].ID <> 2) or (Changes[nextchg].VecNum <> VecNum) then
                Abort('Program error in Activate, patch record not found', 255);
              {Restore the patched over code}
              Move(Changes[nextchg].SaveCode, Mem[VecSeg:VecOfs], 6);
              {Don't output the following patch record}
              inc(nextchg);
            end else
              nextchg := Succ(chg);

        else
          nextchg := Succ(chg);
        end;

      {Put the change block back into WATCH}
      PutWatch(Changes[chg], watchindex);
      {Advance to the next change record}
      chg := nextchg;
    end;

    {Store the count back into WATCH}
    MemW[WatchPsp:NextChange] := watchindex;

    if not(didsomething) then
      Abort('No changes were needed to activate '+HexW(PspHex), 1);

  end;

  procedure DeactivateTSR(PspHex : Word);
    {-Patch out the active interrupt vectors of a specified TSR}
  var
    newchange : ChangeBlock;
    chg, watchindex, curpsp : Word;
    putrec, checking, didsomething : Boolean;

    procedure PutPatch(vecn : Byte; vecs, veco, curpsp : Word);
      {-Patch vector entry point with JMP to previous controlling vector}
    label
      ExitPoint;
    var
      vec : ^Word;
      chg : Word;
    begin
      {Get the original vector from WATCH}
      Move(Mem[WatchPsp:(OrigVectors+(vecn shl 2))], vec, 4);

      {Scan the Changes array to look for redefinition of this vector}
      for chg := 0 to ChangeMax do begin
        with Changes[chg] do
          case ID of
            0, 1 :            {This is or was a redefined vector}
              if vecn = VecNum then
                {It's the vector we're interested in}
                {Store the latest value of the vector}
                Move(VecOfs, vec, 4);
            $FF :             {This record starts a new PSP}
              if PspAdd = curpsp then
                {Stop when we get to the PSP that is being disabled}
                goto ExitPoint;
          end;
      end;
ExitPoint:
      {Patch the vector entry point into a JMP FAR vec}
      Mem[vecs:veco] := $EA;
      Move(vec, Mem[vecs:Succ(veco)], 4);
    end;

    function CountVecs(chg : Word) : Word;
      {-Return count of vectors taken over by the PSP starting at changeblock chg}
    var
      count : Word;
      ID : Byte;
    begin
      count := 0;
      repeat
        {Skip over the first one, which defines the current PSP}
        inc(chg);
        ID := Changes[chg].ID;
        if (ID = 0) and (chg <= ChangeMax) then
          inc(count);
      until (ID = $FF) or (chg >= ChangeMax);
      CountVecs := count;
    end;

    function ValidToPatch(chg : Word) : Boolean;
      {-Assure that there is space to place 6-byte patches}
    var
      First : Word;
      Next : Word;
      I : Word;
      J : Word;
      IAddr : LongInt;
      JAddr : LongInt;
    begin
      ValidToPatch := True;
      if Override then
        Exit;

      {First vector to patch}
      First := chg+1;

      {Last vector to patch}
      Next := First;
      while (Next <= ChangeMax) and (Changes[Next].ID <> $FF) do
        inc(Next);

      {Any to patch?}
      if Next = First then
        Exit;

      {Compare each pair to assure enough space for patch}
      for I := First to Next-1 do begin
        with Changes[I] do
          IAddr := (LongInt(VecSeg) shl 4)+VecOfs;
        for J := First to Next-1 do
          if I <> J then begin
            with Changes[J] do
              JAddr := (LongInt(VecSeg) shl 4)+VecOfs;
            if Abs(IAddr-JAddr) < 6 then begin
              ValidToPatch := False;
              Exit;
            end;
          end;
      end;
    end;

  begin

    {Scan looking for the specified PSP}
    didsomething := False;
    watchindex := 0;

    for chg := 0 to ChangeMax do begin
      putrec := True;
      with Changes[chg] do
        case ID of

          $FF :               {This record starts a new PSP}
            begin
              checking := (PspAdd = PspHex);
              if checking then begin
                {Store the current PSP}
                curpsp := PspAdd;
                {Make sure WATCH has room for the extra changes}
                if watchindex+(CountVecs(chg)*SizeOf(ChangeBlock)) >
                MaxChanges*SizeOf(ChangeBlock) then
                  Abort('Insufficient space in WATCH data area', 255);
                {Make sure the patches will be valid}
                if not ValidToPatch(chg) then
                  Abort('Insufficient space between vectors to patch TSR', 255);
                {Turn off interrupts}
                inline($FA);
              end else
                {Turn on interrupts}
                inline($FB);
            end;

          $00 :               {This record has an active vector redefinition}
            if checking then begin
              {We're in the proper PSP}
              didsomething := True;

              {Change the ID to indicate that vector is inactive}
              ID := 1;
              {Output the record now so that the new record can immediately follow}
              PutWatch(Changes[chg], watchindex);
              putrec := False;

              {Output a new change record so we can reactivate later}
              {Indicate this is a patch record}
              newchange.ID := 2;
              {Save which vector it goes with}
              newchange.VecNum := VecNum;
              {Save the code we'll patch over}
              Move(Mem[VecSeg:VecOfs], newchange.SaveCode, 6);
              {Output the record to the WATCH area}
              PutWatch(newchange, watchindex);
              {Patch in a JMP to the previous vector}
              PutPatch(VecNum, VecSeg, VecOfs, curpsp);
            end;

        end;
      if putrec then
        {Put the change block back into WATCH}
        PutWatch(Changes[chg], watchindex);
    end;

    {Store the count back into WATCH}
    MemW[WatchPsp:NextChange] := watchindex;

    if not(didsomething) then
      Abort('No changes were needed to deactivate '+tsrname, 1);

  end;

  procedure CheckUpperOption;
    {-Set ShowHiMem option}
  var
    arg : String[127];
    i : Word;
  begin
    ShowHiMem := False;
    for I := 1 to ParamCount do begin
      arg := StUpcase(ParamStr(i));
      if (arg = '-U') or (arg = '/U') then begin
        ShowHiMem := True;
        Exit;
      end;
    end;
  end;

  procedure GetOptions;
    {-Analyze command line for options}
  var
    arg : String[127];
    arglen : Byte absolute arg;
    i, code : Word;

    procedure WriteCopyright;
    begin
      WriteLn('DISABLE ', Version, ', Copyright 1991 TurboPower Software');
    end;

    procedure WriteHelp;
      {-Show the options}
    begin
      WriteCopyright;
      WriteLn;
      WriteLn('DISABLE allows you to selectively disable and reenable a TSR while leaving it');
      WriteLn('in memory. To run DISABLE, you must have previously installed the TSR utility');
      WriteLn('WATCH.');
      WriteLn;
      WriteLn('DISABLE is command-line driven. You specify a single TSR by its name (if you');
      WriteLn('are running DOS 3.0 or later) or by its address as determined from a MAPMEM');
      WriteLn('report. Addresses must be preceded by a dollar sign "$" and specified in hex.');
      WriteLn;
      WriteLn('DISABLE accepts the following command line syntax:');
      WriteLn;
      WriteLn('  DISABLE TSRname|$PSPaddress [Options]');
      WriteLn;
      WriteLn('Options may be preceded by either / or -. Valid options are as follows:');
      WriteLn;
      WriteLn('     /A     reactivate the specified TSR.');
      WriteLn('     /C     check whether TSR is installed.');
      WriteLn('     /O     disable the TSR even if dangerous (Override).');
      WriteLn('     /Q     write no screen output.');
      WriteLn('     /U     work with upper memory blocks (DOS 5).');
      WriteLn('     /?     write this help screen.');
      Halt(1);
    end;

    function FindOwner(name : String) : Word;
      {-Return segment of executable block with specified name}
    var
      b : BlockType;
    begin
      name := StUpcase(name);
      {Scan the blocks in reverse order}
      for b := BlockMax downto 1 do
        with Blocks[b] do
          if Succ(mcb) = psp then
            {This block is an executable block}
            if NameFromEnv(Ptr(mcb, 0)) = name then begin
              {Found it}
              FindOwner := psp;
              Exit;
            end else if DosV >= 5 then
              if NameFromMcb(Ptr(Mcb, 0)) = name then begin
                {Found it}
                FindOwner := psp;
                Exit;
              end;
      FindOwner := $FFFF;
    end;

  begin
    {Initialize defaults}
    PspHex := 0;
    Action := aDeactivate;
    Override := False;
    Quiet := False;

    i := 1;
    while i <= ParamCount do begin
      arg := ParamStr(i);
      if (arg[1] = '?') then
        WriteHelp
      else if (arg[1] = '-') or (arg[1] = '/') then
        case arglen of
          1 : Abort('Missing command option following '+arg, 254);
          2 : case UpCase(arg[2]) of
                '?' : WriteHelp;
                'A' : Action := aActivate;
                'C' : Action := aCheckFor;
                'E' : Action := aActivate;
                'O' : Override := True;
                'Q' : Quiet := True;
                'U' : ; {ignore, but allow, here}
              else
                Abort('Unknown command option: '+arg, 254);
              end;
        else
          Abort('Unknown command option: '+arg, 254);
        end
      else begin
        {TSR to change}
        if arg[1] = '$' then begin
          {Treat as hex address}
          Val(arg, PspHex, code);
          if code <> 0 then
            Abort('Invalid hex address specification: '+arg, 254);
        end else if DosV >= 3 then
          {Treat as PSP owner name - scan to find proper PSP}
          PspHex := FindOwner(arg)
        else
          Abort('Must have DOS 3.0+ to find TSRs by name', 254);
        TsrName := StUpcase(arg);
      end;
      inc(i);
    end;

    if not Quiet then
      WriteCopyright;
    if PspHex = 0 then
      Abort('No TSR name or address specified', 254)
    else if PspHex = $FFFF then
      Abort('No such TSR found', 2);
  end;

begin
  {Determine whether upper memory control is desired}
  CheckUpperOption;

  {Set up for high memory access}
  if HiMemAvailable(DosV) then begin
    UmbLinkStatus := GetUmbLinkStatus;
    Status := SetUmbLinkStatus(ShowHiMem);
    if ShowHiMem and (Status = 1) then
      Abort('To access high memory you must have DOS=,UMB in CONFIG.SYS', 255);
  end;
  SaveExit := ExitProc;
  ExitProc := @SafeExit;

  {Get all allocated memory blocks in normal memory}
  {Must do first to support TSRs by name in GetOptions}
  FindTheBlocks(Blocks, BlockMax, StartMcb, CommandSeg);

  {Analyze command line for options}
  GetOptions;

  {Find the watch block}
  if not FindWatch(WatchPsp) then
    Abort('WATCH must be installed in order to use DISABLE', 255);

  {Assure PspHex corresponds to an executable block}
  if not ExecutableBlock(PspHex) then
    Abort('No such TSR found', 2);

  {Initialize information regarding the WATCH data block}
  InitChangeArray(WatchPsp);

  {Activate or deactivate the TSR}
  case Action of
    aDeactivate:DeactivateTSR(PspHex);
    aActivate:ActivateTSR(PspHex);
  end;

  {Write success message}
  if not Quiet then begin
    case Action of
      aDeactivate:Write('Deactivated');
      aActivate:Write('Activated');
      aCheckFor:Write('Found');
    end;
    Write(' ');
    if TsrName[1] = '$' then
      Write('TSR at ');
    WriteLn(TsrName);
  end;
end.