Category : Pascal Source Code
Archive   : TSRSRC33.ZIP
Filename : MARKNET.PAS
* MARKNET - stores system information in a file for later restoration. *
* 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 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 *
* Version 3.0 7/21/91 *
* for compatibility with DOS 5 *
* add Quiet option *
* save BIOS LPT port data areas *
* save XMS allocation *
* add code for tracking high memory *
* Version 3.1 11/4/91 *
* no change *
* Version 3.2 11/22/91 *
* change method of accessing high memory *
* store parent's length as well as segment *
* Version 3.3 1/8/92 *
* 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 2048,0,10000}
{.$DEFINE Debug} {Activate for status messages}
{.$DEFINE MeasureStack} {Activate to measure stack usage}
program MarkNet;
uses
Dos,
MemU,
Xms,
Ems;
const
MarkFOpen : Boolean = False; {True while mark file is open}
Quiet : Boolean = False; {Set True to avoid screen output}
var
MarkName : PathStr; {Name of mark file}
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}
CommandSeg : Word; {PSP segment of primary COMMAND.COM}
CommandPsp : array[1..$100] of Byte;
FileTableA : array[1..5] of SftRecPtr;
FileTableCnt : Word;
FileRecSize : Word;
EHandles : Word; {For tracking EMS allocation}
EmsPages : ^PageArray;
XHandles : Word; {For tracking XMS allocation}
XmsPages : XmsHandlesPtr;
McbG : McbGroup; {Mcbs allocated as we go resident}
SaveExit : Pointer;
{$IFDEF MeasureStack}
I : Word;
{$ENDIF}
procedure ExitHandler; far;
{-Trap error exits (only)}
begin
ExitProc := SaveExit;
if MarkFOpen then begin
if IoResult = 0 then ;
Close(MarkF);
if IoResult = 0 then ;
Erase(MarkF);
end;
{Turbo will swap back, so undo what we've done already}
SwapVectors;
end;
procedure Abort(Msg : String);
{-Halt in case of error}
begin
WriteLn(Msg);
Halt(1);
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 CheckWriteError;
{-Check for errors writing to mark file}
begin
if IoResult = 0 then
Exit;
Abort('Error writing to '+MarkName);
end;
procedure SaveStandardInfo;
{-Save the ID string, the vectors, and so on}
type
IDArray = array[1..4] of Char;
var
PSeg : Word;
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 and length');
{$ENDIF}
PSeg := Mem[PrefixSeg:$16];
BlockWrite(MarkF, PSeg, 2); {Parent's PSP segment}
BlockWrite(MarkF, Mem[PSeg-1:3], 2); {Parent's PSP's length}
CheckWriteError;
{$IFDEF Debug}
WriteLn('Writing BIOS printer table');
{$ENDIF}
BlockWrite(MarkF, Mem[$40:$8], 10); {Printer ports plus #printers}
CheckWriteError;
{Write EMS information}
if EMSpresent then begin
if MaxAvail < 2048 then
Abort('Insufficient memory');
GetMem(EmsPages, 2048);
EHandles := EMSHandles(EmsPages^);
end else
EHandles := 0;
{$IFDEF Debug}
WriteLn('Writing EMS handle information');
{$ENDIF}
BlockWrite(MarkF, EHandles, SizeOf(Word));
if EHandles <> 0 then
BlockWrite(MarkF, EmsPages^, SizeOf(HandlePageRecord)*EHandles);
CheckWriteError;
{Write XMS information}
if XmsInstalled then
XHandles := GetXmsHandles(XmsPages)
else
XHandles := 0;
{$IFDEF Debug}
WriteLn('Writing XMS handle information');
{$ENDIF}
BlockWrite(MarkF, XHandles, SizeOf(Word));
if XHandles <> 0 then
BlockWrite(MarkF, XmsPages^, SizeOf(XmsHandleRecord)*XHandles);
CheckWriteError;
end;
procedure SaveDevChain;
{-Save the device driver chain}
begin
{$IFDEF Debug}
WriteLn('Saving device driver chain');
{$ENDIF}
while OS(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 OS(S).O <> $FFFF do begin
Inc(FileTableCnt);
Size := 6+S^.Count*FileRecSize;
if MaxAvail < Size then
Abort('Insufficient memory');
GetMem(FileTableA[FileTableCnt], Size);
Move(S^, FileTableA[FileTableCnt]^, Size);
S := S^.Next;
end;
end;
end;
procedure BufferAllocatedMcbs;
{-Save an array of all allocated Mcbs}
var
HiMemSeg : Word;
M : McbPtr;
procedure AddMcbs;
var
Done : Boolean;
begin
repeat
inc(McbG.Count);
with McbG.Mcbs[McbG.Count] do begin
mcb := OS(M).S;
psp := M^.Psp;
end;
Done := (M^.Id = 'Z');
M := Ptr(OS(M).S+M^.Len+1, 0);
until Done;
end;
begin
McbG.Count := 0;
M := Mcb1;
AddMcbs;
HiMemSeg := FindHiMemStart;
if HiMemSeg <> 0 then begin
M := Ptr(HiMemSeg, 0);
AddMcbs;
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(OS(DosPtr).S, 0);
Size := OS(DosPtr^.FirstSFT).O;
{$IFDEF Debug}
WriteLn('Saving DOS variables table at ', HexPtr(DosBase));
{$ENDIF}
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}
var
PspPtr : Pointer;
begin
CommandSeg := MasterCommandSeg;
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;
procedure SaveAllocatedMcbs;
{-Save list of allocated memory control blocks}
begin
{$IFDEF Debug}
WriteLn('Saving memory allocation group');
{$ENDIF}
{Save the number of Mcbs}
BlockWrite(MarkF, McbG.Count, SizeOf(Word));
CheckWriteError;
{Save the used Mcbs}
BlockWrite(MarkF, McbG.Mcbs, 2*SizeOf(Word)*McbG.Count);
CheckWriteError;
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;
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
for H := 0 to 4 do
asm
mov ah,$3E
mov bx,H
int $21
end;
end;
procedure GetOptions;
{-Get command line options}
var
Arg : String[127];
procedure UnknownOption;
begin
WriteLn('Unknown command line option: ', Arg);
Halt(1);
end;
procedure BadOption;
begin
WriteLn('Invalid command line option: ', Arg);
Halt(1);
end;
procedure WriteCopyright;
begin
WriteLn('MARKNET ', Version, ', Copyright 1991 TurboPower Software');
end;
procedure WriteHelp;
begin
WriteCopyright;
WriteLn;
WriteLn('MARKNET saves a picture of the PC system status in a file,');
WriteLn('so that the state can later be restored by using RELNET.');
WriteLn;
WriteLn('MARKNET accepts the following command line syntax:');
WriteLn;
WriteLn(' MARKNET [Options] MarkFile');
WriteLn;
WriteLn('Options may be preceded by either / or -. Valid options are as follows:');
WriteLn(' /Q write no screen output.');
WriteLn(' /? write this help screen.');
Halt(1);
end;
procedure GetArgs(S : String);
var
SPos : Word;
begin
SPos := 1;
repeat
Arg := NextArg(S, SPos);
if Arg = '' then
Exit;
if Arg = '?' then
WriteHelp
else
case Arg[1] of
'-', '/' :
case Length(Arg) of
1 : BadOption;
2 : case Upcase(Arg[2]) of
'?' : WriteHelp;
'Q' : Quiet := True;
else
BadOption;
end;
else
UnknownOption;
end;
else
if Length(MarkName) <> 0 then
BadOption
else
MarkName := StUpcase(Arg);
end;
until False;
end;
begin
MarkName := '';
{Get arguments from the command line and the environment}
GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
GetArgs(GetEnv('MARKNET'));
{Assure mark file specified}
if Length(MarkName) = 0 then
WriteHelp;
if not Quiet then
WriteCopyright;
end;
begin
{$IFDEF MeasureStack}
fillchar(mem[sseg:0], sptr-16, $AA);
{$ENDIF}
{Must run with standard DOS vectors}
SwapVectors;
SaveExit := ExitProc;
ExitProc := @ExitHandler;
{Get command line options}
GetOptions;
{Assure supported version of DOS}
ValidateDosVersion;
{Find the device driver chain and the DOS internal table}
FindDevChain;
{Save PSP region of COMMAND.COM}
BufferCommandPSP;
{Buffer the DOS file table}
BufferFileTable;
{Deallocate environment}
asm
mov es,PrefixSeg
mov es,es:[$002C]
mov ah,$49
int $21
end;
{Buffer the allocated mcb array}
BufferAllocatedMcbs;
{Open the mark file}
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;
{Save list of allocated memory control blocks}
SaveAllocatedMcbs;
{Close mark file}
Close(MarkF);
CheckWriteError;
{Move ID strings into place}
SaveIDStrings;
if not Quiet then
WriteLn('Stored mark information in ', MarkName);
{$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}
Flush(Output);
{Close file handles}
CloseStandardFiles;
{Go resident}
asm
mov dl,byte ptr markname
xor dh,dh
add dx,$0090
mov cl,4
shr dx,cl
mov ax,$3100
int $21
end;
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/