Category : Pascal Source Code
Archive   : TSRSRC33.ZIP
Filename : DISABLE.PAS
* 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 *
* Version 3.1 11/4/91 *
* update for new WATCH detection method *
* Version 3.2 11/22/91 *
* change method of accessing high memory *
* Version 3.3 1/8/92 *
* find TSRs by name just like MAPMEM does *
* increase stack space *
* add /H to use high memory optionally *
* new features for parsing and getting command line options *
***************************************************************************
* telephone: 719-260-6641, CompuServe: 76004,2611. *
* requires Turbo Pascal version 6 to compile. *
***************************************************************************}
{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 4096,0,655360}
{.$DEFINE MeasureStack} {Activate to measure stack usage}
program DisableTSR;
{-Deactivate and reactivate memory resident programs}
{-Leaving them in memory all the while}
uses
Dos,
MemU;
var
Blocks : BlockArray;
BlockMax : BlockType;
WatchPsp : Word;
CommandSeg : Word;
HiMemSeg : Word;
Changes : ChangeArray;
ChangeMax, ActualMax, PspHex, StartMCB : Word;
Action : (aDeactivate, aActivate, aCheckFor);
Override : Boolean;
Quiet : Boolean;
OptUseHiMem, UseHiMem : Boolean;
TsrName : PathStr;
{$IFDEF MeasureStack}
I : Word;
{$ENDIF}
procedure Abort(msg : String; ErrorLevel : Byte);
{-Halt in case of error}
begin
WriteLn(msg);
Halt(ErrorLevel);
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 UseHiMem option}
var
Arg : String[127];
procedure GetArgs(S : String);
var
SPos : Word;
begin
SPos := 1;
repeat
Arg := StUpcase(NextArg(S, SPos));
if Arg = '' then
Exit;
if (Arg = '-U') or (Arg = '/U') then
UseHiMem := True
else if (Arg = '-H') or (Arg = '/H') then
OptUseHiMem := True;
until False;
end;
begin
UseHiMem := False;
OptUseHiMem := False;
{Get arguments from the command line and the environment}
GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
GetArgs(GetEnv('DISABLE'));
end;
procedure GetOptions;
{-Analyze command line for options}
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(' /H work with upper memory if available.');
WriteLn(' /O disable the TSR even if dangerous.');
WriteLn(' /Q write no screen output.');
WriteLn(' /U work with upper memory, but halt if none found.');
WriteLn(' /? write this help screen.');
Halt(1);
end;
function FindOwner(tname : String) : Word;
{-Return segment of executable block with specified name}
var
b : BlockType;
IsCmd : Boolean;
M : McbPtr;
Name : String[79];
begin
tname := StUpcase(tname);
{Scan the blocks in reverse order}
for b := BlockMax downto 1 do
with Blocks[b] do
if Succ(mcb) = psp then begin
{This block is an executable block}
IsCmd := (Psp = MemW[Psp:$16]);
M := Ptr(Mcb, 0);
if (not IsCmd) and (DosV > 2) and HasEnvironment(HiMemSeg, M) then
Name := NameFromEnv(M)
else if DosV >= 4 then
Name := NameFromMcb(M)
else if (not IsCmd) and (DosVT >= $031E) then
Name := NameFromMcb(M)
else
Name := '';
if StUpcase(Name) = tname then begin
FindOwner := Psp;
Exit;
end;
end;
FindOwner := $FFFF;
end;
procedure GetArgs(S : String);
var
SPos : Word;
Code : Word;
Arg : String[127];
begin
SPos := 1;
repeat
Arg := NextArg(S, SPos);
if Arg = '' then
Exit;
if (Arg[1] = '?') then
WriteHelp
else if (Arg[1] = '-') or (Arg[1] = '/') then
case Length(Arg) 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;
'H' : ; {ignore, but allow, here}
'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;
until False;
end;
begin
{Initialize defaults}
PspHex := 0;
Action := aDeactivate;
Override := False;
Quiet := False;
{Get arguments from the command line and the environment}
GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
GetArgs(GetEnv('DISABLE'));
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
{$IFDEF MeasureStack}
FillChar(Mem[SSeg:0], SPtr-16, $AA);
{$ENDIF}
{Determine whether upper memory control is desired}
CheckUpperOption;
{Initialize for high memory access}
if OptUseHiMem or UseHiMem then begin
HiMemSeg := FindHiMemStart;
if HiMemSeg = 0 then begin
if UseHiMem then
Abort('No upper memory blocks found', 255);
end else
UseHiMem := True;
end else
HiMemSeg := 0;
{Get all allocated memory blocks in normal memory}
{Must do first to support TSRs by name in GetOptions}
FindTheBlocks(HiMemSeg, Blocks, BlockMax, StartMcb, CommandSeg);
{Analyze command line for options}
GetOptions;
{Find the watch block}
WatchPsp := WatchPspSeg;
if WatchPsp = 0 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;
{$IFDEF MeasureStack}
I := 0;
while I < SPtr-16 do
if Mem[SSeg:i] <> $AA then begin
writeln('Unused stack ', i, ' bytes');
I := SPtr;
end else
inc(I);
{$ENDIF}
end.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/