home *** CD-ROM | disk | FTP | other *** search
- (* -------------------------------------------------------*)
- (* TPATCH.PAS *)
- (* Programm zum Ändern von Texten in .EXE- oder .COM- *)
- (* Dateien, von denen kein Quelltext vorliegt. *)
- (* Nicht mit Original-Programmen arbeiten !!! *)
- (* (C) 1989 Robert Hoffmann & TOOLBOX *)
- (* ------------------------------------------------------ *)
- PROGRAM TextPatch_100;
- {$S-,D-,F-,V-,N-,L-}
-
- USES Crt, Dos;
-
- CONST
- X_min = 1;
- Y_min = 2;
- X_max = 80;
- Y_max = 16;
- Programmname : STRING = 'TPATCH';
- Programmautor : STRING = ' (c) Robert Hoffmann & TOOLBOX';
- Type_Size : ARRAY [0..0] OF INTEGER = (1);
-
- TYPE
- Type_Def = (Byte_Type);
- Byte_Array = ARRAY [0..0] OF BYTE;
- Pointer_To_Byte_Array = ^Byte_Array;
-
- VAR
- Regs : Registers;
- Zeichen_Array : Pointer_To_Byte_Array;
- Zeichen : CHAR;
- Datei : FILE OF BYTE;
- Akt_Pos,
- Ges_Pos,
- Akt_Zeile,
- Zeile_Anfang,
- Zeile_Ende,
- Zeilenzahl : LongInt;
- Dateiname : PathStr;
- geaendert : BOOLEAN;
- OrigMode : WORD;
-
- PROCEDURE New_Array(VAR Pointer; Element_Type : Type_Def;
- Array_Size : LongInt);
- VAR
- Any_Pointer : ^INTEGER ABSOLUTE POINTER;
- BEGIN
- GetMem(Any_Pointer,
- Type_Size [Integer (Element_Type)] * Array_Size);
- END;
-
-
- PROCEDURE Dispose_Array(VAR Pointer;
- Element_Type : Type_Def;
- Array_Size : LongInt);
- VAR
- Any_Pointer : ^INTEGER ABSOLUTE POINTER;
- BEGIN
- FreeMem(Any_Pointer,
- Type_Size[Integer (Element_Type)] * Array_Size);
- END;
-
- FUNCTION IsColor : BOOLEAN;
- BEGIN
- IsColor := NOT ((Lo(LastMode) = 7));
- END;
-
- PROCEDURE Cursor(c : BYTE);
- BEGIN
- IF c IN [0..2] THEN BEGIN
- WITH Regs DO BEGIN
- ax := $0100;
- CASE c of
- 0 : cx := $0F00;
- 1 : IF IsColor THEN cx := $0607
- ELSE cx := $0B0C;
- 2 : cx := 12;
- END;
- END;
- Intr($10, Regs);
- END;
- END;
-
- PROCEDURE Setze_Farbe(v, h : BYTE);
- BEGIN
- TextColor(v); TextBackground(h);
- END;
-
- PROCEDURE Beep(f, d : INTEGER);
- BEGIN
- Sound(f); Delay(d); NoSound;
- END;
-
- PROCEDURE Speichern;
- VAR
- i : LongInt;
- BEGIN
- Assign(Datei, Dateiname);
- {$I-}
- Rewrite(Datei);
- {$I+}
- IF IOResult = 0 THEN
- FOR i := 1 TO Ges_Pos DO
- Write(Datei, Zeichen_Array^[i]);
- Close(Datei);
- END;
-
- PROCEDURE Beenden;
- BEGIN
- IF geaendert THEN Speichern;
- Dispose_Array(Zeichen_Array, Byte_Type, Ges_Pos+2);
- Cursor(1);
- TextMode(OrigMode);
- Halt(1);
- END;
-
- PROCEDURE Start;
- VAR
- a, i : INTEGER;
- BEGIN
- Setze_Farbe(Yellow, Red);
- Window(X_min, Y_min - 1, X_max, Y_min);
- REPEAT
- REPEAT
- ClrScr; Write(' Dateiname : ');
- Cursor(2); ReadLn(Dateiname); Cursor(0);
- UNTIL Dateiname <> '';
- Assign(Datei, Dateiname);
- {$I-}
- Reset(Datei);
- {$I+}
- UNTIL IOResult= 0;
- Ges_Pos := FileSize(Datei);
- ClrScr;
- a := Length(Programmname) + Length(Programmautor);
- a := (79 - a) DIV 2;
- WriteLn(' ' : a, Programmname + ' ' + Programmautor);
- FOR i := 1 TO Length(Dateiname) DO
- Dateiname[i] := UpCase(Dateiname[i]);
- a := Length(Dateiname);
- a := (79 - a) DIV 2;
- ClrEol;
- Write(' ' : a, Dateiname);
- END;
-
- PROCEDURE Laden;
- VAR
- i : LongInt;
- c : CHAR;
- BEGIN
- Start;
- IF Ges_Pos <= MaxAvail + 20000 THEN BEGIN
- New_Array(Zeichen_Array, Byte_Type, Ges_Pos+2);
- FOR i := 1 TO Ges_Pos DO
- Read(Datei, Zeichen_Array^[i])
- END ELSE BEGIN
- Window(X_min, Y_min - 1, X_max, Y_min);
- ClrScr;
- WriteLn(' Das Programm ist zu groß !!');
- Write(' Abbruch mit ESC');
- REPEAT
- c := ReadKey;
- IF c = #0 THEN c := ReadKey;
- UNTIL c = #27;
- Close(Datei);
- Cursor(1);
- TextMode(OrigMode);
- Halt(1);
- END;
- Close(Datei);
- END;
-
- PROCEDURE Vorbereiten;
- BEGIN
- Akt_Pos := 0;
- Ges_Pos := 0;
- Zeilenzahl := 0;
- Zeile_Anfang := 1;
- Akt_Zeile := 1;
- CheckBreak := FALSE;
- OrigMode := LastMode;
- TextMode(3);
- Cursor(0);
- Setze_Farbe(LightGray, Black);
- ClrScr;
- Laden;
- Setze_Farbe(LightGray, Blue);
- Window(X_min, Y_max + 6, X_max, Y_max + 9);
- ClrScr;
- Setze_Farbe(Blue, LightGray);
- Write(' Ctrl '#27,' ');
- Setze_Farbe(LightGray, Blue);
- Write(' an Anfang der Zeile ');
- Setze_Farbe(Blue, LightGray);
- Write(' Ctrl ',#26,' ');
- Setze_Farbe(LightGray, Blue);
- Write(' ans Ende der Zeile ');
- Setze_Farbe(Blue, LightGray);
- Write(' Home ');
- Setze_Farbe(LightGray, Blue);
- WriteLn(' an Anfang');
- Setze_Farbe(Blue, LightGray);
- Write(' ', #24, ' ');
- Setze_Farbe(LightGray,Blue);
- Write(' eine Zeile auf ');
- Setze_Farbe(Blue, LightGray);
- Write(' ',#25,' ');
- Setze_Farbe(LightGray, Blue);
- Write(' eine Zeile ab ');
- Setze_Farbe(Blue, LightGray);
- Write(' ESC ');
- Setze_Farbe(LightGray, Blue);
- WriteLn(' ENDE');
- Setze_Farbe(Blue, LightGray);
- Write (' ', #26, ' ');
- Setze_Farbe(LightGray, Blue);
- Write(' ein Zeichen rechts ');
- Setze_Farbe(Blue, LightGray);
- Write(' ',#27,' ');
- Setze_Farbe(LightGray, Blue);
- WriteLn(' ein Zeichen links ');
- Setze_Farbe(Blue, LightGray);
- Write(' PgUp ');
- Setze_Farbe(LightGray, Blue);
- Write(' eine Seite hoch ');
- Setze_Farbe(Blue, LightGray);
- Write(' PgDn ');
- Setze_Farbe(LightGray, Blue);
- Write(' eine Seite runter ');
- END;
-
- PROCEDURE Schreib(x : LongInt);
- BEGIN
- IF (Zeichen_Array^[x] < 32) OR
- ((Zeichen_Array^[x] > 126) AND
- (Zeichen_Array^[x] <> 129) AND
- (Zeichen_Array^[x] <> 132) AND
- (Zeichen_Array^[x] <> 148) AND
- (Zeichen_Array^[x] <> 142) AND
- (Zeichen_Array^[x] <> 153) AND
- (Zeichen_Array^[x] <> 154) AND
- (Zeichen_Array^[x] <> 225)) THEN
- Write('.')
- ELSE
- Write(Chr(Zeichen_Array^[x]));
- END;
-
- PROCEDURE Status;
- VAR
- x, y : INTEGER;
- BEGIN
- x := WhereX; y := WhereY;
- Setze_Farbe(Blue, LightGray);
- GotoXY(1,1); ClrEol;
- WriteLn(' Zeichen ', Akt_Pos:6, ' von ',
- Ges_Pos:6, ' Zeile ', Akt_Zeile:4, ' von ',
- Zeilenzahl:4);
- Setze_Farbe(LightGray, Blue);
- GotoXY(x,y)
- END;
-
- PROCEDURE Editieren;
- VAR
- a, e, i : LongInt;
-
- PROCEDURE Left;
- BEGIN
- IF Akt_Pos > 1 THEN
- IF WhereX > X_min THEN BEGIN
- Dec(Akt_Pos);
- GotoXY(WhereX - 1, WhereY);
- END;
- END;
-
- PROCEDURE Right;
- BEGIN
- IF Akt_Pos < Ges_Pos THEN
- IF WhereX < X_max THEN BEGIN
- Inc(Akt_Pos);
- GotoXY(WhereX + 1, WhereY);
- END;
- END;
-
- PROCEDURE Control_Left;
- BEGIN
- WHILE WhereX > X_min DO Left;
- END;
-
- PROCEDURE Control_Right;
- BEGIN
- WHILE(WhereX < X_max) AND (Akt_Pos < Ges_Pos) DO
- Right;
- END;
-
- PROCEDURE Down;
- VAR
- x, xx : INTEGER;
- i : LongInt;
- BEGIN
- IF Akt_Zeile < Zeilenzahl THEN
- IF Akt_Zeile < Zeile_Ende THEN BEGIN
- Inc(Akt_Pos, X_max);
- Inc(Akt_Zeile);
- GotoXY(WhereX, WhereY + 1);
- WHILE((Akt_Zeile-1)*X_max)+WhereX>Ges_Pos DO BEGIN
- GotoXY(WhereX - 1,WhereY);
- Dec(Akt_Pos);
- END;
- END ELSE
- IF Akt_Zeile = Zeile_Ende THEN BEGIN
- xx := WhereX;
- Inc(Zeile_Anfang);
- Inc(Zeile_Ende);
- GotoXY(X_min, Y_min);
- DelLine;
- GotoXY(X_min, Y_max);
- Akt_Pos := Akt_Zeile * X_max;
- Inc(Akt_Zeile);
- FOR i := Akt_Pos + 1 TO Akt_Pos + X_max DO
- IF i <= Ges_Pos THEN BEGIN
- Schreib(i);
- Inc(Akt_Pos);
- END;
- x := (Akt_Zeile - 1) * X_max;
- x := Akt_Pos - x;
- GotoXY(x, Y_max);
- WHILE WhereX > xx DO BEGIN
- GotoXY(WhereX - 1, Y_max);
- Dec(Akt_Pos);
- END;
- END;
- END;
-
- PROCEDURE Up;
- VAR
- x : INTEGER;
- a, i : LongInt;
- BEGIN
- IF WhereY > Y_min THEN BEGIN
- Dec(Akt_Pos, X_max);
- GotoXY(WhereX, WhereY - 1);
- Dec(Akt_Zeile);
- END ELSE
- IF Zeile_Anfang > 1 THEN BEGIN
- x := WhereX;
- Dec(Akt_Pos, X_max);
- Dec(Zeile_Anfang);
- Dec(Zeile_Ende);
- Dec(Akt_Zeile);
- a := (Zeile_Anfang-1) * X_max + 1;
- GotoXY(X_min, Y_max);
- DelLine;
- GotoXY(X_min, Y_min);
- InsLine;
- FOR i := a TO a + X_max - 1 DO Schreib(i);
- GotoXY( x,Y_min)
- END;
- END;
-
- BEGIN { Editieren }
- Akt_Zeile := 1;
- Akt_Pos := 1;
- Zeile_Anfang := 1;
- Zeilenzahl := Ges_Pos DIV X_max;
- IF Ges_Pos MOD X_max <> 0 THEN Inc(Zeilenzahl);
- Zeile_Ende := Zeile_Anfang + Y_max - Y_min;
- IF Zeile_Ende > Zeilenzahl THEN
- Zeile_Ende := Zeilenzahl;
- Setze_Farbe(LightGray, Blue);
- Window(X_min, Y_min + 2, X_max, Y_max + 4);
- ClrScr;
- GotoXY(X_min, Y_min);
- a := (Zeile_Anfang - 1) * X_max + 1;
- e := a + (Y_max - Y_min + 1) * X_max - 1;
- FOR i := a TO e DO
- IF i <= Ges_Pos THEN Schreib(i);
- Status;
- GotoXY(X_min, Y_min);
- REPEAT
- Cursor(2);
- Zeichen := ReadKey;
- IF Zeichen = #0 THEN BEGIN
- Zeichen := ReadKey;
- Cursor(0);
- CASE Zeichen of
- #71 : IF Zeile_Anfang > 1 THEN BEGIN { Home }
- Akt_Pos := 1;
- Akt_Zeile := 1;
- Zeile_Anfang := 1;
- Zeile_Ende := Zeile_Anfang + Y_max -Y_min;
- IF Zeile_Ende > Zeilenzahl THEN
- Zeile_Ende := Zeilenzahl;
- ClrScr;
- GotoXY(X_min, Y_min);
- a := (Zeile_Anfang - 1) * X_max + 1;
- e := a + (Y_max - Y_min + 1) * X_max - 1;
- FOR i := a TO e DO
- IF i <= Ges_Pos THEN Schreib(i);
- GotoXY(X_min, Y_min);
- END ELSE BEGIN
- Akt_Pos := 1;
- Akt_Zeile := 1;
- GotoXY(X_min, Y_min);
- END;
- #72 : Up; { Up }
- #73 : FOR a := Y_min - 1 TO Y_max - Y_min DO Up;
- #75 : Left;
- #77 : Right;
- #115: Control_Left;
- #116: Control_Right;
- #80 : Down;
- #81 : FOR a := Y_min - 1 TO Y_max - Y_min DO Down;
- END;
- END ELSE
- IF ((Zeichen IN [#32..#63,#65..#126,#129,#132,#148,
- #142,#153,#154,#225]) AND
- (Akt_Pos <= Ges_Pos)) THEN BEGIN
- geaendert := TRUE;
- Cursor(0);
- Write(Zeichen);
- Zeichen_Array^[Akt_Pos] := Ord(Zeichen);
- Inc(Akt_Pos);
- IF (WhereY = Y_max + 1) AND
- (Zeile_Ende < Zeilenzahl) THEN BEGIN
- GotoXY(X_max,Y_max);
- Down;
- END ELSE
- IF (WhereY = Y_max + 1) AND
- (Zeile_Ende = Zeilenzahl) THEN BEGIN
- GotoXY(X_max, Y_max);
- Dec(Akt_Pos);
- END ELSE
- IF Akt_Pos > Ges_Pos THEN BEGIN
- GotoXY(WhereX-1, WhereY);
- Dec(Akt_Pos);
- END;
- END ELSE Beep(400,100);
- Status;
- UNTIL Zeichen = #27;
- END;
-
- BEGIN { Main }
- geaendert := FALSE;
- Vorbereiten;
- Editieren;
- Beenden;
- END.
- (* ------------------------------------------------------ *)
- (* Ende von TPATCH.PAS *)