home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 02 / ldm / spion.pas < prev    next >
Pascal/Delphi Source File  |  1990-11-12  |  27KB  |  835 lines
  1. (* ------------------------------------------------------ *)
  2. (*                        SPION.PAS                       *)
  3. (*               Residenter Speichermonitor               *)
  4. (*                    Turbo Pascal 5.5                    *)
  5. (*            (c) 1991 Achim Stindt & toolbox             *)
  6. (* ------------------------------------------------------ *)
  7. {$R-,S-,I-,V-,B-,N-,D-,F+,L-}
  8. {$M 16384, 0, 655360}
  9.  
  10. PROGRAM Spy;
  11. USES
  12.   Crt, Dos, TSR;
  13. CONST
  14.   Name       = 'Spion';
  15.   SpyID      = 22;
  16.   HotKey     = $6800;
  17.   HotKeyName = 'Alt-F1';
  18.  
  19. PROCEDURE Monitor;         { Hauptprozedur Speichermonitor }
  20. CONST
  21.   Title : ARRAY[0 .. 5, 0 .. 5] OF STRING[10] =    { Menüs }
  22.           ((' Ende     ', ' Zurück   ', '',
  23.             '', '', ''),
  24.           (' Edit     ', ' Hex-Edit ', ' Asc-Edit ',
  25.             '', '', ''),
  26.           (' Adresse  ', ' Segment  ', ' Offset   ',
  27.             '', '', ''),
  28.           (' Rechnen  ', ' Dez->Hex ', ' Hex->Dez ',
  29.             ' Addieren ', ' Subtrah. ', ''),
  30.           (' Finden   ', ' Such Hex ', ' Such Asc ',
  31.             '', '', ''),
  32.           (' Diskette ', ' Laden    ', ' Sichern  ',
  33.             '', '', ''));
  34.   YellowOnRed = 256 * (Red * 16 + Yellow);
  35.   BlueOnWhite = 256 * (LightGray * 16 + Blue);
  36.   GrayOnBlack = 256 * LightGray;
  37. TYPE
  38.   ScreenType  = ARRAY[0 .. 24, 0 .. 79] OF WORD;
  39.   StMax       = STRING[255];      { längstmöglicher String }
  40. VAR
  41.   LastX, LastY, i, j, x, y, MenuX, MenuY : INTEGER;
  42.   DeIn, UpDa, InEd, NewKey, NoRead, Ende : BOOLEAN;
  43.   Key             : CHAR;
  44.   Segment, Offset : WORD;
  45.   p               : ARRAY[0..15, 0..15] OF BYTE;
  46.   Search          : StMax;
  47.   Buffer          : ARRAY[0..24, 0..79] OF WORD;
  48.   MenuBuffer      : ARRAY[0..4, 0..79] OF WORD;
  49.   ColorScreen     : BYTE ABSOLUTE $B800:$0000;
  50.   MonoScreen      : BYTE ABSOLUTE $B000:$0000;
  51.   Regs            : Registers;
  52.   Screen          : ^ScreenType;
  53.  
  54.   FUNCTION GetKey : CHAR;                    { Taste lesen }
  55.   BEGIN
  56.     IF NewKey THEN GetKey := ReadKey
  57.     ELSE BEGIN
  58.       GetKey := Key; NewKey := TRUE;
  59.     END;
  60.   END;  { GetKey }
  61.  
  62.   PROCEDURE WriteAsc(x, y, Value : WORD);
  63.   BEGIN                         { ASCII-Zeichen auf Screen }
  64.     IF (Value >= 32) AND (Value <= 127) THEN
  65.       Screen^[y, x] := Value + YellowOnRed   { darstellbar }
  66.     ELSE
  67.       Screen^[y, x] := Ord('.') + YellowOnRed;     { Punkt }
  68.     GotoXY(x + 2, y + 1);
  69.   END;  { WriteAsc }
  70.  
  71.   PROCEDURE WriteHex(x, y, Value, dgt : WORD);
  72.   VAR                  { Hex-Zahlen umrechnen und anzeigen }
  73.     mdl, Digit : WORD;
  74.   BEGIN
  75.     Digit := dgt;
  76.     WHILE Digit > 0 DO BEGIN
  77.       mdl := Value MOD 16;
  78.       IF mdl < 10 THEN
  79.         Screen^[y, x + Digit - 1] :=
  80.           mdl + Ord('0') + YellowOnRed
  81.       ELSE
  82.         Screen^[y, x + Digit - 1] :=
  83.           mdl - 10 + Ord('A') + YellowOnRed;
  84.       Value := Value DIV 16;
  85.       Dec(Digit);
  86.     END;
  87.     GotoXY(x + dgt + 1, y + 1);
  88.   END;  { WriteHex }
  89.  
  90.   FUNCTION ReadHex(x, y, dgt : INTEGER) : WORD;
  91.   VAR              { Tastatureingabe einer Hexadezimalzahl }
  92.     Value, Digit : WORD;
  93.     Key          : CHAR;
  94.   BEGIN
  95.     FOR Digit := 0 TO dgt - 1 DO
  96.       WriteAsc(x + Digit, y, Ord('-'));
  97.     GotoXY(x + 1 , y + 1);
  98.     Digit := dgt;
  99.     Value := 0;
  100.     IF NOT NoRead THEN REPEAT
  101.       Key := UpCase(GetKey);
  102.       CASE Key OF
  103.         #13      : BEGIN                        { <Return> }
  104.                      WriteHex(x, y, Value, dgt);
  105.                      Digit := 0;
  106.                    END;
  107.         '0'..'9' : BEGIN                         { Ziffern }
  108.                      Screen^[y, x + dgt - Digit] :=
  109.                        Ord(Key) + YellowOnRed;
  110.                      Value :=
  111.                        Value * 16 + Ord(Key) - Ord('0');
  112.                      Dec(Digit);
  113.                      GotoXY(x + dgt - Digit + 1, y + 1);
  114.                    END;
  115.         'A'..'F' : BEGIN                     { <A> bis <F> }
  116.                      Screen^[y, x + dgt - Digit] :=
  117.                        Ord(Key) + YellowOnRed;
  118.                      Value := Value * 16 + Ord(Key) - 55;
  119.                      Dec(Digit);
  120.                      GotoXY(x + dgt - Digit + 1, y + 1);
  121.                    END;
  122.         #8       : IF Digit < dgt THEN BEGIN  
  123.                      Inc(Digit);             { <BackSpace> }
  124.                      Screen^[y, x + dgt - Digit] :=
  125.                        Ord('-') + YellowOnRed;
  126.                      GotoXY(x + dgt - Digit + 1, y + 1);
  127.                      Value := Value DIV 16;
  128.                    END;
  129.         #27      : BEGIN                        { <Escape> }
  130.                      NoRead := TRUE; Digit := 0;
  131.                    END;
  132.       END; { CASE }
  133.     UNTIL Digit = 0;
  134.     ReadHex := Value;
  135.   END;  { ReadHex }
  136.  
  137.   PROCEDURE ClrTri;                  { Infofenster löschen }
  138.   VAR
  139.     i, j : INTEGER;
  140.   BEGIN
  141.     FOR i := 20 TO 22 DO
  142.       FOR j := 2 TO 77 DO Screen^[i, j] := 32 + YellowOnRed;
  143.   END;  { ClrTri }
  144.  
  145.   PROCEDURE Page;  { Speicherseite auf Bildschirm ausgeben }
  146.   VAR
  147.     y, x, i, j : INTEGER;
  148.   BEGIN
  149.     TextColor(Yellow); TextBackground(Red);
  150.     FOR y := 0 TO 15 DO BEGIN
  151.       WriteHex(2, 2 + y, Segment, 4);
  152.       WriteAsc(6, 2 + y, Ord(':'));
  153.       WriteHex(7, 2 + y, Offset + y * 16, 4);
  154.       WriteAsc(11, 2 + y, 32);
  155.       WriteAsc(12, 2 + y, 32);
  156.       WriteAsc(61, 2 + y, 32);
  157.       FOR x := 0 TO 15 DO BEGIN        { Speicher auslesen }
  158.         p[y, x] := Mem[Segment : Offset + y * 16 + x];
  159.         WriteHex(13 + 3 * x, 2 + y, p[y, x], 2);
  160.         WriteAsc(13 + 3 * x + 2, 2 + y, 32);
  161.         WriteAsc(62 + x, 2 + y, p[y, x]);
  162.       END;
  163.     END;
  164.     IF NOT InEd THEN BEGIN
  165.       TextColor(Black); TextBackground(LightGray);
  166.       FOR i := 2 TO 4 DO
  167.         FOR j := 0 TO 79 DO
  168.           MenuBuffer[i, j] := Screen^[i, j];
  169.       FOR i := 2 TO 4 DO BEGIN
  170.         FOR j := 0 TO 79 DO
  171.           MenuBuffer[i, j] := Screen^[i, j];
  172.         GotoXY(10 * MenuX + 1, 1 + i);
  173.         IF Title[MenuX, i] <> '' THEN
  174.           Write(Title[MenuX, i]);
  175.       END;
  176.     END;
  177.   END;  { Page }
  178.  
  179.   FUNCTION Change : BOOLEAN;
  180.   VAR                   { Änderungen in Speicher schreiben }
  181.     x, y : WORD;
  182.     OK   : BOOLEAN;
  183.     c    : CHAR;
  184.   BEGIN
  185.     IF NOT UpDa THEN BEGIN
  186.       ClrTri;
  187.       GotoXY(25, 21);
  188.       Write('Soll geänderter Text wirklich ');
  189.       GotoXY(25, 22);
  190.       Write('geschrieben werden ? (J/N)');
  191.       REPEAT
  192.         c := ReadKey
  193.       UNTIL UpCase(c) IN ['J', 'N', 'Y', #13];
  194.       ClrTri;
  195.       IF UpCase(c) <> 'N' THEN BEGIN
  196.         OK := TRUE;
  197.         FOR y := 0 TO 15 DO BEGIN    { Puffer in Speicher }
  198.           FOR x := 0 TO 15 DO BEGIN  { schreiben          }
  199.             Mem[Segment : Offset + y * 16 + x] := p[y, x];
  200.             IF Mem[Segment : Offset + y * 16 + x] <>
  201.               p[y, x] THEN
  202.               OK := FALSE;
  203.           END;
  204.         END;
  205.         IF NOT OK THEN BEGIN
  206.           ClrTri;
  207.           GotoXY(20, 22);
  208.           Write('Achtung! Geänderter Text läßt ');
  209.           Write('sich nicht zurückschreiben!');
  210.         END;
  211.         Change := OK;
  212.       END ELSE
  213.         OK := FALSE;
  214.       IF NOT OK THEN BEGIN
  215.         FOR y := 0 TO 15 DO BEGIN
  216.           FOR x := 0 TO 15 DO BEGIN
  217.             p[y, x] := Mem[Segment : Offset + y * 16 + x];
  218.           END;
  219.         END;
  220.         Page;
  221.       END;
  222.       UpDa := TRUE;
  223.     END;
  224.   END;  { Change }
  225.  
  226.   PROCEDURE Edit(Hex : BOOLEAN);      { Speicher editieren }
  227.   VAR
  228.     i, j, Value : INTEGER;
  229.     Accept      : BOOLEAN;
  230.   BEGIN
  231.     InEd := TRUE;
  232.     FOR i := 0 TO 4 DO
  233.       FOR j := 0 TO 79 DO Screen^[i, j] := MenuBuffer[i, j];
  234.     REPEAT
  235.       IF Hex THEN BEGIN
  236.         Screen^[2 + y, 13 + x * 3] :=
  237.          (Screen^[2 + y, 13 + x * 3] AND $FF) + BlueOnWhite;
  238.         Screen^[2 + y, 13 + x * 3 + 1] :=
  239.           (Screen^[2 + y, 13 + x * 3 + 1] AND $FF)
  240.           + BlueOnWhite;
  241.         GotoXY(13 + 3 * x + 1, 2 + y + 1);
  242.       END ELSE BEGIN
  243.         Screen^[2 + y, 62 + x] :=
  244.           (Screen^[2 + y, 62 + x] AND $FF) + BlueOnWhite;
  245.         GotoXY(62 + x + 1, 2 + y + 1);
  246.       END;
  247.       REPEAT UNTIL KeyPressed;
  248.       IF Hex THEN BEGIN
  249.         Screen^[2 + y, 13 + x * 3] :=
  250.           (Screen^[2 + y, 13 + x * 3] AND $FF) +
  251.           YellowOnRed;
  252.         Screen^[2 + y, 13 + x * 3 + 1] :=
  253.           (Screen^[2 + y, 13 + x * 3 + 1] AND $FF) +
  254.           YellowOnRed;
  255.       END ELSE
  256.         Screen^[2 + y, 62 + x] :=
  257.           (Screen^[2 + y, 62 + x] AND $FF) + YellowOnRed;
  258.       NoRead := FALSE;
  259.       Key := GetKey;
  260.       IF Key = #0 THEN BEGIN
  261.         Key := GetKey;
  262.         CASE Key OF
  263.           #72 : IF y > 0 THEN Dec(y)              { <hoch> }
  264.                 ELSE BEGIN
  265.                   IF Change THEN BEGIN
  266.                     IF Offset > 16 THEN Dec(Offset, 16)
  267.                                    ELSE Offset := 0;
  268.                       Page;
  269.                   END;
  270.                 END;
  271.           #73 : IF Change THEN BEGIN              { <PgUp> }
  272.                   IF Offset >= 256 THEN
  273.                     Dec(Offset, 256)
  274.                   ELSE BEGIN
  275.                     Offset := 0; x := 0; y := 0;
  276.                   END;
  277.                   Page;
  278.                 END;
  279.           #75 : IF x > 0 THEN Dec(x)             { <links> }
  280.                 ELSE BEGIN
  281.                   x := 15;
  282.                   IF y > 0 THEN Dec(y)
  283.                   ELSE
  284.                     IF Change THEN BEGIN
  285.                       IF Offset >= 16 THEN Dec(Offset, 16)
  286.                                       ELSE Offset := 0;
  287.                       Page;
  288.                     END;
  289.                 END;
  290.           #77 : IF x < 15 THEN Inc(x)           { <rechts> }
  291.                 ELSE BEGIN
  292.                   x := 0;
  293.                   IF y < 15 THEN Inc(y)
  294.                   ELSE
  295.                     IF Change THEN BEGIN
  296.                       IF Offset <= $FF00 - 16 THEN
  297.                         Inc(Offset, 16)
  298.                       ELSE
  299.                         Offset := $FF00;
  300.                       Page;
  301.                     END;
  302.                 END;
  303.           #80 : IF y < 15 THEN Inc(y)           { <runter> }
  304.                 ELSE
  305.                   IF Change THEN BEGIN
  306.                     IF Offset <= $FF00 - 16 THEN
  307.                       Inc(Offset, 16)
  308.                     ELSE
  309.                       Offset := $FF00;
  310.                     Page;
  311.                   END;
  312.           #81 : IF Change THEN BEGIN              { <PgDn> }
  313.                   IF Offset <= $FF00 - 256 THEN
  314.                     Inc(Offset, 256)
  315.                   ELSE BEGIN
  316.                     Offset := $FF00;
  317.                     x := 0; y := 0;
  318.                   END;
  319.                   Page;
  320.                 END;
  321.         END;  { CASE }
  322.       END ELSE BEGIN
  323.         Accept := FALSE;
  324.         IF Hex THEN BEGIN
  325.           IF UpCase(Key) IN ['0'..'9', 'A'..'F'] THEN BEGIN
  326.             NewKey := FALSE;
  327.             Value := ReadHex(13 + 3 * x, 2 + y, 2);
  328.             Accept := TRUE;
  329.           END
  330.         END ELSE
  331.           IF Key IN [#32..#255] THEN BEGIN
  332.             NewKey := FALSE;
  333.             Value := Ord(GetKey);
  334.             Accept := TRUE;
  335.           END;
  336.         IF Accept THEN BEGIN
  337.           UpDa := FALSE;
  338.           p[y, x] := Value;
  339.           WriteHex(13 + 3 * x, 2 + y, p[y, x], 2);
  340.           WriteAsc(62 + x, 2 + y, p[y, x]);
  341.           IF x < 15 THEN Inc(x)
  342.           ELSE BEGIN
  343.             x := 0;
  344.             IF y < 15 THEN Inc(y)
  345.             ELSE
  346.               IF Change THEN BEGIN
  347.                 IF Offset <= $FF00 - 16 THEN Inc(Offset, 16)
  348.                                        ELSE Offset := $FF00;
  349.                 Page;
  350.               END;
  351.           END;
  352.         END;
  353.         IF Key = #9 THEN Hex := NOT Hex;
  354.         IF Key = #13 THEN BEGIN
  355.           x := 0;
  356.           IF y < 15 THEN Inc(y) ELSE
  357.             IF Change THEN BEGIN
  358.               IF Offset <= $FF00 -16 THEN Inc(Offset, 16)
  359.                                      ELSE Offset := $FF00;
  360.               Page;
  361.             END;
  362.         END;
  363.       END;
  364.     UNTIL Key = #27;
  365.     TextColor(Black);
  366.     TextBackground(LightGray);
  367.     FOR i := 0 TO 4 DO BEGIN
  368.       FOR j := 0 TO 79 DO
  369.         MenuBuffer[i, j] := Screen^[i, j];
  370.       GotoXY(10 * MenuX + 1, 1 + i);
  371.       IF Title[MenuX, i] <> '' THEN
  372.         Write(Title[MenuX, i]);
  373.     END;
  374.     InEd := FALSE;
  375.   END;  { Edit }
  376.  
  377.   PROCEDURE ReadString(VAR s : StMax;
  378.                        x, y, Width : INTEGER);
  379.   VAR                         { Stringeingabe mit Tastatur }
  380.     c : CHAR;
  381.   BEGIN
  382.     i := 0;
  383.     s := '';
  384.     REPEAT
  385.       GotoXY(x + 1, y + 1); Write('"' + s + '" ');
  386.       GotoXY(x + Ord(s[0]) + 2, y + 1);
  387.       c := ReadKey;
  388.       IF (c IN [#32 .. #127]) AND (i < Width) THEN BEGIN
  389.         s[Ord(s[0]) + 1] := c;
  390.         Inc(s[0]);
  391.       END;
  392.       IF c =  #8 THEN
  393.         IF s[0] > #0 THEN Dec(s[0]);
  394.       IF c = #27 THEN BEGIN
  395.         s := ''; c := #13;
  396.       END;
  397.     UNTIL c = #13;
  398.   END;  { ReadString }
  399.  
  400.   PROCEDURE Adress(Segm : BOOLEAN);        { Adresseingabe }
  401.   BEGIN
  402.     TextColor(Yellow);
  403.     TextBackground(Red);
  404.     NoRead := FALSE;
  405.     IF Segm THEN Segment := ReadHex(2, 2, 4)
  406.             ELSE Offset  := ReadHex(7, 2, 4);
  407.     Page;
  408.   END;  { Adress }
  409.  
  410.   PROCEDURE Rechnen(Conv, Foo : BOOLEAN);   { Berechnungen }
  411.   VAR
  412.     o, s, s1, o1, s2, o2, a, i : WORD;
  413.     l                          : LONGINT;
  414.     c                          : CHAR;
  415.   BEGIN
  416.     NoRead := FALSE;
  417.     ClrTri;
  418.     IF Conv THEN BEGIN
  419.       IF Foo THEN BEGIN
  420.         GotoXY(35, 22); Write('-----d = ----h');
  421.         i := 5; a := 0;
  422.         WHILE (i > 0) DO BEGIN
  423.           GotoXY(35 + 5 - i, 22);
  424.           c := ReadKey;
  425.           CASE c OF
  426.             '0' .. '9' : BEGIN                   { Ziffern }
  427.                            a := 10 * a + Ord(c) - Ord('0');
  428.                            Write(c);
  429.                            Dec(i);
  430.                          END;
  431.             #13        : BEGIN                  { <Return> }
  432.                            GotoXY(35, 22); Write(a:5);
  433.                            i := 0;
  434.                          END;
  435.             #8         : IF i > 0 THEN BEGIN { <BackSpace> }
  436.                            a := a DIV 10;
  437.                            Inc(i);
  438.                            GotoXY(35 + 5 - i, 22);
  439.                            Write('-');
  440.                          END;
  441.             #27        : BEGIN                  { <Escape> }
  442.                            NoRead := TRUE;
  443.                            i := 0;
  444.                          END;
  445.           END;  { CASE }
  446.         END;
  447.         WriteHex(43, 21, a, 4);
  448.       END ELSE BEGIN
  449.         GotoXY(35, 22);
  450.         Write('----h = -----d');
  451.         a := ReadHex(34, 21, 4);
  452.         IF NOT NoRead THEN BEGIN
  453.           GotoXY(43, 22); Write(a:5);
  454.         END;
  455.       END;
  456.     END ELSE BEGIN
  457.       GotoXY(35, 21); Write(' ----:---- ');
  458.       GotoXY(34, 22);
  459.       IF Foo THEN Write('+')
  460.              ELSE Write('-');
  461.       Write(' ----:---- ');
  462.       GotoXY(35, 23); Write(' ----:---- ');
  463.       s1 := ReadHex(35, 20, 4); o1 := ReadHex(40, 20, 4);
  464.       s2 := ReadHex(35, 21, 4); o2 := ReadHex(40, 21, 4);
  465.       IF Foo THEN BEGIN
  466.         s := s1 + s2;
  467.         l := LONGINT(o1) + LONGINT(o2);
  468.         IF l > $FFFF THEN
  469.           s := s + $1000;
  470.         o := l;
  471.       END ELSE BEGIN
  472.         s := s1 - s2; l := o1 - o2;
  473.         IF o1 < o2 THEN
  474.           s := s - $1000;
  475.       END;
  476.       WriteHex(35, 20, s1, 4);
  477.       WriteHex(40, 20, o1, 4);
  478.       WriteHex(35, 21, s2, 4);
  479.       WriteHex(40, 21, o2, 4);
  480.       WriteHex(35, 22, s, 4);
  481.       WriteHex(40, 22, o, 4);
  482.     END;
  483.     IF NoRead THEN BEGIN
  484.       NoRead := FALSE;
  485.       ClrTri;
  486.     END;
  487.   END;  { Rechnen }
  488.  
  489.   PROCEDURE Finden(Hex : BOOLEAN);                { Suchen }
  490.   VAR
  491.     d             : CHAR;
  492.     s             : StMax;
  493.     ex0, ex1      : BOOLEAN;
  494.     ss, so        : WORD;
  495.     i, l, j, x, z : INTEGER;
  496.   BEGIN
  497.     NoRead := FALSE;
  498.     ClrTri;
  499.     IF Hex = TRUE THEN BEGIN
  500.       GotoXY(28, 21); Write('Bitte Hex-String eingeben');
  501.       GotoXY(20, 22);
  502.       i := 0;
  503.       ex0 := FALSE;
  504.       REPEAT
  505.         d := UpCase(ReadKey);
  506.         IF (d IN ['0'..'9','A'..'F']) AND (i < 250) THEN
  507.         BEGIN
  508.           s[i + 2] := d;
  509.           Inc(i);
  510.         END;
  511.         IF (d = #8) AND (i > 0) THEN BEGIN
  512.           Dec(i);
  513.           GotoXY(20, 22); Write(' ':40);
  514.         END;
  515.         GotoXY(20, 22);
  516.         IF i < 26 THEN BEGIN
  517.           x := 0; z := i;
  518.         END ELSE BEGIN
  519.           x := i - 24; z := x + 24;
  520.           Write('>> ');
  521.         END;
  522.         FOR l := x TO z - 1 DO BEGIN
  523.           Write(s[l + 2]);
  524.           IF l MOD 2 = 1 THEN
  525.             Write(#32);
  526.         END;
  527.         IF d = #27 THEN BEGIN
  528.           NoRead := TRUE;
  529.           ClrTri;
  530.         END;
  531.       UNTIL ((d = #13) AND (i MOD 2 = 0)) OR NoRead;
  532.       s[0] := Chr(i DIV 2);
  533.       FOR l := 0 TO i DO BEGIN
  534.         IF s[l + 2] <= '9' THEN
  535.           d := Chr (Ord(s[l + 2]) - Ord('0'))
  536.         ELSE
  537.           d := Chr(Ord(s[l + 2])  - 55);
  538.         s[l DIV 2 + 1] := Chr(((Ord(s[l DIV 2 + 1]) SHL 4)
  539.                           AND $F0) + Ord(d));
  540.       END;
  541.     END ELSE BEGIN
  542.       GotoXY(27, 21); Write(' Bitte ASCII-String eingeben');
  543.       GotoXY(20, 22);
  544.       i := 0;
  545.       REPEAT
  546.         d := ReadKey;
  547.         IF d IN [#32..#255] THEN BEGIN
  548.           Inc(i);
  549.           s[i] := d;
  550.         END;
  551.         IF (d = #8) AND (i > 0) THEN BEGIN
  552.           Dec(i);
  553.           GotoXY(20, 22); Write(' ':40);
  554.         END;
  555.         GotoXY(24, 22);
  556.         IF i < 32 THEN BEGIN
  557.           FOR l := 1 TO i DO Write(s[l])
  558.         END ELSE BEGIN
  559.           Write('>> ');
  560.           FOR l := i - 28 TO i DO Write(s[l]);
  561.         END;
  562.         IF d = #27 THEN BEGIN
  563.           NoRead := TRUE;
  564.           ClrTri;
  565.         END;
  566.       UNTIL (d = #13) OR NoRead;
  567.       s[0] := Chr(i);
  568.     END;
  569.     IF NOT NoRead THEN BEGIN
  570.       FOR i := 1 TO Ord(s[0]) DO Inc(s[i]);
  571.       IF s = '' THEN s := Search
  572.                 ELSE Search := s;
  573.       l := Ord(s[0]);
  574.       GotoXY(20, 22); Write(' ':40);
  575.       IF s[0] < #20 THEN i := Ord(s[0])
  576.                     ELSE i := 20;
  577.       x := 40 - (26 + i) DIV 2;
  578.       GotoXY(x, 21);  Write('Suche ab ----:---- nach "');
  579.       FOR i := 1 TO i DO
  580.         IF s[i] > #32 THEN Write(Pred(s[i]))
  581.                       ELSE Write('.');
  582.       IF s[0] > #20 THEN Write(' >>');
  583.       Write('"');
  584.       ss := Segment; so := Offset + 1;
  585.       i := 0;
  586.       ex0 := FALSE; ex1 := TRUE;
  587.       REPEAT
  588.         IF i = 0 THEN BEGIN
  589.           WriteHex(x + 8, 20, ss, 4);
  590.           WriteHex(x + 13, 20, so, 4);
  591.           i := 1024;
  592.         END;
  593.         i := Pred(i);
  594.         ex0 := TRUE;
  595.         FOR j := 0 TO Pred(l) DO
  596.           CASE Hex OF
  597.             TRUE  : IF Pred(s [Succ(j)]) <>
  598.                       Chr(Mem[ss : so + j]) THEN BEGIN
  599.                       ex0 := FALSE;
  600.                       j := Pred(l);
  601.                     END;
  602.             FALSE : IF UpCase(Pred(s[Succ(j)])) <>
  603.                       UpCase(Chr(Mem[ss : so + j])) THEN
  604.                     BEGIN
  605.                       ex0 := FALSE;
  606.                       j := Pred(l);
  607.                     END;
  608.           END;  { CASE }
  609.         IF NOT ex0 THEN
  610.           IF so < $8040 THEN so := Succ(so)
  611.           ELSE BEGIN
  612.             ss := ss + $800; so := 0;
  613.           END;
  614.       UNTIL ex0 OR KeyPressed;
  615.       IF KeyPressed THEN d := ReadKey;
  616.       IF ex0 THEN BEGIN
  617.         Segment := ss; Offset := so;
  618.         ClrTri;
  619.         GotoXY(30, 23); Write('Gefunden an ----:----');
  620.         WriteHex(41, 22, ss, 4); WriteHex(46, 22, so, 4);
  621.       END;
  622.       Page;
  623.     END;
  624.   END;  { Finden }
  625.  
  626.   PROCEDURE Disk(Save : BOOLEAN);
  627.   VAR                          { Diskettenein- und Ausgabe }
  628.     Fn       : StMax;
  629.     Lock     : FILE OF BYTE;
  630.     j        : INTEGER;
  631.     Of1, Of2 : WORD;
  632.     b        : BYTE;
  633.   BEGIN
  634.     NoRead := FALSE;
  635.     ClrTri;
  636.     REPEAT
  637.       GotoXY(28, 21);
  638.       IF Save = TRUE THEN Write('Sichern  ab  ----:----')
  639.                      ELSE Write('  Laden  an  ----:----');
  640.       GotoXY(36, 22); Write('bis  ----:----');
  641.       GotoXY(28, 23); Write('mit Namen ""');
  642.       WriteHex(40, 20, Segment, 4);
  643.       WriteHex(40, 21, Segment, 4);
  644.       Of1 := ReadHex(45, 20, 4); Of2 := ReadHex(45, 21, 4);
  645.     UNTIL (Of1 <= Of2) OR NoRead;
  646.     IF NOT NoRead THEN BEGIN
  647.       ReadString(Fn, 37, 22, 20);
  648.       IF Fn <> '' THEN BEGIN
  649.         Assign(Lock, Fn);
  650.         IF Save THEN ReWrite(Lock)
  651.                 ELSE Reset(Lock);
  652.         IF IOResult = 0 THEN BEGIN
  653.           IF Save THEN BEGIN
  654.             FOR j := Of1 TO Of2 DO
  655.               Write(Lock, Mem[Segment : j]);
  656.             Close(Lock);
  657.             GotoXY(60, 23); Write('gesichert');
  658.           END ELSE BEGIN
  659.             Read(Lock, b);
  660.             j := Of1;
  661.             WHILE (NOT EoF(Lock)) AND (j <= Of2) DO BEGIN
  662.               Mem[Segment:j] := b;
  663.               Inc(j);
  664.               Read(Lock, b);
  665.             END;
  666.             Page;
  667.             GotoXY(60, 23); Write('geladen');
  668.             IF (NOT EoF(Lock)) AND (j = Of2) THEN BEGIN
  669.               GotoXY(60, 22); Write('Datei zu lang');
  670.             END;
  671.           END;
  672.         END ELSE BEGIN
  673.           ClrTri;
  674.           GotoXY(30, 21); Write('Unzulässiger Dateiname');
  675.         END;
  676.       END ELSE
  677.         ClrTri;
  678.     END;
  679.     IF NoRead THEN BEGIN
  680.       NoRead := FALSE; ClrTri;
  681.     END;
  682.   END;  { Disk }
  683.  
  684.   PROCEDURE Horizon(Right : BOOLEAN);         { Menüleiste }
  685.   VAR
  686.     i, j : INTEGER;
  687.   BEGIN
  688.     TextColor(Black); TextBackground(LightGray);
  689.     FOR i := 0 TO 4 DO
  690.       FOR j := 0 TO 79 DO Screen^[i, j] := MenuBuffer[i, j];
  691.     IF Right THEN BEGIN                           { rechts }
  692.       Inc(MenuX);
  693.       IF MenuX = 6 THEN MenuX := 0;
  694.     END ELSE BEGIN                                 { links }
  695.       IF MenuX = 0 THEN MenuX := 6;
  696.       Dec(MenuX);
  697.     END;
  698.     MenuY := 0;
  699.     FOR i := 0 TO 4 DO BEGIN
  700.       FOR j := 0 TO 79 DO
  701.         MenuBuffer[i, j] := Screen^[i, j];
  702.       GotoXY(10 * MenuX + 1, 1 + i);
  703.       Write(Title[MenuX, i]);
  704.     END;
  705.   END;  { Horizon }
  706.  
  707.   PROCEDURE CursorOn;
  708.   BEGIN
  709.     INLINE($B4/$01/$B9/$13/$12/$CD/$10);
  710.   END;
  711.  
  712.   PROCEDURE CursorOff;
  713.   BEGIN
  714.     INLINE($B4/$01/$B9/$FF/$FF/$CD/$10);
  715.   END;
  716.  
  717. BEGIN                                            { Monitor }
  718.   IF LastMode = Mono THEN Screen := @MonoScreen
  719.                      ELSE Screen := @ColorScreen;
  720.   LastX := WhereX; LastY := WhereY;    { Cursorpos. merken }
  721.   FOR i := 0 TO 24 DO
  722.     FOR j := 0 TO 79 DO Buffer[i, j] := Screen^[i, j];
  723.   TextMode(CO80);
  724.   FOR i := 0 TO 24 DO
  725.     FOR j := 0 TO 79 DO Screen^[i, j] := 178 + GrayOnBlack;
  726.   GotoXY(1, 1);
  727.   TextColor(Black); TextBackground(LightGray);
  728.   FOR i := 0 TO 5 DO Write(Title[i, 0]);
  729.   Write(' ':20);
  730.   MenuX := 0; MenuY := 0;
  731.   InEd := TRUE;
  732.   Offset := 0; Segment := 0;
  733.   Page;
  734.   ClrTri;
  735.   IF LastMode <> Mono THEN BEGIN
  736.     FOR i :=  3 TO 78 DO Screen^[18, i] := 32 + Black;
  737.     FOR i :=  3 TO 17 DO Screen^[i, 78] := 32 + Black;
  738.     FOR i :=  3 TO 78 DO Screen^[23, i] := 32 + Black;
  739.     FOR i := 21 TO 22 DO Screen^[i, 78] := 32 + Black;
  740.   END;
  741.  
  742.   FOR i := 0 TO 4 DO
  743.     FOR j := 0 TO 79 DO MenuBuffer[i, j] := Screen^[i, j];
  744.  
  745.   MenuX := 0; MenuY := 0;
  746.   TextColor(Yellow); TextBackground(Blue);
  747.   GotoXY(1, 1); Write(Title[0, 0]);
  748.   TextColor(Black); TextBackground(LightGray);
  749.   GotoXY(1, 2); Write(Title[0, 1]);
  750.   GotoXY(1, 3); Write(Title[0, 2]);
  751.  
  752.   x := 0; y := 0;
  753.   Ende := FALSE; NewKey := TRUE;
  754.   NoRead := FALSE; InEd := FALSE; UpDa := TRUE;
  755.   Search := '@@@@@';
  756.   REPEAT
  757.     CursorOff;
  758.     REPEAT UNTIL KeyPressed;
  759.     GotoXY(10 * MenuX + 1, 1 + MenuY);
  760.     TextColor(Black); TextBackground(LightGray);
  761.     Write(Title[MenuX, MenuY]);
  762.     TextColor(Yellow); TextBackground(Red);
  763.     CursorOn;
  764.     Key := GetKey;
  765.     IF Key = #0 THEN Key := GetKey;
  766.     CASE Key OF
  767.       #32, #9, #77 : Horizon(TRUE);
  768.       #8, #75      : Horizon(FALSE);
  769.       #72          : IF MenuY > 0 THEN Dec(MenuY);
  770.       #80          : IF Title[MenuX, MenuY + 1] <> '' THEN
  771.                        Inc(MenuY);
  772.       #13          : BEGIN
  773.                        IF (MenuX = 0) AND (MenuY = 1) THEN
  774.                        BEGIN                        { Ende }
  775.                          Ende := TRUE; DeIn := FALSE;
  776.                        END;
  777.                        IF (MenuX = 1) AND (MenuY = 1) THEN
  778.                          Edit(TRUE);            { Hex-Edit }
  779.                        IF (MenuX = 1) AND (MenuY = 2) THEN
  780.                          Edit(FALSE);         { ASCII-Edit }
  781.                        IF (MenuX = 2) AND (MenuY = 1) THEN
  782.                          Adress(TRUE);   { Segment-Adresse }
  783.                        IF (MenuX = 2) AND (MenuY = 2) THEN
  784.                          Adress(FALSE);   { Offset-Adresse }
  785.                        IF (MenuX = 3) AND (MenuY = 1) THEN
  786.                          Rechnen(TRUE, TRUE);   { Dez->Hex }
  787.                        IF (MenuX = 3) AND (MenuY = 2) THEN
  788.                          Rechnen(TRUE, FALSE);  { Hex->Dez }
  789.                        IF (MenuX = 3) AND (MenuY = 3) THEN
  790.                          Rechnen(FALSE, TRUE);  { Addieren }
  791.                        IF (MenuX = 3) AND (MenuY = 4) THEN
  792.                          Rechnen(FALSE, FALSE);   { Subtr. }
  793.                        IF (MenuX = 4) AND (MenuY = 1) THEN
  794.                          Finden(TRUE);         { Suche Hex }
  795.                        IF (MenuX = 4) AND (MenuY = 2) THEN
  796.                          Finden(FALSE);      { Suche ASCII }
  797.                        IF (MenuX = 5) AND (MenuY = 1) THEN
  798.                          Disk(FALSE);          { Disk Load }
  799.                        IF (MenuX = 5) AND (MenuY = 2) THEN
  800.                          Disk(TRUE);           { Disk Save }
  801.                      END;
  802.     END;  { CASE }
  803.     GotoXY(10 * MenuX + 1, 1 + MenuY);
  804.     TextColor(Yellow); TextBackground(Blue);
  805.     Write(Title[MenuX, MenuY]);
  806.     GotoXY(10 * MenuX + 2, 1 + MenuY);
  807.   UNTIL Ende = TRUE;
  808.   TextMode(LastMode);
  809.   FOR i := 0 TO 24 DO                { Screen restaurieren }
  810.     FOR j := 0 TO 79 DO Screen^[i, j] := Buffer[i, j];
  811.   GotoXY(LastX, LastY);      { Cursorposition restaurieren }
  812.   IF Screen = @ColorScreen THEN BEGIN
  813.     Regs.AX := $1003;
  814.     Regs.BL := $00;
  815.     Intr($10, Regs);
  816.   END;
  817. END;
  818.  
  819. BEGIN
  820.   IF AlreadyLoaded(SpyID) THEN
  821.     WriteLn(#13#10, Name, ' ist bereits geladen')
  822.   ELSE BEGIN
  823.     IF PopUpInstalled(@Monitor, HotKey, 250) THEN BEGIN
  824.       WriteLn(#13#10, Name, ' installiert');
  825.       WriteLn('Aktivieren mit ', HotKeyName);
  826.       MakeResident(SpyID);
  827.     END ELSE BEGIN
  828.       WriteLn(#13#10, Name, ' nicht installiert,');
  829.       WriteLn('vielleicht nicht genug Speicher?');
  830.     END;
  831.   END;
  832. END.
  833. (* ------------------------------------------------------ *)
  834. (*                   Ende von SPION.PAS                   *)
  835.