home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 10 / praxis / tpatch.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1989-07-31  |  12.1 KB  |  448 lines

  1. (* -------------------------------------------------------*)
  2. (*                     TPATCH.PAS                         *)
  3. (*   Programm zum Ändern von Texten in .EXE- oder .COM-   *)
  4. (*   Dateien, von denen kein Quelltext vorliegt.          *)
  5. (*       Nicht mit Original-Programmen arbeiten !!!       *)
  6. (*       (C) 1989 Robert Hoffmann & TOOLBOX               *)
  7. (* ------------------------------------------------------ *)
  8. PROGRAM TextPatch_100;
  9. {$S-,D-,F-,V-,N-,L-}
  10.  
  11. USES Crt, Dos;
  12.  
  13. CONST
  14.   X_min         = 1;
  15.   Y_min         = 2;
  16.   X_max         = 80;
  17.   Y_max         = 16;
  18.   Programmname  : STRING = 'TPATCH';
  19.   Programmautor : STRING = ' (c) Robert Hoffmann & TOOLBOX';
  20.   Type_Size     : ARRAY [0..0] OF INTEGER = (1);
  21.  
  22. TYPE
  23.   Type_Def              = (Byte_Type);
  24.   Byte_Array            = ARRAY [0..0] OF BYTE;
  25.   Pointer_To_Byte_Array = ^Byte_Array;
  26.  
  27. VAR
  28.   Regs                  : Registers;
  29.   Zeichen_Array         : Pointer_To_Byte_Array;
  30.   Zeichen               : CHAR;
  31.   Datei                 : FILE OF BYTE;
  32.   Akt_Pos,
  33.   Ges_Pos,
  34.   Akt_Zeile,
  35.   Zeile_Anfang,
  36.   Zeile_Ende,
  37.   Zeilenzahl            : LongInt;
  38.   Dateiname             : PathStr;
  39.   geaendert             : BOOLEAN;
  40.   OrigMode              : WORD;
  41.  
  42.   PROCEDURE New_Array(VAR Pointer; Element_Type : Type_Def;
  43.                       Array_Size : LongInt);
  44.   VAR
  45.     Any_Pointer : ^INTEGER ABSOLUTE POINTER;
  46.   BEGIN
  47.     GetMem(Any_Pointer,
  48.            Type_Size [Integer (Element_Type)] * Array_Size);
  49.   END;
  50.  
  51.  
  52.   PROCEDURE Dispose_Array(VAR Pointer;
  53.                           Element_Type : Type_Def;
  54.                           Array_Size   : LongInt);
  55.   VAR
  56.     Any_Pointer : ^INTEGER ABSOLUTE POINTER;
  57.   BEGIN
  58.     FreeMem(Any_Pointer,
  59.             Type_Size[Integer (Element_Type)] * Array_Size);
  60.   END;
  61.  
  62.   FUNCTION IsColor : BOOLEAN;
  63.   BEGIN
  64.     IsColor := NOT ((Lo(LastMode) = 7));
  65.   END;
  66.  
  67.   PROCEDURE Cursor(c : BYTE);
  68.   BEGIN
  69.     IF c IN [0..2] THEN BEGIN
  70.       WITH Regs DO BEGIN
  71.         ax := $0100;
  72.         CASE c of
  73.           0 : cx := $0F00;
  74.           1 : IF IsColor THEN cx := $0607
  75.                          ELSE cx := $0B0C;
  76.           2 : cx := 12;
  77.         END;
  78.       END;
  79.       Intr($10, Regs);
  80.     END;
  81.   END;
  82.  
  83.   PROCEDURE Setze_Farbe(v, h : BYTE);
  84.   BEGIN
  85.     TextColor(v);  TextBackground(h);
  86.   END;
  87.  
  88.   PROCEDURE Beep(f, d : INTEGER);
  89.   BEGIN
  90.     Sound(f);  Delay(d);  NoSound;
  91.   END;
  92.  
  93.   PROCEDURE Speichern;
  94.   VAR
  95.     i : LongInt;
  96.   BEGIN
  97.     Assign(Datei, Dateiname);
  98.     {$I-}
  99.     Rewrite(Datei);
  100.     {$I+}
  101.     IF IOResult = 0 THEN
  102.       FOR i := 1 TO Ges_Pos DO
  103.         Write(Datei, Zeichen_Array^[i]);
  104.     Close(Datei);
  105.   END;
  106.  
  107.   PROCEDURE Beenden;
  108.   BEGIN
  109.     IF geaendert THEN Speichern;
  110.     Dispose_Array(Zeichen_Array, Byte_Type, Ges_Pos+2);
  111.     Cursor(1);
  112.     TextMode(OrigMode);
  113.     Halt(1);
  114.   END;
  115.  
  116.   PROCEDURE Start;
  117.   VAR
  118.     a, i : INTEGER;
  119.   BEGIN
  120.     Setze_Farbe(Yellow, Red);
  121.     Window(X_min, Y_min - 1, X_max, Y_min);
  122.     REPEAT
  123.       REPEAT
  124.         ClrScr;     Write(' Dateiname : ');
  125.         Cursor(2);  ReadLn(Dateiname);  Cursor(0);
  126.       UNTIL Dateiname <> '';
  127.       Assign(Datei, Dateiname);
  128.       {$I-}
  129.       Reset(Datei);
  130.       {$I+}
  131.     UNTIL IOResult= 0;
  132.     Ges_Pos := FileSize(Datei);
  133.     ClrScr;
  134.     a := Length(Programmname) + Length(Programmautor);
  135.     a := (79 - a) DIV 2;
  136.     WriteLn(' ' : a, Programmname + ' ' + Programmautor);
  137.     FOR i := 1 TO Length(Dateiname) DO
  138.       Dateiname[i] := UpCase(Dateiname[i]);
  139.     a := Length(Dateiname);
  140.     a := (79 - a) DIV 2;
  141.     ClrEol;
  142.     Write(' ' : a, Dateiname);
  143.   END;
  144.  
  145.   PROCEDURE Laden;
  146.   VAR
  147.     i : LongInt;
  148.     c : CHAR;
  149.   BEGIN
  150.     Start;
  151.     IF Ges_Pos <= MaxAvail + 20000 THEN BEGIN
  152.       New_Array(Zeichen_Array, Byte_Type, Ges_Pos+2);
  153.       FOR i := 1 TO Ges_Pos DO
  154.         Read(Datei, Zeichen_Array^[i])
  155.     END ELSE BEGIN
  156.       Window(X_min, Y_min - 1, X_max, Y_min);
  157.       ClrScr;
  158.       WriteLn(' Das Programm ist zu groß !!');
  159.       Write(' Abbruch mit ESC');
  160.       REPEAT
  161.         c := ReadKey;
  162.         IF c = #0 THEN c := ReadKey;
  163.       UNTIL c = #27;
  164.       Close(Datei);
  165.       Cursor(1);
  166.       TextMode(OrigMode);
  167.       Halt(1);
  168.     END;
  169.     Close(Datei);
  170.   END;
  171.  
  172.   PROCEDURE Vorbereiten;
  173.   BEGIN
  174.     Akt_Pos      := 0;
  175.     Ges_Pos      := 0;
  176.     Zeilenzahl   := 0;
  177.     Zeile_Anfang := 1;
  178.     Akt_Zeile    := 1;
  179.     CheckBreak   := FALSE;
  180.     OrigMode     := LastMode;
  181.     TextMode(3);
  182.     Cursor(0);
  183.     Setze_Farbe(LightGray, Black);
  184.     ClrScr;
  185.     Laden;
  186.     Setze_Farbe(LightGray, Blue);
  187.     Window(X_min, Y_max + 6, X_max, Y_max + 9);
  188.     ClrScr;
  189.     Setze_Farbe(Blue, LightGray);
  190.     Write(' Ctrl '#27,' ');
  191.     Setze_Farbe(LightGray, Blue);
  192.     Write(' an Anfang der Zeile  ');
  193.     Setze_Farbe(Blue, LightGray);
  194.     Write(' Ctrl ',#26,' ');
  195.     Setze_Farbe(LightGray, Blue);
  196.     Write(' ans Ende der Zeile  ');
  197.     Setze_Farbe(Blue, LightGray);
  198.     Write(' Home   ');
  199.     Setze_Farbe(LightGray, Blue);
  200.     WriteLn(' an Anfang');
  201.     Setze_Farbe(Blue, LightGray);
  202.     Write('    ', #24, '   ');
  203.     Setze_Farbe(LightGray,Blue);
  204.     Write(' eine Zeile auf       ');
  205.     Setze_Farbe(Blue, LightGray);
  206.     Write('    ',#25,'   ');
  207.     Setze_Farbe(LightGray, Blue);
  208.     Write(' eine Zeile ab       ');
  209.     Setze_Farbe(Blue, LightGray);
  210.     Write(' ESC    ');
  211.     Setze_Farbe(LightGray, Blue);
  212.     WriteLn(' ENDE');
  213.     Setze_Farbe(Blue, LightGray);
  214.     Write  ('    ', #26, '   ');
  215.     Setze_Farbe(LightGray, Blue);
  216.     Write(' ein Zeichen rechts   ');
  217.     Setze_Farbe(Blue, LightGray);
  218.     Write('    ',#27,'   ');
  219.     Setze_Farbe(LightGray, Blue);
  220.     WriteLn(' ein Zeichen links ');
  221.     Setze_Farbe(Blue, LightGray);
  222.     Write(' PgUp   ');
  223.     Setze_Farbe(LightGray, Blue);
  224.     Write(' eine Seite hoch      ');
  225.     Setze_Farbe(Blue, LightGray);
  226.     Write(' PgDn   ');
  227.     Setze_Farbe(LightGray, Blue);
  228.     Write(' eine Seite runter ');
  229.   END;
  230.  
  231.   PROCEDURE Schreib(x : LongInt);
  232.   BEGIN
  233.     IF  (Zeichen_Array^[x] <  32) OR
  234.        ((Zeichen_Array^[x] >  126) AND
  235.         (Zeichen_Array^[x] <> 129) AND
  236.         (Zeichen_Array^[x] <> 132) AND
  237.         (Zeichen_Array^[x] <> 148) AND
  238.         (Zeichen_Array^[x] <> 142) AND
  239.         (Zeichen_Array^[x] <> 153) AND
  240.         (Zeichen_Array^[x] <> 154) AND
  241.         (Zeichen_Array^[x] <> 225)) THEN
  242.       Write('.')
  243.     ELSE
  244.       Write(Chr(Zeichen_Array^[x]));
  245.   END;
  246.  
  247.   PROCEDURE Status;
  248.   VAR
  249.     x, y : INTEGER;
  250.   BEGIN
  251.     x := WhereX; y := WhereY;
  252.     Setze_Farbe(Blue, LightGray);
  253.     GotoXY(1,1); ClrEol;
  254.     WriteLn('                Zeichen ', Akt_Pos:6, ' von ',
  255.             Ges_Pos:6, '    Zeile ', Akt_Zeile:4, ' von ',
  256.             Zeilenzahl:4);
  257.     Setze_Farbe(LightGray, Blue);
  258.     GotoXY(x,y)
  259.   END;
  260.  
  261.   PROCEDURE Editieren;
  262.   VAR
  263.     a, e, i : LongInt;
  264.  
  265.     PROCEDURE Left;
  266.     BEGIN
  267.       IF Akt_Pos > 1 THEN
  268.         IF WhereX > X_min THEN BEGIN
  269.           Dec(Akt_Pos);
  270.           GotoXY(WhereX - 1, WhereY);
  271.         END;
  272.     END;
  273.  
  274.     PROCEDURE Right;
  275.     BEGIN
  276.       IF Akt_Pos < Ges_Pos THEN
  277.       IF WhereX < X_max THEN BEGIN
  278.         Inc(Akt_Pos);
  279.         GotoXY(WhereX + 1, WhereY);
  280.       END;
  281.     END;
  282.  
  283.     PROCEDURE Control_Left;
  284.     BEGIN
  285.       WHILE WhereX > X_min DO Left;
  286.     END;
  287.  
  288.     PROCEDURE Control_Right;
  289.     BEGIN
  290.       WHILE(WhereX < X_max) AND (Akt_Pos < Ges_Pos) DO
  291.         Right;
  292.     END;
  293.  
  294.     PROCEDURE Down;
  295.     VAR
  296.       x, xx : INTEGER;
  297.       i     : LongInt;
  298.     BEGIN
  299.       IF Akt_Zeile < Zeilenzahl THEN
  300.         IF Akt_Zeile < Zeile_Ende THEN BEGIN
  301.           Inc(Akt_Pos, X_max);
  302.           Inc(Akt_Zeile);
  303.           GotoXY(WhereX, WhereY + 1);
  304.           WHILE((Akt_Zeile-1)*X_max)+WhereX>Ges_Pos DO BEGIN
  305.             GotoXY(WhereX - 1,WhereY);
  306.             Dec(Akt_Pos);
  307.           END;
  308.         END ELSE
  309.           IF Akt_Zeile = Zeile_Ende THEN BEGIN
  310.             xx := WhereX;
  311.             Inc(Zeile_Anfang);
  312.             Inc(Zeile_Ende);
  313.             GotoXY(X_min, Y_min);
  314.             DelLine;
  315.             GotoXY(X_min, Y_max);
  316.             Akt_Pos := Akt_Zeile * X_max;
  317.             Inc(Akt_Zeile);
  318.             FOR i := Akt_Pos + 1 TO Akt_Pos + X_max DO
  319.               IF i <= Ges_Pos THEN BEGIN
  320.                 Schreib(i);
  321.                 Inc(Akt_Pos);
  322.               END;
  323.             x := (Akt_Zeile - 1) * X_max;
  324.             x := Akt_Pos - x;
  325.             GotoXY(x, Y_max);
  326.             WHILE WhereX > xx DO BEGIN
  327.               GotoXY(WhereX - 1, Y_max);
  328.               Dec(Akt_Pos);
  329.             END;
  330.           END;
  331.     END;
  332.  
  333.     PROCEDURE Up;
  334.     VAR
  335.       x    : INTEGER;
  336.       a, i : LongInt;
  337.     BEGIN
  338.       IF WhereY > Y_min THEN BEGIN
  339.         Dec(Akt_Pos, X_max);
  340.         GotoXY(WhereX, WhereY - 1);
  341.         Dec(Akt_Zeile);
  342.       END ELSE
  343.         IF Zeile_Anfang > 1 THEN BEGIN
  344.         x := WhereX;
  345.         Dec(Akt_Pos, X_max);
  346.         Dec(Zeile_Anfang);
  347.         Dec(Zeile_Ende);
  348.         Dec(Akt_Zeile);
  349.         a := (Zeile_Anfang-1) * X_max + 1;
  350.         GotoXY(X_min, Y_max);
  351.         DelLine;
  352.         GotoXY(X_min, Y_min);
  353.         InsLine;
  354.         FOR i := a TO a + X_max - 1 DO Schreib(i);
  355.         GotoXY( x,Y_min)
  356.       END;
  357.     END;
  358.  
  359.   BEGIN { Editieren }
  360.     Akt_Zeile    := 1;
  361.     Akt_Pos      := 1;
  362.     Zeile_Anfang := 1;
  363.     Zeilenzahl   := Ges_Pos DIV X_max;
  364.     IF Ges_Pos MOD X_max <> 0 THEN Inc(Zeilenzahl);
  365.     Zeile_Ende := Zeile_Anfang + Y_max - Y_min;
  366.     IF Zeile_Ende > Zeilenzahl THEN
  367.       Zeile_Ende := Zeilenzahl;
  368.     Setze_Farbe(LightGray, Blue);
  369.     Window(X_min, Y_min + 2, X_max, Y_max + 4);
  370.     ClrScr;
  371.     GotoXY(X_min, Y_min);
  372.     a := (Zeile_Anfang - 1) * X_max + 1;
  373.     e := a + (Y_max - Y_min + 1) * X_max - 1;
  374.     FOR i := a TO e DO
  375.       IF i <= Ges_Pos THEN Schreib(i);
  376.     Status;
  377.     GotoXY(X_min, Y_min);
  378.     REPEAT
  379.       Cursor(2);
  380.       Zeichen := ReadKey;
  381.       IF Zeichen = #0 THEN BEGIN
  382.         Zeichen := ReadKey;
  383.         Cursor(0);
  384.         CASE Zeichen of
  385.           #71 : IF Zeile_Anfang > 1 THEN BEGIN  { Home }
  386.                   Akt_Pos := 1;
  387.                   Akt_Zeile := 1;
  388.                   Zeile_Anfang := 1;
  389.                   Zeile_Ende := Zeile_Anfang + Y_max -Y_min;
  390.                   IF Zeile_Ende > Zeilenzahl THEN
  391.                     Zeile_Ende := Zeilenzahl;
  392.                   ClrScr;
  393.                   GotoXY(X_min, Y_min);
  394.                   a := (Zeile_Anfang - 1) * X_max + 1;
  395.                   e := a + (Y_max - Y_min + 1) * X_max - 1;
  396.                   FOR i := a TO e DO
  397.                     IF i <= Ges_Pos THEN Schreib(i);
  398.                   GotoXY(X_min, Y_min);
  399.                 END ELSE BEGIN
  400.                   Akt_Pos := 1;
  401.                   Akt_Zeile := 1;
  402.                   GotoXY(X_min, Y_min);
  403.                 END;
  404.           #72 : Up; { Up }
  405.           #73 : FOR a := Y_min - 1 TO Y_max - Y_min DO Up;
  406.           #75 : Left;
  407.           #77 : Right;
  408.           #115: Control_Left;
  409.           #116: Control_Right;
  410.           #80 : Down;
  411.           #81 : FOR a := Y_min - 1 TO Y_max - Y_min DO Down;
  412.         END;
  413.       END ELSE
  414.         IF ((Zeichen IN [#32..#63,#65..#126,#129,#132,#148,
  415.                          #142,#153,#154,#225]) AND
  416.            (Akt_Pos <= Ges_Pos)) THEN BEGIN
  417.           geaendert := TRUE;
  418.           Cursor(0);
  419.           Write(Zeichen);
  420.           Zeichen_Array^[Akt_Pos] := Ord(Zeichen);
  421.           Inc(Akt_Pos);
  422.           IF (WhereY = Y_max + 1) AND
  423.              (Zeile_Ende < Zeilenzahl) THEN BEGIN
  424.             GotoXY(X_max,Y_max);
  425.             Down;
  426.           END ELSE
  427.             IF (WhereY = Y_max + 1) AND
  428.                (Zeile_Ende = Zeilenzahl) THEN BEGIN
  429.               GotoXY(X_max, Y_max);
  430.               Dec(Akt_Pos);
  431.             END ELSE
  432.               IF Akt_Pos > Ges_Pos THEN BEGIN
  433.                 GotoXY(WhereX-1, WhereY);
  434.                 Dec(Akt_Pos);
  435.               END;
  436.       END ELSE Beep(400,100);
  437.       Status;
  438.     UNTIL Zeichen = #27;
  439.   END;
  440.  
  441. BEGIN { Main }
  442.   geaendert := FALSE;
  443.   Vorbereiten;
  444.   Editieren;
  445.   Beenden;
  446. END.
  447. (* ------------------------------------------------------ *)
  448. (*                 Ende von TPATCH.PAS                    *)