home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
TSRUTILS.ZIP
/
MARKNET.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-05-04
|
18KB
|
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: 408-438-8608, 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.