Program MemoryExplore;
{$M $2048,0,12000}
Uses Crt, Dos;
Var
  KbdIntVec:Procedure;
  Source, Scr:Pointer;
  Segm,Smeh:Word;

{Вывод на экран числа в 16-тиричном виде}
Procedure WriteHexWord(w: Word);
Const
  HexChars : array [0..$F] of Char=
    '0123456789ABCDEF';
Begin
     Write(HexChars[Hi(w) shr 4],
           HexChars[Hi(w) and $F],
           HexChars[Lo(w) shr 4],
           HexChars[Lo(w) and $F]);
End;

{$F+}
Procedure MemScan;         { Процедура        }
Var                        { просмотра памяти }
   X:LongInt;
Begin
   Repeat
      Port[$20]:=$20;
      For X:=9 to 3999 Do
      Begin
        Mem[$B800:x*2]:=Mem[Segm:Smeh+x-9];
      End;
      If port[$60]=$48 Then
     Begin
        If Smeh>=80 Then Smeh:=Smeh-80
                    Else Smeh:=0;
        Delay(250);port[$60]:=0;
     End;
     If port[$60]=$50 Then
     Begin
       If Smeh<61455 Then Smeh:=smeh+80
                       Else Smeh:=61455;
       Delay(250);port[$60]:=0;
    End;
If port[$60]=$49 Then
Begin
   If Segm>=1 Then Segm:=Segm-1
              Else Segm:=0;
   Delay(250);port[$60]:=0;
End;
If port[$60]=$51 Then
Begin
  If Segm<$FFFF Then Segm:=Segm+1
                Else Segm:=$FFFF;
  Delay(250);port[$60]:=0;
End;
If port[$60]=$47 Then
Begin
   If Segm>=100 Then Segm:=Segm-100
                Else Segm:=0;
   port[$60]:=0;
End;
If port[$60]=$4F Then
Begin
   If Segm<$FFFF-100 Then Segm:=Segm+100
                     Else Segm:=$FFFF;
   port[$60]:=0;
End;
GotoXY(1,1);
TextAttr:=16*Red+White;
WriteHexWord(Segm);Write(':');
WriteHexWord(Smeh);
TextAttr:=White;
Until port [$60]=$44;
Repeat
Until port[$60]<>$44;
End;

procedure KeyClick; interrupt;
Begin
  If port[$60]=76 Then
  Begin
    GetMem(Scr,4000);
    Source:=Ptr($B800,0000);
    Move(Source^,Scr^,4000);
    ClrScr;
    MemScan;
    Move(Scr^,Source^,4000);
    FreeMem(Scr,4000);
  End;
    inline ($9C);
    KbdIntVec;
  End;
  {$F-}

Begin
      Smeh:=0;Segm:=0;
      GetIntVec($9,@KbdIntVec);
      SetIntVec($9,Addr(KeyClick));
      Keep(0);
End.