Программатор ПЗУ

        x:=length(name) shr 1;

        y:=(xdr-xul)shr 1+xul;

        y:=y-x;

        Loc(y+1,yul);

        y:=clr;

        x:=(clr and $F0)shr 4;

        color(x,clr and $0F);

        Wrt(name);

        clr:=y;

        lxul:=xul;

        lyul:=yul;

        lxdr:=xdr;

        lydr:=ydr;

End;

Procedure Morph(xf1,yf1,xf2,yf2,xt1,yt1,xt2,yt2 : byte);

Var

    x : word;

Begin

    Window(xf1,yf1,xf2,yf2,'');

Repeat

    MakeMans;

     If xf1>xt1 Then dec(xf1,((xf1-xt1)Shr speed)+1);

      If xf1<xt1 Then inc(xf1,((xt1-xf1)Shr speed)+1);

       If yf1>yt1 Then dec(yf1,((yf1-yt1)Shr speed)+1);

        If yf1<yt1 Then inc(yf1,((yt1-yf1)Shr speed)+1);

         If xf2>xt2 Then dec(xf2,((xf2-xt2)Shr speed)+1);

          If xf2<xt2 Then inc(xf2,((xt2-xf2)Shr speed)+1);

           If yf2>yt2 Then dec(yf2,((yf2-yt2)Shr speed)+1);

            If yf2<yt2 Then inc(yf2,((yt2-yf2)Shr speed)+1);

             Window(xf1,yf1,xf2,yf2,'');

             Map;

             WaitRt;

Until (xf1=xt1)And(xf2=xt2)And(yf1=yt1)And(yf2=yt2);

End;

Procedure MorphL(xt1,yt1,xt2,yt2 : byte);

Var

    x : word;

    xf1,xf2,yf1,yf2 : byte;

Begin

    xf1:=lxul; xf2:=lxdr;

    yf1:=lyul; yf2:=lydr;

    MorPh(xf1,yf1,xf2,yf2,xt1,yt1,xt2,yt2);

End;

Procedure WindowL(name : string);

Var

   xf1,xf2,yf1,yf2 : byte;

Begin

   xf1:=lxul; xf2:=lxdr;

   yf1:=lyul; yf2:=lydr;

   Window(xf1,yf1,xf2,yf2,name);

End;

Procedure Menu(x1,y1,stepy,all,col : byte; s1,s2,s3,s4,s5 : string;lenx : byte);

Var

   x  : byte;

   yt : byte;

   yp : byte;

Begin

   yt:=y1;

    For x:=1 To all Do

     Begin

      Loc(x1,yt);

       Case x oF

        1: Wrt(s1);

        2: Wrt(s2);

        3: Wrt(s3);

        4: Wrt(s4);

        5: Wrt(s5);

       End;

      yt:=yt+stepy;

     End;

    yp:=0;

    yt:=clr;

    clr:=col;

Repeat

Repeat {??}

    Loc(x1-2,y1+(stepy*yp));

    Wrt(char(204));

    WaitKey;

Until (Key=chr(13))or(ScanCode=byte('H'))or(ScanCode=byte('P'))or(Key=chr(27));

    Loc(x1-2,y1+(stepy*yp));

    Wrt(' ');

     If Key=chr(27) Then yp:=all-1;

      If ScanCode=byte('P') Then If yp<(all-1) Then inc(yp);

       If ScanCode=byte('H') Then If yp>0 Then dec(yp);

Until (Key=chr(13))or(Key=chr(27));

       x:=x1-2;

Repeat

       Loc(x,y1+(stepy*yp));

       Wrt(' '+chr(205));

       WaitRt;

       Map;

       inc(x,1);

Until x>=x1+lenx;

       clr:=yt;

       MenuP:=yp;

End;

Procedure HexL2Str(l : longint; var s : string);

Begin

    s:=hex[(l shr (4*7))and 15];

    s:=s+hex[(l shr (4*6))and 15];

    s:=s+hex[(l shr (4*5))and 15];

    s:=s+hex[(l shr (4*4))and 15];

    s:=s+hex[(l shr (4*3))and 15];

    s:=s+hex[(l shr (4*2))and 15];

    s:=s+hex[(l shr (4*1))and 15];

    s:=s+hex[(l)and 15];

End;

Procedure HexB2Str(l : byte; var s : string);

Begin

    s:=hex[(l shr 4)and 15];

    s:=s+hex[(l)and 15];

End;

Procedure MemEd(name: string);

Var

    x,y         : word;

    l,l1,p,lpos : longint;

    s,st        : string;

    stc         : byte;

    size        : longint;

    readsize    : longint;

    bank        : word;

    b1,b2       : byte;

    flag        : boolean;

    i           :  searchrec;

Label Repaint, TryAgain;

Begin

    TryAgain:

    FindFirst(name,AnyFile,i);

     If i.Attr And ReadOnly = ReadOnly Then

      Begin

       stc:=clr;

       color(7,4);

       MorPhL(20,7,56,15);

       WindowL('File has ReadOnly Attribute!');

       Menu(30,9,2,3,$4b,'Remove it','Reselect file','Exit','xxx4','xxx5',6);

        If MenuP=1 Then

         Begin

          MenuP:=8;

          exit;

         End;

        If MenuP=2 Then

         Begin

          MenuP:=0;

          exit;

         End;

       clr:=stc;

       assign(f,name);

       SetFattr(f,(i.Attr xor ReadOnly));

       MorPhL(0,0,77,24);

       Color(7,6);

       WindowL('Memory Editor');

        goto TryAgain;

      End;

    Assign(f,name);

    reset(f,1);

    size:=FilesiZe(f);

    l1:=0;

    p:=0;

    lpos:=0;

    bank:=0;

    flag:=false;

     If size>35000 Then readsize:=35000 Else readsize:=size;

      blockread(f,buffer^,readsize);

      RePaint:

       If l1 Div 32767 <> bank Then

        Begin

         If flag Then

          Begin

           color(7,4);

           MorPhL(24,7,50,14);

           WindowL('Save Changed Data?');

           Menu(36,9,3,2,$4b,'YES','NO','xxx3','xxx4','xxx5',6);

            If MenuP=0 Then

             Begin

              Seek(f,lpos);

              blockwrite(f,buffer^,readsize);

             End;

           MorPhL(0,0,77,24);

           Color(7,6);

           WindowL('Memory Editor');

          End;

         lpos:=(l1 div 32767)*32767+(l1 div 32767);

         Seek(f,lpos);

          If size-l1>35000 Then readsize:=35000 Else readsize:=size-l1;

           blockread(f,buffer^,readsize);

           bank:=l1 div 32767;

           flag:=false;

       end;

      l:=l1 and 32767;

      Loc(2,1);

      Wrt('address     0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F     ASCII');

       For x:=2 To 22 Do

        Begin

         Loc(2,x);

         HexL2Str(l+(l1 and (32767 xor $FFFFFFFF)),s);

         Wrt(s+':  ');

          For y:=1 to 16 do

           Begin

            HexB2Str(buffer^[l],s);

            Wrt(s+' ');

            inc(l);

           End;

            For y:=16 Downto 1 Do

             Begin

              Wrt(char(buffer^[l-y]));

             End;

        End;

       l:=l1 and 32767;

Repeat

Repeat

       stc:=clr;

       color(6,7);

       HexB2Str(buffer^[l+p],s);

       Loc((((p) and 15)*3)+13,(p) shr 4+2);

       Wrt(s);

       Loc((((p) and 15))+61,(p) shr 4+2);

       Wrt(char(buffer^[l+p]));

       clr:=stc;

       WaitKey;

Until (Key=chr(13))or(ScanCode=$49)or(ScanCode=$51)or(ScanCode=$48)

      or(ScanCode=$4D)or(ScanCode=$4B)or(ScanCode=$50)or(Key=chr(27))

      or((Key>='0')and(Key<='9')or(upcase(Key)>='A')and(Upcase(Key)<='F'));

       If (ScanCode=$48)or(ScanCode=$4d)or(ScanCode=$4b)or(ScanCode=$50) Then

        Begin

         HexB2Str(buffer^[l+p],s);

         Loc((((p) and 15)*3)+13,(p) shr 4+2);

         Wrt(s);

         Loc((((p) and 15))+61,(p) shr 4+2);

         Wrt(char(buffer^[l+p]));

        End;

       If ((Key>='0')And(Key<='9'))Or((upcase(Key)>='A')And(Upcase(Key)<='F')) Then

        Begin

         stc:=clr;

         Key:=upcase(Key);

         If (Key>='0')And(Key<='9') Then b1:=byte(Key)-byte('0') Else b1:=byte(Key)-byte('A')+10;

          color(6,7);

          Loc((((p) and 15)*3)+13,(p) shr 4+2);

          Wrt(Key+'?');

          Loc((((p) and 15))+61,(p) shr 4+2);

          Wrt('?');

Repeat

          WaitKey;

Until ((Key>='0')and(Key<='9')or(upcase(Key)>='A')and(Upcase(Key)<='F'))or(ScanCode=$0E);

          Key:=upcase(Key);

           If (Key>='0')And(Key<='9') Then b2:=byte(Key)-byte('0') Else b2:=byte(Key)-byte('A')+10;

            If ((Key>='0')And(Key<='9'))Or((upcase(Key)>='A')And(Upcase(Key)<='F')) Then

             Begin

              buffer^[l+p]:=b1*16+b2;

              flag:=true;

             end;

            clr:=stc;

        end;

Case ScanCode of

 $50: if l1+p+16<size then begin inc(p,16); if p>320+15 then begin inc(l1,16); p:=320+(p and 15); goto RePaINt; end; end;

 $48: begin if (p>15)or(l1<>0)then dec(p,16); if p<0 then begin dec(l1,16); p:=p and 15; goto RePaINt; end; end;

 $4D: if l1+p+1<size then begin inc(p); if p>320+15 then begin inc(l1,16); p:=320; goto RePaINt; end; end;

1	2	3	4	5	6	7	8	9