[Back to SAVESCRN SWAG index] [Back to Main SWAG index] [Original]
{$B-,F-,I-,R-,S-}
{$M 2048,2048,2048}
Program CapText;
{
ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ
ÛÛÛÝÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÞÛÛÛ±±
ÛÛÛÝÛÛ ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ Resident text screen capture ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ Aleksandar Dlabac ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ (C)1992. Dlabac Bros. Company ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ ------------------------------ ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ adlabac@urcpg.urc.cg.ac.yu ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ adlabac@urcpg.pmf.cg.ac.yu ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ ÛÛÞÛÛÛ±±
ÛÛÛÝßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÞÛÛÛ±±
ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±
±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
}
Uses Dos;
Var OldKeyboard : procedure;
OldTimeClick : procedure;
OldIdle : procedure;
Procedure Keyboard; Interrupt; Forward; {< }
Procedure TimeClick; Interrupt; Forward; {< New interrapt routines }
Procedure Idle; Interrupt; Forward; {< }
Var FileName : string;
InDos : ^Boolean;
PSP : word;
Signature : string [10];
PoV : byte;
Call : byte;
I : byte;
X1, X2, Y1, Y2 : byte;
Ctrl, Shift, Alt : Boolean;
PasStack : pointer;
OldStack : pointer;
Procedure GetStack;
{ Gets current SP and SS values }
Inline ($89/$26/>PasStack/$8C/$16/>PasStack+2);
Procedure ToPasStack;
{ Changes current SP and SS values, to Pascal code ones }
Inline ($89/$26/>OldStack/$8C/$16/>OldStack+2/
$8B/$26/>PasStack/$8E/$16/>PasSTack+2/$FB);
Procedure ToOldStack;
{ Changes current SP and SS values, to original ones }
Inline ($8B/$26/>OldStack/$8E/$16/>OldStack+2);
Function PasStackFree : Boolean;
{ Checks if Pascal stack is free }
Inline ($8C/$D0/$2B/$06/>PasStack+2/$0A/$C4);
Procedure PushF;
{ PUSHF assembler command must be executed before old interrupt }
{ procedure call. This is because IRET pops flags, and RET don't. }
Inline ($9C);
Function IntVec (IntNo:byte) : pointer;
{ Returns pointer to requested interrupt routine }
Var P : pointer;
Begin
GetIntVec (IntNo,P); IntVec:=P
End;
Procedure Swp (Var X,Y:byte);
{ Swaps two variables }
Var Temp : byte;
Begin
Temp:=X;
X:=Y;
Y:=Temp
End;
Procedure SaveScreen;
{ Procedure for screen content saving to file }
Function VideoAdr : word;
{ Address of video segment }
Begin
If Mem [$0000:$0449] = 7
then VideoAdr:=$B000
else VideoAdr:=$B800
End;
Var F : text;
St : string [80];
I, J : integer;
Begin
Assign (F,FileName);
Append (F);
For I:=Y1 to Y2 do
Begin
St:='';
For J:=X1 to X2 do St:=St+Chr (Mem [VideoAdr:((I-1)*80+J-1)*2]);
Writeln (F,St)
End;
Close (F)
End;
Procedure UnInstall;
{ Uninstalls program, if it is possible, i.e. if hooked vectors are not }
{ changed after installation. Beep if successfull. }
Type MCB = record
Tok : byte;
PID : word;
Siz : word
End;
MCBPtr = ^MCB;
WrdPtr = ^word;
Var Blk : MCBPtr;
Adr : WrdPtr;
R : Registers;
Begin
If (IntVec ($08)=@TimeClick) and (IntVec ($09)=@Keyboard)
and (IntVec ($28)=@Idle) and (IntVec (PoV)=@Signature) then
Begin
SetIntVec ($08,@OldTimeClick);
SetIntVec ($09,@OldKeyboard);
SetIntVec ($28,@OldIdle);
SetIntVec (PoV,Nil);
R.AH:=$52;
MsDos (R);
Adr:=Ptr (R.ES,R.BX-2);
Blk:=Ptr (Adr^,0);
Repeat
If (Blk^.PID=PSP) then
Begin
R.AH:=$49;
R.ES:=Seg (Blk^)+1;
MsDos (R)
End;
If (Blk^.Tok=$4D) then Blk:=Ptr (Blk^.Siz+Seg (Blk^)+1,0)
else Blk:=Nil
Until Blk=Nil;
Write (#7);
End
End;
Procedure Action;
Begin
Case Call of
22 : Uninstall;
38 : SaveScreen
End;
Call:=0
End;
Procedure Keyboard;
{ New Keyboard interrupt routine }
Begin
Case Port [$60] of
29 : Ctrl:=True;
157 : Ctrl:=False;
42 : Shift:=True;
170 : Shift:=False;
56 : Alt:=True;
184 : Alt:=False;
22, 38 : If Shift and Ctrl and Alt and (Call=0)
then Call:=Port [$60]
End;
PushF;
OldKeyboard
End;
Procedure TimeClick;
{ New timer interrupt routine }
Begin
PushF;
OldTimeClick;
If (Call<>0) and not (InDos^) and PasStackFree then
Begin
ToPasStack;
Action;
ToOldStack
End
End;
Procedure Idle;
{ New DOS Idle interrupt routine }
Begin
PushF;
OldIdle;
If (Call<>0) and PasStackFree then
Begin
ToPasStack;
Action;
ToOldStack
End
End;
Var R : Registers;
F : Text;
Begin
Writeln;
Writeln ('Text Capture ver 1.0');
Writeln ('Dlabac Bros Software (C) 1992');
Writeln ('Activation Ctrl-Alt-Shift L');
Writeln ('Deactivation Ctrl-Alt-Shift U');
Writeln;
Signature:='TextCap1.0';
PoV:=$60;
While (PoV<$68) and (string (IntVec (PoV)^)<>Signature) do Inc (PoV);
If (PoV<>$68) then
Begin
Writeln ('TextCap already installed.');
Halt (1)
End;
PoV:=$60;
While (PoV<$68) and (IntVec (PoV)<>Nil) do Inc (PoV);
If PoV=$68 then
Begin
Writeln ('Instalation unsuccessful - no free vector : 60H-67H');
Halt (2)
End;
Repeat
Write ('Define window coordinates (X1 Y1 X2 Y2) : ');
Readln (X1,Y1,X2,Y2);
If X1>X2 then Swp (X1,X2);
If Y1>Y2 then Swp (Y1,Y2)
Until (X1>=1) and (X2<=80) and (Y1>=1) and (Y2<=25);
Write ('File name : ');
Readln (FileName);
Assign (F,FileName);
Rewrite (F);
Close (F);
R.AH:=$34;
MsDos (R);
InDos:=Ptr (R.ES,R.BX);
R.AH:=$62;
MsDos (R);
PSP:=R.BX;
Call:=0;
Ctrl:=False;
Shift:=False;
Alt:=False;
SwapVectors;
GetIntVec ($08,@OldTimeClick);
GetIntVec ($09,@OldKeyboard);
GetIntVec ($28,@OldIdle);
SetIntVec ($08,@TimeClick);
SetIntVec ($09,@Keyboard);
SetIntVec ($28,@Idle);
SetIntVec (Pov,@Signature);
GetStack;
Keep (0)
End.
[Back to SAVESCRN SWAG index] [Back to Main SWAG index] [Original]