Category : Pascal Source Code
Archive   : TSRSRC33.ZIP
Filename : RELNET.PAS
* RELNET - releases memory above the last MARKNET call made. *
* Copyright (c) 1986,1991 Kim Kokkonen, TurboPower Software. *
* May be freely distributed and used but not sold except by permission. *
***************************************************************************
* Version 2.7 3/4/89 *
* first public release *
* (based on RELEASE 2.6) *
* Version 2.8 3/10/89 *
* restore the DOS environment *
* restore the async ports *
* Version 2.9 5/4/89 *
* ignore file marks *
* Version 3.0 9/25/91 *
* make compatible with DOS 5 *
* handle NetWare IPX better, allowing release of NETBIOS TSR *
* add Quiet option *
* update for new WATCH behavior *
* restore BIOS LPT port data areas *
* restore XMS allocation *
* add code for tracking high memory *
* Version 3.1 11/4/91 *
* restore less of DOS variables table (more deactivates high memory *
* after a release) *
* add option to disable IPX socket shutdown *
* Version 3.2 11/22/91 *
* version 3.1 crashed under DOS 3.3 (RestoreDosTable) *
* change method of accessing high memory *
* reverse order in which memory blocks are released to work *
* correctly with the 386MAX high memory manager *
* merge blocks in high memory after release (QEMM doesn't) *
* Version 3.3 1/8/92 *
* 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 6 to compile. *
***************************************************************************}
{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 16384,0,655360}
{.$DEFINE Debug}
program RelNet;
uses
Dos,
MemU,
Ipx,
Xms,
Ems;
const
MarkFOpen : Boolean = False; {True while mark file is open}
VectorsRestored : Boolean = False; {True after old vector table restored}
var
Blocks : BlockArray;
markBlock : BlockType;
BlockMax : BlockType;
markPsp : Word;
MarkName : PathStr;
ReturnCode : Word;
StartMCB : Word;
HiMemSeg : Word;
Revector8259 : Boolean;
DealWithIpx : Boolean;
DealWithEMS : Boolean;
DealWithXMS : Boolean;
KeepMark : Boolean;
RestoreEnvir : Boolean;
ResetTimer : Boolean;
RestoreComm : Boolean;
MemMark : Boolean;
FilMark : Boolean;
Verbose : Boolean;
Quiet : Boolean;
OptUseHiMem, UseHiMem : Boolean;
Keys : string[16];
MarkEHandles : Word;
CurrEHandles : Word;
MarkEmsHandles : PageArrayPtr;
CurrEmsHandles : PageArrayPtr;
TrappedBytes : LongInt;
MarkXHandles : Word;
CurrXHandles : Word;
MarkXmsHandles : XmsHandlesPtr;
CurrXmsHandles : XmsHandlesPtr;
{Save areas read in from file mark}
Vectors : array[0..1023] of Byte;
EGAsavTable : array[0..7] of Byte;
IntComTable : array[0..15] of Byte;
ParentSeg : Word;
ParentLen : Word;
BiosPrintTable : array[0..9] of Byte;
DevA : DeviceArray; {Temporary array of device headers}
DevCnt : Word; {Number of device headers}
CommandPsp : array[1..$100] of Byte; {Buffer for COMMAND.COM PSP}
DosData : array[1..$200] of Byte; {Buffer for DOS data area}
DosTableSize : Word;
DosTable : Pointer; {Dos internal variables}
FileTableA : array[1..5] of SftRecPtr; {Points to system file table buffers}
FileTableCnt : Word; {Number of system file table blocks}
FileRecSize : Word; {Bytes in internal DOS file record}
PatchOfst : Word; {Address of COMMAND.COM patch}
PatchSegm : Word;
EnvLen : Word; {Bytes in DOS environment}
EnvPtr : Pointer; {Pointer to copy of DOS environment}
PicMask : Byte; {8259 interrupt mask}
ComData : ComArray; {Communications data array}
McbG : McbGroup; {Allocated Mcbs}
TestPtr : DeviceHeaderPtr; {Test pointer while getting started on chain}
DevicePtr : DeviceHeaderPtr; {Pointer to the next device header}
DeviceSegment : Word; {Current device segment}
DeviceOffset : Word; {Current device offset}
MarkF : file; {Saved system information file}
DosPtr : ^DosRec; {Pointer to internal DOS variable table}
CommandSeg : Word; {Segment of primary COMMAND.COM}
procedure NoRestoreHalt(ReturnCode : Word);
{-Replace Turbo halt with one that doesn't restore any interrupts}
begin
if VectorsRestored then begin
Close(Output);
asm
mov ah,$4C
mov al,byte(ReturnCode)
int $21
end;
end else
System.Halt(ReturnCode);
end;
procedure RemoveMarkFile;
{-Close and remove the mark file}
begin
Close(MarkF);
if IoResult = 0 then
if not KeepMark then begin
Erase(MarkF);
if IoResult = 0 then ;
end;
MarkFOpen := False;
end;
procedure Abort(Msg : String);
{-Halt in case of error}
begin
if MarkFOpen then
RemoveMarkFile;
WriteLn(Msg);
Halt(255);
end;
function FindMark(MarkName, MarkID : String;
MarkOffset : Word;
var MemMark, FilMark : Boolean;
var B : BlockType) : Boolean;
{-Find the last memory block matching idstring at offset idoffset}
var
BPsp : Word;
function HasIDstring(Segment : Word;
IdString : String;
IdOffset : Word) : Boolean;
{-Return true if idstring is found at segment:idoffset}
var
Tstring : String;
Len : Byte;
begin
Len := Length(IdString);
Tstring[0] := Chr(Len);
Move(Mem[Segment:IdOffset], Tstring[1], Len);
HasIDstring := (Tstring = IdString);
end;
function GetMarkName(Segment : Word) : String;
{-Return a cleaned up mark name from the segment's PSP}
var
Tstring : String;
Tlen : Byte absolute Tstring;
begin
Move(Mem[Segment:$80], Tstring[0], 128);
while (Tlen > 0) and ((Tstring[1] = ' ') or (Tstring[1] = ^I)) do
Delete(Tstring, 1, 1);
while (Tlen > 0) and ((Tstring[Tlen] = ' ') or (Tstring[Tlen] = ^I)) do
Dec(Tlen);
GetMarkName := StUpcase(Tstring);
end;
function MatchMemMark(Segment : Word;
MarkName : String;
var B : BlockType) : Boolean;
{-Return true if MemMark is unnamed or matches current name}
var
FoundIt : Boolean;
Tstring : String;
begin
{Check the mark name stored in the PSP of the mark block}
Tstring := GetMarkName(Segment);
FoundIt := (Tstring = MarkName);
if not FoundIt then begin
if (Tstring <> '') and (Tstring[1] = ProtectChar) then
{Current mark is protected, stop searching}
B := 1;
Dec(B);
end;
MatchMemMark := FoundIt;
end;
function MatchFilMark(Segment : Word;
MarkName : String;
var B : BlockType) : Boolean;
{-Return true if FilMark is unnamed or matches current name}
var
FoundIt : Boolean;
begin
{Check the mark name stored in the PSP of the mark block}
FoundIt := (GetMarkName(Segment) = MarkName);
if FoundIt then begin
{Assure named file exists}
if Verbose then
WriteLn('Finding mark file ', MarkName);
FoundIt := ExistFile(MarkName);
end;
if not FoundIt then
{Net marks are protected marks; stop checking if non-match found}
B := 0;
MatchFilMark := FoundIt;
end;
function MatchExactFilMark(Segment : Word;
MarkName : String;
var B : BlockType) : Boolean;
{-Return true if FilMark matches current name}
var
FoundIt : Boolean;
begin
{Check the mark name stored in the PSP of the mark block}
FoundIt := (GetMarkName(Segment) = MarkName);
if FoundIt then begin
{Assure named file exists}
if Verbose then
WriteLn('Finding mark file ', MarkName);
FoundIt := ExistFile(MarkName);
end;
if not FoundIt then
dec(B);
MatchExactFilMark := FoundIt;
end;
begin
B := BlockMax;
MemMark := False;
FilMark := False;
if UseHiMem then begin
{Scan for an exact match to the specified net mark}
repeat
BPsp := Blocks[B].Psp;
if (Blocks[B].Mcb+1 <> BPsp) or (BPsp = PrefixSeg) then
{Don't match any non-program block or this program}
Dec(B)
else if HasIDstring(BPsp, NmarkID, NmarkOffset) then
{A net mark}
FilMark := MatchExactFilMark(BPsp, MarkName, B)
else
{Not a net mark}
Dec(B);
until (B < 1) or FilMark;
end else begin
{Scan from the last block down to find the last MARK TSR}
repeat
BPsp := Blocks[B].Psp;
if (Blocks[B].Mcb+1 <> BPsp) or (BPsp = PrefixSeg) then
{Don't match any non-program block or this program}
Dec(B)
else if HasIDstring(BPsp, MarkID, MarkOffset) then
{An in-memory mark}
MemMark := MatchMemMark(BPsp, MarkName, B)
else if HasIDstring(BPsp, NmarkID, NmarkOffset) then
{A net mark}
FilMark := MatchFilMark(BPsp, MarkName, B)
else
{Ignore normal file marks}
{Not a mark}
Dec(B);
until (B < 1) or MemMark or FilMark;
end;
FindMark := MemMark or FilMark;
end;
procedure CheckReadError;
{-Check previous I/O operation}
begin
if IoResult = 0 then
Exit;
Abort('Error reading '+MarkName);
end;
function PhysicalAddress(P : Pointer) : LongInt;
begin
PhysicalAddress := LongInt(OS(P).S) shl 4+OS(P).O;
end;
procedure ValidateMarkFile;
{-Open mark file and assure it's valid}
type
IDArray = array[1..4] of Char;
var
ID : IDArray;
ExpectedID : IDArray;
begin
Assign(MarkF, MarkName);
Reset(MarkF, 1);
if IoResult <> 0 then
Abort('Mark file '+MarkName+' not found');
MarkFOpen := True;
{Check the ID at the start of the file}
ExpectedID := NetMarkID;
BlockRead(MarkF, ID, SizeOf(IDArray));
CheckReadError;
if ID <> ExpectedID then
Abort(MarkName+' is not a valid net mark file');
{Read the NUL device address}
BlockRead(MarkF, TestPtr, SizeOf(Pointer));
CheckReadError;
if PhysicalAddress(TestPtr) <> PhysicalAddress(DevicePtr) then begin
if Verbose then
WriteLn('Old NUL addr:', HexPtr(TestPtr),
' Current NUL addr:', HexPtr(DevicePtr));
Abort('Unexpected error. NUL device moved');
end;
end;
procedure BufferFileTable;
{-Read the file table from the mark file into memory}
type
SftRecStub =
record
Next : SftRecPtr;
Count : Word;
end;
var
I : Word;
Size : Word;
P : Pointer;
S : SftRecStub;
begin
BlockRead(MarkF, FileTableCnt, SizeOf(Word));
for I := 1 to FileTableCnt do begin
BlockRead(MarkF, S, SizeOf(SftRecStub));
Size := 6+S.Count*FileRecSize;
GetMem(FileTableA[I], Size);
P := FileTableA[I];
Move(S, P^, SizeOf(SftRecStub));
Inc(OS(P).O, SizeOf(SftRecStub));
BlockRead(MarkF, P^, Size-SizeOf(SftRecStub));
end;
CheckReadError;
end;
procedure ReadReg(var B : Byte);
{-Read a communications register from the mark file}
begin
BlockRead(MarkF, B, SizeOf(Byte));
CheckReadError;
end;
procedure ReadMarkFile;
{-Read the mark file info into memory}
var
DevPtr : DeviceHeaderPtr;
Com : Byte;
begin
{Read the vector table from the mark file, into a temporary memory area}
BlockRead(MarkF, Vectors, 1024);
CheckReadError;
{Read the BIOS miscellaneous save areas into temporary tables}
BlockRead(MarkF, EGAsavTable, 8);
BlockRead(MarkF, IntComTable, 16);
BlockRead(MarkF, ParentSeg, 2);
BlockRead(MarkF, ParentLen, 2);
BlockRead(MarkF, BiosPrintTable, 10);
CheckReadError;
{Read the stored EMS handles, if any}
BlockRead(MarkF, MarkEHandles, SizeOf(Word));
GetMem(MarkEmsHandles, SizeOf(HandlePageRecord)*MarkEHandles);
BlockRead(MarkF, MarkEmsHandles^, SizeOf(HandlePageRecord)*MarkEHandles);
CheckReadError;
{Read the stored XMS handles, if any}
BlockRead(MarkF, MarkXHandles, SizeOf(Word));
GetMem(MarkXmsHandles, SizeOf(XmsHandleRecord)*MarkXHandles);
BlockRead(MarkF, MarkXmsHandles^, SizeOf(XmsHandleRecord)*MarkXHandles);
CheckReadError;
{Read the device driver chain}
DevPtr := DevicePtr;
DevCnt := 0;
while OS(DevPtr).O <> $FFFF do begin
Inc(DevCnt);
GetMem(DevA[DevCnt], SizeOf(DeviceHeader));
BlockRead(MarkF, DevA[DevCnt]^, SizeOf(DeviceHeader));
CheckReadError;
with DevA[DevCnt]^ do
DevPtr := Ptr(NextHeaderSegment, NextHeaderOffset);
end;
{Read the DOS data area table}
BlockRead(MarkF, DosData, $200);
CheckReadError;
{Read the DOS internal variables table}
BlockRead(MarkF, DosTableSize, SizeOf(Word));
if DosTableSize <> 0 then begin
GetMem(DosTable, DosTableSize);
BlockRead(MarkF, DosTable^, DosTableSize);
end;
CheckReadError;
{Read the internal file table}
BufferFileTable;
{Read in the copy of COMMAND.COM's PSP}
BlockRead(MarkF, CommandPsp, $100);
CheckReadError;
{Read in the address used for COMMAND.COM patching by NetWare}
BlockRead(MarkF, PatchOfst, SizeOf(Word));
BlockRead(MarkF, PatchSegm, SizeOf(Word));
CheckReadError;
{Read in the DOS master environment}
BlockRead(MarkF, EnvLen, SizeOf(Word));
GetMem(EnvPtr, EnvLen);
BlockRead(MarkF, EnvPtr^, EnvLen);
CheckReadError;
{Read in the communications data area}
BlockRead(MarkF, PicMask, SizeOf(Byte));
CheckReadError;
for Com := 1 to 2 do
with ComData[Com] do begin
BlockRead(MarkF, Base, SizeOf(Word));
CheckReadError;
if Base <> 0 then begin
ReadReg(IERReg);
ReadReg(LCRReg);
ReadReg(MCRReg);
ReadReg(BRLReg);
ReadReg(BRHreg);
end;
end;
{Read in the allocated Mcb chain}
BlockRead(MarkF, McbG.Count, SizeOf(Word));
BlockRead(MarkF, McbG.Mcbs, 2*SizeOf(Word)*McbG.Count);
CheckReadError;
{Close and possibly erase mark file}
RemoveMarkFile;
end;
procedure RestoreCommState;
{-Restore the communications chips to their previous state}
var
Com : Byte;
begin
for Com := 1 to 2 do
with ComData[Com] do
if Base <> 0 then begin
Port[Base+IER] := IERReg; {Interrupt enable register}
NullJump;
Port[Base+MCR] := MCRReg; {Modem control register}
NullJump;
Port[Base+LCR] := LCRReg or $80; {Enable baud rate divisor registers}
NullJump;
Port[Base+BRL] := BRLReg; {Baud rate low}
NullJump;
Port[Base+BRH] := BRHReg; {Baud rate high}
NullJump;
Port[Base+LCR] := LCRReg; {Line control register}
NullJump;
end;
{Restore the interrupt mask}
Port[$21] := PicMask;
end;
procedure CopyVectors;
{-Put interrupt vectors back into table}
procedure Reset8259;
{-Reset the 8259 interrupt controller to its powerup state}
{-Interrupts assumed OFF prior to calling this routine}
function ATmachine : Boolean;
{-Return true if machine is AT class}
var
MachType : Byte absolute $FFFF : $000E;
begin
case MachType of
$F8, $FC : ATmachine := True;
else
ATmachine := False;
end;
end;
procedure Reset8259PC;
{-Reset the 8259 on a PC class machine}
begin
inline(
$E4/$21/ { in al,$21}
$88/$C4/ { mov ah,al}
$B0/$13/ { mov al,$13}
$E6/$20/ { out $20,al}
$B0/$08/ { mov al,8}
$E6/$21/ { out $21,al}
$B0/$09/ { mov al,9}
$E6/$21/ { out $21,al}
$88/$E0/ { mov al,ah}
$E6/$21 { out $21,al}
);
end;
procedure Reset8259AT;
{-Reset the 8259 interrupt controllers on an AT machine}
begin
inline(
$32/$C0/ { xor al,al }
$E6/$F1/ { out 0f1h,al ; Switch off an 80287 if necessary}
{Set up master 8259 }
$E4/$21/ { in al,21h ; Get current interrupt mask }
$8A/$E0/ { mov ah,al ; save it }
$B0/$11/ { mov al,11h }
$E6/$20/ { out 20h,al }
$EB/$00/ { jmp short $+2 }
$B0/$08/ { mov al,8 ; Set up main interrupt vector number}
$E6/$21/ { out 21h,al }
$EB/$00/ { jmp short $+2 }
$B0/$04/ { mov al,4 }
$E6/$21/ { out 21h,al }
$EB/$00/ { jmp short $+2 }
$B0/$01/ { mov al,1 }
$E6/$21/ { out 21h,al }
$EB/$00/ { jmp short $+2 }
$8A/$C4/ { mov al,ah }
$E6/$21/ { out 21h,al }
{Set up slave 8259 }
$E4/$A1/ { in al,0a1h ; Get current interrupt mask }
$8A/$E0/ { mov ah,al ; save it }
$B0/$11/ { mov al,11h }
$E6/$A0/ { out 0a0h,al }
$EB/$00/ { jmp short $+2 }
$B0/$70/ { mov al,70h }
$E6/$A1/ { out 0a1h,al }
$B0/$02/ { mov al,2 }
$EB/$00/ { jmp short $+2 }
$E6/$A1/ { out 0a1h,al }
$EB/$00/ { jmp short $+2 }
$B0/$01/ { mov al,1 }
$E6/$A1/ { out 0a1h,al }
$EB/$00/ { jmp short $+2 }
$8A/$C4/ { mov al,ah ; Reset previous interrupt state }
$E6/$A1 { out 0a1h,al }
);
end;
begin
if ATmachine then
Reset8259AT
else
Reset8259PC;
end;
begin
{Interrupts off}
IntsOff;
{Reset 8259 if requested}
if Revector8259 then
Reset8259;
{Reset the communications state if requested}
if RestoreComm then
RestoreCommState;
{Restore the main interrupt vector table}
Move(Vectors, Mem[0:0], 1024);
{Interrupts on}
IntsOn;
{Flag that we don't want system restoring vectors for us}
VectorsRestored := True;
Move(EGAsavTable, Mem[$40:$A8], 8); {EGA table}
Move(IntComTable, Mem[$40:$F0], 16); {Interapplications communication area}
{$IFDEF Debug}
writeln('Parent address: ', HexW(ParentSeg), ' Length: ', ParentLen);
{$ENDIF}
if ValidPsp(HiMemSeg, ParentSeg, ParentLen) then
{Don't restore parent if it no longer exists (applies to QEMM LOADHI)}
MemW[PrefixSeg:$16] := ParentSeg;
Move(BiosPrintTable, Mem[$40:$08], 10); {BIOS Printer Table}
if not UseHiMem then
{Programs loaded into high memory have strange termination addresses}
Move(Mem[0:$88], Mem[PrefixSeg:$0A], 12); {Int 22,23,24 addresses}
end;
procedure MarkBlocks(markBlock : BlockType);
{-Mark those blocks to be released}
procedure BatchWarning(B : BlockType);
{-Warn about the trapping effect of batch files}
var
T : BlockType;
begin
ReturnCode := 1;
{Accumulate number of bytes temporarily trapped}
for T := 1 to B do
if Blocks[T].ReleaseIt then
Inc(TrappedBytes, LongInt(MemW[Blocks[T].Mcb:3]) shl 4);
end;
procedure MarkBlocksAbove;
{-Mark blocks above the mark}
var
b : BlockType;
begin
for b := 1 to BlockMax do
with Blocks[b] do
if (b >= markBlock) and (psp = CommandSeg) then begin
{Don't release blocks owned by master COMMAND.COM}
releaseIt := False;
BatchWarning(b);
end else if KeepMark then
{Release all but RELEASE and the mark}
releaseIt := (psp <> PrefixSeg) and (psp > markPsp)
else
releaseIt := (psp <> PrefixSeg) and (psp >= markPsp);
end;
procedure MarkUnallocatedBlocks;
{-Mark blocks that weren't allocated at time of mark}
var
TopSeg : Word;
b : BlockType;
m : BlockType;
Found : Boolean;
begin
{Find last low memory mcb}
TopSeg := TopOfMemSeg-1;
m := 1;
Found := False;
while (not Found) and (m <= McbG.Count) do
if McbG.Mcbs[m].mcb >= TopSeg then
Found := True
else
inc(m);
{Mark out all mcbs associated with psp of last low memory mcb}
TopSeg := McbG.Mcbs[m-1].psp;
if TopSeg <> markPsp then
for m := 1 to McbG.Count do
with McbG.Mcbs[m] do
if psp = TopSeg then
psp := 0;
for b := 1 to BlockMax do
with Blocks[b] do begin
Found := False;
m := 1;
while (not Found) and (m <= McbG.Count) do begin
Found := (McbG.Mcbs[m].psp <> 0) and (McbG.Mcbs[m].mcb = mcb);
inc(m);
end;
if Found then
{was allocated at time of mark, keep it now unless a mark to be released}
releaseIt := not KeepMark and (psp = markPsp)
else if psp = CommandSeg then
{Don't release blocks owned by master COMMAND.COM}
releaseIt := False
else
{not allocated at time of mark}
releaseIt := (psp <> 0) and (psp <> PrefixSeg);
end;
end;
begin
if UseHiMem then
MarkUnallocatedBlocks
else
MarkBlocksAbove;
{$IFDEF Debug}
for b := 1 to BlockMax do
with Blocks[b] do
WriteLn(b:3, ' ', HexW(psp), ' ', HexW(mcb), ' ', releaseIt);
{$ENDIF}
end;
function ReleaseBlock(Segm : Word) : Word; assembler;
{-Use DOS services to release memory block}
asm
mov ah,$49
mov es,Segm
int $21
jc @Done
xor ax,ax
@Done:
end;
procedure ReleaseMem;
{-Release DOS memory marked for release}
var
b : BlockType;
begin
if Verbose then begin
WriteLn('Releasing DOS memory');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
for b := BlockMax downto 1 do
with blocks[b] do
if releaseIt then
if ReleaseBlock(mcb+1) <> 0 then begin
WriteLn('Could not release block at segment ', HexW(mcb+1));
Abort('Memory may be a mess... Please reboot');
end;
if Verbose then begin
WriteLn('Merging free blocks in high memory');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
MergeHiMemBlocks(HiMemSeg);
end;
procedure RestoreEMSmap;
{-Restore EMS to state at time of mark}
var
O, N, NHandle : Word;
procedure EmsError;
begin
WriteLn('Program error or EMS device not responding');
Abort('EMS memory may be a mess... Please reboot');
end;
begin
{Get the existing EMS page map}
GetMem(CurrEmsHandles, MaxHandles*SizeOf(HandlePageRecord));
CurrEHandles := EmsHandles(CurrEmsHandles^);
if CurrEHandles > MaxHandles then
WriteLn('EMS handle count exceeds capacity of RELNET -- no action taken')
else if CurrEHandles <> 0 then begin
{See how many handles were active when MARK was installed}
if Verbose then begin
WriteLn('Releasing EMS memory allocated since MARK');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
{Compare the two maps and deallocate pages not in the stored map}
for N := 1 to CurrEHandles do begin
{Scan all current handles}
NHandle := CurrEmsHandles^[N].Handle;
if MarkEHandles > 0 then begin
{See if current handle matches one stored by MARK}
O := 1;
while (MarkEmsHandles^[O].Handle <> NHandle) and (O <= MarkEHandles) do
Inc(O);
{If not, deallocate the current handle}
if (O > MarkEHandles) then
if not FreeEms(NHandle) then
EmsError;
end else
{No handles stored by MARK, deallocate all current handles}
if not FreeEms(NHandle) then
EmsError;
end;
end;
end;
procedure RestoreXmsmap;
{-Restore Xms to state at time of mark}
var
O, N, NHandle : Word;
procedure XmsError;
begin
WriteLn('Program error or XMS device not responding');
Abort('XMS memory may be a mess... Please reboot');
end;
begin
CurrXHandles := GetXmsHandles(CurrXmsHandles);
if CurrXHandles <> 0 then begin
{See how many handles were active when MARK was installed}
if Verbose then begin
WriteLn('Releasing XMS memory allocated since MARK');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
if MarkXHandles = 0 then begin
{Release all current XMS Handles}
for N := 1 to CurrXHandles do
if FreeExtMem(CurrXmsHandles^[N].Handle) <> 0 then
XmsError;
end else begin
{Compare the two maps and deallocate pages not in the stored map}
for N := 1 to CurrXHandles do begin
{Scan all current handles}
NHandle := CurrXmsHandles^[N].Handle;
{See if current handle matches one stored by MARK}
O := 1;
while (MarkXmsHandles^[O].Handle <> NHandle) and (O <= MarkXHandles) do
Inc(O);
{If not, deallocate the current handle}
if (O > MarkXHandles) then
if FreeExtMem(NHandle) <> 0 then
XmsError;
end;
end;
end;
end;
procedure GetOptions;
{-Analyze command line for options}
procedure WriteCopyright;
begin
WriteLn('RELNET ', Version, ', Copyright 1991 TurboPower Software');
end;
procedure WriteHelp;
{-Show the options}
begin
WriteCopyright;
WriteLn;
WriteLn('RELNET removes memory-resident programs from memory, particularly network');
WriteLn('shells like Novell''s NetWare, although it will also release normal memory');
WriteLn('resident programs. In combination with MARKNET it thoroughly restores the');
WriteLn('system to its state at the time MARKNET was called.');
WriteLn;
WriteLn('RELNET accepts the following command line syntax:');
WriteLn;
WriteLn(' RELNET NetMarkFile [Options]');
WriteLn;
WriteLn('Options may be preceded by either / or -. Valid options are:');
WriteLn;
WriteLn(' /C do NOT restore communications state.');
WriteLn(' /E do NOT access EMS memory.');
WriteLn(' /H work with upper memory if available.');
WriteLn(' /I do NOT shut down IPX events and sockets.');
WriteLn(' /K release memory, but keep the mark in place.');
WriteLn(' /P do NOT restore DOS environment.');
WriteLn(' /Q write no screen output.');
WriteLn(' /R revector 8259 interrupt controller to powerup state.');
WriteLn(' /S chars stuff string (<16 chars) into keyboard buffer on exit.');
WriteLn(' /T do NOT reset system timer chip to default rate.');
WriteLn(' /U work with upper memory, but halt if none found.');
WriteLn(' /V verbose: show each step of the restore.');
WriteLn(' /X do NOT access XMS memory.');
WriteLn(' /? write this help screen.');
Halt(1);
end;
procedure GetArgs(S : String);
var
SPos : 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);
2 : case Upcase(Arg[2]) of
'C' : RestoreComm := False;
'E' : DealWithEMS := False;
'H' : OptUseHiMem := True;
'I' : DealWithIPX := False;
'K' : KeepMark := True;
'P' : RestoreEnvir := False;
'Q' : Quiet := True;
'R' : Revector8259 := True;
'S' : begin
Arg := NextArg(S, SPos);
if Length(Arg) = 0 then
Abort('Key string missing');
if Length(Arg) > 15 then
Abort('No more than 15 keys may be stuffed');
Keys := Arg+^M;
end;
'T' : ResetTimer := False;
'U' : UseHiMem := True;
'V' : Verbose := True;
'X' : DealWithXMS := False;
'?' : WriteHelp;
else
Abort('Unknown command option: '+Arg);
end;
else
Abort('Unknown command option: '+Arg);
end
else if Length(MarkName) = 0 then
{Mark file}
MarkName := StUpcase(Arg)
else
Abort('Too many mark files specified');
until False;
end;
begin
{Initialize defaults}
MarkName := '';
Keys := '';
Revector8259 := False;
KeepMark := False;
DealWithIPX := True;
DealWithEMS := True;
DealWithXMS := True;
ResetTimer := True;
Verbose := False;
Quiet := False;
RestoreEnvir := True;
RestoreComm := True;
UseHiMem := False;
OptUseHiMem := False;
ReturnCode := 0;
TrappedBytes := 00;
{Get arguments from the command line and the environment}
GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
GetArgs(GetEnv('RELNET'));
if Length(MarkName) = 0 then begin
WriteLn('No mark file specified');
WriteHelp;
end;
if Verbose then
Quiet := False;
if not Quiet then
WriteCopyright;
{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');
end else
UseHiMem := True;
end else
HiMemSeg := 0;
end;
function MemoryRelease(P : Pointer) : Boolean;
{-Return True if address P is in a block to be released}
var
B : BlockType;
PL : LongInt;
PSPL : LongInt;
begin
PL := PhysicalAddress(P);
for B := 1 to BlockMax do
with Blocks[B] do
if ReleaseIt then begin
PSPL := LongInt(Psp) shl 4;
if (PL >= PSPL) and (PL < PSPL+LongInt(MemW[Mcb:3]) shl 4) then begin
MemoryRelease := True;
Exit;
end;
end;
MemoryRelease := False;
end;
procedure CloseIpxSockets;
const
Retf : Byte = $CB; {Return instruction}
var
This, Next : IpxEcbPtr;
Ecb : IpxEcb;
Status : Byte;
begin
{Create a new Ecb to find start of linked list of Ecb's}
FillChar(Ecb, SizeOf(IpxEcb), 0);
Ecb.EsrAddress := @RetF;
ScheduleSpecialEvent(182, Ecb);
{Scan the list of Ecb's}
This := Ecb.Link;
while This <> nil do begin
if Verbose then
Write('Ecb: ', HexPtr(This),
' Esr: ', HexPtr(This^.EsrAddress),
' InUse: ', HexW(This^.InUse),
' Socket: ', HexW(This^.SocketNumber));
Next := This^.Link;
if MemoryRelease(This) or MemoryRelease(This^.ESRAddress) then
{Memory of this Ecb will be released}
if This^.InUse <> 0 then begin
{This Ecb is in use}
Status := CancelEvent(This^);
if Verbose then
Write(' [cancelled]');
if This^.SocketNumber <> 0 then begin
CloseSocket(This^.SocketNumber);
if Verbose then
Write(' [closed]');
end;
end;
if Verbose then
Writeln;
This := Next;
end;
{Cancel the special event we started}
Status := CancelEvent(Ecb);
end;
procedure FindDevChain;
{-Return segment, offset and pointer to NUL device}
begin
DosPtr := Ptr(OS(DosList).S, OS(DosList).O-2);
DevicePtr := @DosPtr^.NullDevice;
DeviceSegment := OS(DevicePtr).S;
DeviceOffset := OS(DevicePtr).O;
end;
procedure RestoreDosTable;
{-Restore the DOS variables table, except for the buffer pointer}
type
ByteArray = array[0..32767] of Byte;
ByteArrayPtr = ^ByteArray;
var
DosBase : Pointer;
SPtr : Pointer;
DPtr : Pointer;
begin
if Verbose then begin
WriteLn('Restoring DOS data area at 0050:0000');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
DPtr := Ptr($50, 0);
Move(DosData, DPtr^, $200);
DosBase := Ptr(OS(DosPtr).S, 0);
if Verbose then begin
WriteLn('Restoring ', DosTableSize,
' bytes of DOS variables table at ', HexPtr(DosBase));
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
{patch up DosTable to reflect current items that must be maintained}
{CachePtr}
SPtr := @DosPtr^.CachePtr;
DPtr := @ByteArrayPtr(DosTable)^[Ofs(DosPtr^.CachePtr)];
{$IFDEF Debug}
writeln('cacheptr ', hexptr(sptr), '->', hexptr(dptr), ' ', SizeOf(Pointer));
{$ENDIF}
move(SPtr^, DPtr^, SizeOf(Pointer));
if DosV = 5 then begin
{Other unknown areas}
SPtr := Ptr(OS(DosPtr).S, OS(DosPtr).O+SizeOf(DosRec));
DPtr := @ByteArrayPtr(DosTable)^[OS(DosPtr).O+SizeOf(DosRec)];
{$IFDEF Debug}
writeln('unknown ', hexptr(sptr), '->', hexptr(dptr), ' ',
OS(DosPtr^.FirstSFT).O-OS(DosPtr).O-SizeOf(DosRec)-$3C);
{$ENDIF}
move(SPtr^, DPtr^, OS(DosPtr^.FirstSFT).O-OS(DosPtr).O-SizeOf(DosRec)-$3C);
end;
{Restore DOS table}
move(DosTable^, DosBase^, DosTableSize);
end;
procedure RestoreFileTable;
{-Copy the internal file table from our memory buffer to its DOS location}
var
S : SftRecPtr;
I : Word;
begin
S := DosPtr^.FirstSFT;
if Verbose then begin
WriteLn('Restoring DOS file table at ', HexPtr(S));
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
for I := 1 to FileTableCnt do begin
Move(FileTableA[I]^, S^, 6+FileTableA[I]^.Count*FileRecSize);
S := S^.Next;
end;
end;
procedure RestoreDeviceDrivers;
{-Restore the device driver chain to its original state}
var
D : Word;
DevPtr : DeviceHeaderPtr;
begin
if Verbose then begin
WriteLn('Restoring device driver chain');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
DevPtr := DevicePtr;
for D := 1 to DevCnt do begin
DevPtr^ := DevA[D]^;
with DevA[D]^ do
DevPtr := Ptr(NextHeaderSegment, NextHeaderOffset);
end;
end;
procedure RestoreCommandPSP;
{-Copy COMMAND.COM's PSP back into place}
var
PspPtr : Pointer;
begin
PspPtr := Ptr(CommandSeg, 0);
if Verbose then begin
WriteLn('Restoring COMMAND.COM PSP at ', HexPtr(PspPtr));
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
Move(CommandPsp, PspPtr^, $100);
end;
procedure RestoreCommandPatch;
{-Restore the patch that NetWare applies to COMMAND.COM}
begin
if (PatchSegm <> 0) or (PatchOfst <> 0) then
if (Mem[PatchSegm:PatchOfst+$01] <> Byte('/')) or
(Mem[PatchSegm:PatchOfst+$11] <> Byte('/')) then begin
if Verbose then begin
WriteLn('Removing patch at ', HexW(PatchSegm), ':', HexW(PatchOfst));
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
Mem[PatchSegm:PatchOfst+$01] := Byte('/');
Mem[PatchSegm:PatchOfst+$11] := Byte('/');
end;
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 RestoreDosEnvironment;
{-Restore the master copy of the DOS environment}
var
EnvSeg : Word;
CurLen : Word;
P : Pointer;
begin
if RestoreEnvir then begin
FindEnv(CommandSeg, EnvSeg, CurLen);
if CurLen <> EnvLen then
Abort('Environment length changed');
if Verbose then begin
WriteLn('Restoring DOS environment, ', EnvLen, ' bytes at ', HexW(EnvSeg), ':0000');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
P := Ptr(EnvSeg, 0);
move(EnvPtr^, P^, EnvLen);
end;
end;
procedure SetTimerRate(Rate : Word);
{-Program system 8253 timer number 0 to run at specified rate}
begin
IntsOff;
Port[$43] := $36;
NullJump;
Port[$40] := Lo(Rate);
NullJump;
Port[$40] := Hi(Rate);
IntsOn;
end;
procedure RestoreTimer;
{-Set the system timer to its normal rate}
begin
if Verbose then begin
WriteLn('Restoring system timer to normal rate');
{$IFDEF Debug}
ReadLn;
{$ENDIF}
end;
SetTimerRate(0);
end;
function CompaqDOS30 : Boolean; assembler;
{-Return true if Compaq DOS 3.0}
asm
mov ah,$34
int $21
cmp bx,$019C
mov al,1
jz @Done
dec al
@Done:
end;
procedure ValidateDosVersion;
{-Assure supported version of DOS and compute size of DOS internal filerec}
var
DosVer : Word;
begin
DosVer := DosVersion;
case Hi(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, 5 : FileRecSize := 59;
else
Abort('Requires DOS 3, 4, or 5');
end;
end;
begin
{Assure supported version of DOS}
ValidateDosVersion;
{Analyze command line for options}
GetOptions;
{Find the start of the device driver chain via the NUL device}
FindDevChain;
{Get all allocated memory blocks in normal memory}
FindTheBlocks(HiMemSeg, Blocks, BlockMax, StartMcb, CommandSeg);
{Find the block marked with the MARK idstring, and MarkName if specified}
if not(FindMark(MarkName, MarkID, MarkOffset, MemMark, FilMark, markBlock)) then
Abort('No matching marker found, or protected marker encountered.');
if MemMark then
Abort('Marker must have been placed by MARKNET');
markPsp := Blocks[markBlock].psp;
{Open and validate the mark file}
ValidateMarkFile;
{Close IPX sockets and cancel IPX ECBs}
if DealWithIpx then
if IpxInstalled then
CloseIpxSockets;
{Get file mark information into memory}
ReadMarkFile;
{Mark those blocks to be released}
MarkBlocks(markBlock);
{Copy the vector table from the MARK copy}
CopyVectors;
{Restore the device driver chain}
RestoreDeviceDrivers;
{Restore the COMMAND.COM patch possibly made by NetWare}
RestoreCommandPatch;
{Restore the DOS variables table}
RestoreDosTable;
{Restore the DOS file table}
RestoreFileTable;
{Restore the COMMAND.COM PSP}
RestoreCommandPSP;
{Restore the master DOS environment}
RestoreDosEnvironment;
{Set the timer to normal rate}
if ResetTimer then
RestoreTimer;
(*
this isn't necessary, and in fact is harmful, when the DOS file table
is being restored above.
{Close open file handles}
CloseHandles;
*)
{Release normal memory}
ReleaseMem;
{Deal with expanded memory}
if DealWithEMS then
if EMSpresent then
RestoreEMSmap;
{Deal with extended memory}
if DealWithXMS then
if XMSInstalled then
RestoreXMSMap;
{Write success message}
if not Quiet then
WriteLn('Memory released after ', StUpcase(MarkName));
if (ReturnCode <> 0) and Verbose then
WriteLn(TrappedBytes, ' bytes temporarily trapped until batch file completes');
{Stuff keyboard buffer if requested}
if Length(Keys) > 0 then
StuffKeys(Keys, True);
NoRestoreHalt(ReturnCode);
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/