Category : Pascal Source Code
Archive   : PAS_0693.ZIP
Filename : BOOTRES.PAS

 
Output of file : BOOTRES.PAS contained in archive : PAS_0693.ZIP
{Ä Fido Pascal Conference ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ PASCAL Ä
Msg : 312 of 319
From : Steve Mulligan 1:163/307.30 23 Jun 93 10:24
To : Edward Walker
Subj : TSRs that write to disk....
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
Tuesday June 22 1993 02:38, Edward Walker wrote to All:

EW> What do I need to set up in the code to write to disk in a TSR?

Here's a TSR called BootRes. It opens a file and writes to disk every x
seconds :}

program BootRes;

{$M 2048,0,0}
{$F+}

Uses BootVars, Crt, Dos;

const
OLDSTACKSS : WORD = 0;
OLDSTACKSP : WORD = 0;
STACKSW : INTEGER = - 1;
OurStackSeg : word = 0;
OurStackSp : word = 0;
DosDelimSet : set of Char = ['\', ':', #0];

var
R : registers;
DosSeg, DosBusy : word;
Tick, WaitBuf : integer;
NeedPop : boolean;

PROCEDURE BEGINint;
INLINE($FF/$06/STACKSW/
$75/$10/
$8C/$16/OLDSTACKSS/
$89/$26/OLDSTACKSP/
$8E/$16/OURSTACKSEG/
$8B/$26/OURSTACKSP);

PROCEDURE ENDint;
INLINE($FF/$0E/STACKSW/
$7D/$08/
$8E/$16/OLDSTACKSS/
$8B/$26/OLDSTACKSP);

PROCEDURE CALLPOP(SUB:POINTER);
BEGIN
INLINE($FF/$5E/$06);
END;

PROCEDURE CLI; INLINE($FA);
PROCEDURE STI; INLINE($FB);

function Exist(fname : string) : boolean;
var
f1 : file; err : integer;
begin
{$I-}
assign(f1,fname); reset(f1); err := ioresult;
{$I+}
if err = 0 then close(f1); exist := err = 0;
end;

function AddBackSlash(DirName : string) : string;
{-Add a default backslash to a directory name}
begin
if DirName[Length(DirName)] in DosDelimSet then
AddBackSlash := DirName
else
AddBackSlash := DirName+'\';
end;

procedure TsrCrap;
begin
CLI;
BEGINint;
STI;

NeedPop := False;

GetDate(h, m, s, hund);
TimeLoad.Year := h;
TimeLoad.Month := m;
TimeLoad.Day := s;
GetTime(h, m, s, hund);
TimeLoad.Hour := h;
TimeLoad.Min := m;
TimeLoad.Sec := s;

DoDate;
DoDate2;

if not exist(LogName) then begin
assign(LogFile, LogName);
rewrite(LogFile);
write(LogFile, LogRec);
close(LogFile);
end;

assign(LogFile, LogName);
reset(LogFile);
if FileSize(LogFile) = 0 then begin
close(LogFile);
assign(LogFile, LogName);
rewrite(LogFile);
write(LogFile, LogRec);
close(LogFile);
assign(LogFile, LogName);
reset(LogFile);
end;
seek(LogFile, FileSize(LogFile) - 1);
read(LogFile, LogRec);
DoDate2;
seek(LogFile, FileSize(LogFile) - 1);
write(LogFile, LogRec);
close(LogFile);
Tick := 0;

CLI;
ENDint;
STI;
end;

procedure RunTSR; Interrupt;
begin
CLI;
BEGINint;
STI;
inc(Tick);
if Tick > 18.2 * WaitBuf then begin
NeedPop := True;
if MEM[DosSeg:DosBusy] = 0 then begin
NeedPop := False;
PORT[$20] := $20;
TsrCrap;
end;
end;
CLI;
ENDint;
STI;
end;

procedure Int28TSR; Interrupt;
begin
CLI;
BEGINint;
STI;
if NeedPop = True then TsrCrap;
CLI;
ENDint;
STI;
end;

procedure InitTSR;
begin
OurStackSeg := SSEG;
InLine($89/$26/OurStackSp);
R.Ah := $34;
MSDOS(R);
DosSeg := R.ES;
DosBusy := R.BX;
end;

procedure ShowHelp;
begin
writeln('Usage : BOOTRES ');
writeln;
writeln('Valid Options : # Number of seconds to wait before writing current
time');
writeln(' /? This screen');
end;

begin
InitTSR;

GetDir(0, LogName);
LogName := AddBackSlash(LogName) + 'BOOTLOG.DAT';
WaitBuf := 60;

writeln;

if ParamCount > 0 then begin
if ParamStr(1) = '/?' then begin
ShowHelp;
halt(0);
end;
val(ParamStr(1), WaitBuf, Tick);
if (Tick <> 0) or ((WaitBuf > 60 * 10) or (WaitBuf < 5)) then begin
writeln('Must be an integer between 5 and ', 60 * 10);
halt(1);
end;
end else begin
writeln('Type BOOTRES /? for help');
writeln;
end;

Tick := 0;

SetIntVec($28,@Int28TSR);
SetIntVec($1C,@RunTSR);

writeln('BootRes installed');

keep(0);
end.

  3 Responses to “Category : Pascal Source Code
Archive   : PAS_0693.ZIP
Filename : BOOTRES.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. 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/