home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 08 / praxis / red.pas < prev   
Pascal/Delphi Source File  |  1990-07-05  |  17KB  |  526 lines
  1. (* ------------------------------------------------------ *)
  2. (*                         RED.PAS                        *)
  3. (*                File Redirection Utility                *)
  4. (*           Turbo-Pascal-Versionen 4.0 und 5.x           *)
  5. (*    Copyright (c) 1990  Karsten Gieselmann & TOOLBOX    *)
  6. (* ------------------------------------------------------ *)
  7. {$M 2048, 0, 512}
  8. {$B-,I-,R-,S-,V-}             (* keine Laufzeitprüfungen! *)
  9.  
  10. PROGRAM Red;
  11.  
  12. USES
  13.   Dos
  14.   {$IFDEF Ver40}
  15.     ,Dos_50     (* Kompatibilitäts-Unit aus Toolbox 12'89 *)
  16.   {$ENDIF};
  17.  
  18. CONST
  19.   Hotkey      = $1C0A; (* "Erweiterungs"-Taste: <CtrlRet> *)
  20.   MaxEntries  = 10;          (* Max. Suchtabelleneinträge *)
  21.   RedExt      : ExtStr = 'RED';         (* Standardsuffix *)
  22.  
  23. TYPE
  24.   StringPtr    = ^STRING;
  25.   RedTable     = ARRAY[1..MaxEntries] OF RECORD
  26.                    Mask, RedPath : StringPtr;
  27.                  END;
  28.   IntRegisters = RECORD CASE BYTE OF      (* CPU-Register *)
  29.                    1 : (BP,ES,DS,DI,SI,
  30.                         DX,CX,BX,AX,IP,CS,Flags : WORD);
  31.                    2 : (Dummy : ARRAY[1..5] OF WORD;
  32.                         DL,DH,CL,CH,BL,BH,AL,AH : BYTE);
  33.                  END;
  34.  
  35. VAR
  36.   Stack        : POINTER;       (* programmeigener Stapel *)
  37.   SaveInt16    : POINTER;     (* alter Tastatur-Interrupt *)
  38.   SaveInt2F    : POINTER;    (* alter Multiplex-Interrupt *)
  39.   Enabled      : BOOLEAN;             (* Umleitung aktiv? *)
  40.   Installed    : BOOLEAN;     (* Programm schon resident? *)
  41.   StackSwapped : BOOLEAN;        (* eigener Stapel aktiv? *)
  42.   Buffer       : STRING;               (* Universalpuffer *)
  43.   ProgName     : NameStr;        (* Kennung für Multiplex *)
  44.   RedName      : PathStr;   (* Name der aktuellen Tabelle *)
  45.   DefExt       : ExtStr;      (* aktuelles Standardsuffix *)
  46.   Redirection  : RedTable;                 (* Suchtabelle *)
  47.   LastEntry    : WORD;   (* Index letzter Tabelleneintrag *)
  48.  
  49. (* --------------------- Utilities ---------------------- *)
  50.  
  51. PROCEDURE SwapStackAndCall(    FarProc : POINTER;
  52.                                Stack   : POINTER;
  53.                            VAR Regs    : IntRegisters);
  54.   (* schaltet auf neuen Stapel um und ruft Routine auf *)
  55. INLINE($C6/$06/StackSwapped/$01/$9C/$59/$8C/$D0/$8E/$C0/
  56.        $58/$5A/$5B/$5F/$FA/$8E/$D7/$87/$E3/$51/$9D/$9C/$06/
  57.        $53/$52/$50/$26/$FF/$1F/$FA/$58/$5A/$59/$8E/$D2/$89/
  58.        $C4/$51/$9D/$83/$C4/$04/$C6/$06/StackSwapped/$00);
  59.  
  60. PROCEDURE ChainInt(VAR Regs   : IntRegisters;
  61.                        OldInt : POINTER);
  62.   (* beendet aktuelle Serviceroutine und setzt die Pro-
  63.      grammausführung bei der alten Interruptroutine fort  *)
  64. INLINE($5B/$58/$5E/$1F/$87/$5C/$0E/$87/$44/$10/$8B/$54/
  65.        $16/$52/$9D/$8C/$DA/$FA/$8E/$D2/$89/$F4/$FB/$5D/
  66.        $07/$1F/$5F/$5E/$5A/$59/$CB);
  67.  
  68. FUNCTION GetKey(Call : BYTE) : WORD;
  69.   (* ruft alten Tastaturinterrupt, um eine Taste zu holen *)
  70. INLINE($58/$86/$E0/$9C/$FF/$1E/SaveInt16);
  71.  
  72. PROCEDURE InterruptsOn;
  73.   (* erlaubt das Auslösen weiterer Interruptaufrufe       *)
  74. INLINE($FB);
  75.  
  76. FUNCTION PSP : WORD;
  77.   (* ermittelt das aktuelle Program Segment Prefix        *)
  78. INLINE($B4/$62/$CD/$21/$89/$D8);
  79.  
  80. FUNCTION InTextMode(VAR Col, Row : BYTE;
  81.                     VAR VideoRAM : Pointer) : BOOLEAN;
  82.   (* prüft, ob momentan ein Textmodus aktiv ist und ermit-
  83.      telt die aktuelle Cursorposition sowie die von der
  84.      Seite abhängige Bildschirmspeicher-Adresse. Der Ein-
  85.      fachheit halber werden nur 80x25-Modi unterstützt;
  86.      eine Unterscheidung zwischen Text/Grafik bei Mono-
  87.      chrom-Systemen (Hercules) ist hier nicht möglich.    *)
  88. CONST
  89.   Segment : ARRAY[FALSE..TRUE] OF WORD = ($B800, $B000);
  90. VAR
  91.   Regs : Registers;
  92.   Seg  : WORD;
  93. BEGIN
  94.   WITH Regs DO BEGIN
  95.     AH := $0F;                           (* "Read Status" *)
  96.     Intr($10, Regs);
  97.     InTextMode := (AL <= 3) OR (AL = 7);
  98.     VideoRAM := Ptr(Segment[AL=7]+$200*BH, 0);
  99.     AH := $03;
  100.     Intr($10, Regs);                      (* "Get Cursor" *)
  101.     Col := Succ(DL);    (* Umrechnung von 0..79 auf 1..80 *)
  102.     Row := Succ(DH);    (* Umrechnung von 0..24 auf 1..25 *)
  103.   END;
  104. END;
  105.  
  106. FUNCTION HasWildCards(VAR St : STRING) : BOOLEAN;
  107.   (* prüft, ob ein String Wildcardzeichen (*,?) enthält   *)
  108. BEGIN
  109.   HasWildCards := (Pos('?', St) > 0) OR (Pos('*', St) > 0);
  110. END;
  111.  
  112. PROCEDURE DefaultExtension(VAR FileName : PathStr;
  113.                            VAR DefExt   : ExtStr);
  114.   (* verbindet einen Dateinamen mit einem Standardsuffix,
  115.      falls die Namensangabe keine Erweiterung enthält.    *)
  116. VAR
  117.   Dir : DirStr;
  118.   Name : NameStr;
  119.   Ext : ExtStr;
  120. BEGIN
  121.   FSplit(FileName, Dir, Name, Ext);
  122.   IF Ext = '' THEN
  123.     FileName := Dir + Name + '.' + DefExt;
  124. END;
  125.  
  126. PROCEDURE UpperCase(VAR St : STRING);
  127.   (* konvertiert eine Zeichenkette in Großbuchstaben      *)
  128. VAR
  129.   i : BYTE;
  130. BEGIN
  131.   FOR i:=1 TO Length(St) DO
  132.     St[i] := UpCase(St[i]);
  133. END;
  134.  
  135. FUNCTION SubStringToHeap(a, b : BYTE) : POINTER;
  136.   (* legt den von führenden und folgenden Blanks befrei-
  137.      ten Teilstring Buffer[a..b] auf dem Heap ab          *)
  138. VAR
  139.   S : StringPtr;
  140. BEGIN
  141.   WHILE (a <= b) AND (Buffer[a] <= ' ') DO Inc(a);
  142.   WHILE (b >= a) AND (Buffer[b] <= ' ') DO Dec(b);
  143.   IF a <= b THEN BEGIN
  144.     GetMem(S, b-a+2);
  145.     S^[0] := Chr(b-a+1);
  146.     Move(Buffer[a], S^[1], b-a+1);
  147.   END ELSE BEGIN
  148.     GetMem(S, 1);
  149.     S^[0] := #0;
  150.   END;
  151.   SubStringToHeap := S;
  152. END;
  153.  
  154. (* ------------ Pattern-Matching-Algorithmus ------------ *)
  155.  
  156. FUNCTION Match(VAR Source, Pattern : STRING) : BOOLEAN;
  157.   (* prüft, ob die durch "Pattern" gegebene Zeichenkette,
  158.      die beliebig mit Wildcards "?" (ein Zeichen) und "*"
  159.      (beliebig viele Zeichen) durchsetzt sein kann, mit
  160.      "Source" (darf keine Wildcards enthalten!) überein-
  161.      stimmt. Groß- und Kleinschreibung werden dabei nicht
  162.      unterschieden.
  163.      Beispiel:  "T*B?x*SP??Z*" stimmt mit
  164.                 "Toolbox ist Spitze!" überein.            *)
  165. TYPE
  166.   Result = (Failed, Passed, Scanning);
  167. VAR
  168.   PatternLen : BYTE ABSOLUTE Pattern;
  169.   SourceLen  : BYTE ABSOLUTE Source;
  170.  
  171.   FUNCTION MatchSubString(s : BYTE; p : BYTE) : Result;
  172.     (* rekursiver Test auf Übereinstimmung der Teilstrings
  173.        ab Pattern[p], Source[s]. Trotz Rekursion wird der
  174.        Laufzeitstapel nur minimal belastet, da lokale und
  175.        formale Parameter zusammen gerade 3 Bytes belegen! *)
  176.   VAR
  177.     State : Result;
  178.   BEGIN
  179.     IF PatternLen = 0 THEN   (* triviale Übereinstimmung: *)
  180.       State := Passed                   (* leeres Muster! *)
  181.     ELSE BEGIN
  182.       State := Scanning;
  183.       REPEAT
  184.         IF  (s > SourceLen)      (* Muster und Zeichen... *)
  185.         AND (p > PatternLen) THEN      (* ...abgearbeitet *)
  186.           State := Passed
  187.         ELSE IF p > PatternLen THEN
  188.           State := Failed  (* Muster vorzeitig erschöpft! *)
  189.         ELSE IF Pattern[p] = '*' THEN
  190.           IF p = PatternLen THEN  (* Joker entspricht.... *)
  191.             State := Passed      (* ...restlichen Zeichen *)
  192.           ELSE
  193.             REPEAT            (* rekursiver Restvergleich *)
  194.               State := MatchSubString(s, p+1);
  195.               Inc(s);
  196.             UNTIL (State = Passed) OR (s > SourceLen)
  197.         ELSE IF (Upcase(Pattern[p]) <> Upcase(Source[s]))
  198.         AND (Pattern[p] <> '?') THEN
  199.           State := Failed        (* keine Übereinstimmung *)
  200.         ELSE BEGIN
  201.           Inc(s);    (* Übereinstimmung, nächstes Zeichen *)
  202.           Inc(p);
  203.         END;
  204.       UNTIL State <> Scanning;
  205.     END;
  206.     MatchSubString := State;
  207.   END;
  208.  
  209. BEGIN
  210.   Match := (MatchSubString(1, 1) = Passed);
  211. END;
  212.  
  213. (* ------------------- Konfiguration -------------------- *)
  214.  
  215. PROCEDURE SignOn;
  216.   (* Versions- und Copyrightmeldung                       *)
  217. BEGIN
  218.   WriteLn;
  219.   WriteLn('File Redirection Utility, Version 1.00');
  220.   WriteLn('Copyright (c) 1990  K.Gieselmann & toolbox');
  221.   WriteLn;
  222. END;
  223.  
  224. PROCEDURE GetHelp;
  225.   (* Anzeige eines Hilfsbildschirms                       *)
  226. BEGIN
  227.   Write(
  228.    'Syntax:    RED  ?|+|-   oder   RED Datei [.Suffix]'^M^J,
  229.    'Parameter:'^M^J,
  230.    '  ?        zeigt diesen Text an'^M^J,
  231.    '  +        aktiviert geladene Suchtabelle'^M^J,
  232.    '  -        setzt Suchtabelle außer Kraft'^M^J,
  233.    '  Datei    lädt neue Suchtabelle aus Datei'^M^J,
  234.    '  Suffix   Standardsuffix für Dateinamen'^M^J);
  235.   IF NOT Installed THEN Halt;
  236. END;
  237.  
  238. PROCEDURE ShowStatus;
  239.   (* Anzeige der momentanen Programm-Konfiguration        *)
  240. CONST
  241.   Status : ARRAY[FALSE..TRUE] OF STRING[6]
  242.          = ('passiv', 'aktiv');
  243. BEGIN
  244.   IF RedName <> '' THEN BEGIN
  245.     Write('Tabelle ', RedName,
  246.           ' geladen und ', Status[Enabled]);
  247.   END ELSE BEGIN
  248.     Write('Keine Tabelle geladen');
  249.   END;
  250.   IF DefExt = '' THEN
  251.     WriteLn(', kein Standardsuffix definiert.')
  252.   ELSE BEGIN
  253.     WriteLn(', Standardsuffix ist .', DefExt);
  254.   END;
  255. END;
  256.  
  257. PROCEDURE LoadTable(VAR Path : PathStr);
  258.   (* lädt eine neue Suchtabelle aus "Path"                *)
  259. VAR
  260.   p : WORD;
  261. BEGIN
  262.   Release(HeapOrg);
  263.   LastEntry := 0;
  264.   DefaultExtension(Path, RedExt);
  265.   Assign(Input, Path); Reset(Input);
  266.   IF IoResult = 0 THEN BEGIN
  267.     WHILE NOT EoF(Input)
  268.     AND (LastEntry < MaxEntries) DO BEGIN
  269.       ReadLn(Input, Buffer);
  270.       p := Pos('=', Buffer);
  271.       IF p > 0 THEN BEGIN
  272.         Inc(LastEntry);
  273.         IF MaxAvail > Length(Buffer) THEN BEGIN
  274.           WITH Redirection[LastEntry] DO BEGIN
  275.             Mask := SubStringToHeap(1, p-1);
  276.             RedPath := SubStringToHeap(p+1, Length(Buffer));
  277.           END;
  278.         END;
  279.       END;
  280.     END;
  281.     Close(Input);
  282.     Buffer := '';
  283.     Enabled := TRUE;
  284.   END ELSE BEGIN
  285.     RedName := '';
  286.     WriteLn('Datei nicht gefunden!');
  287.   END;
  288. END;
  289.  
  290. {$F+}
  291. PROCEDURE Configure(VAR Regs : IntRegisters);
  292.   (* wertet die per Kommandozeile gemachten Angaben aus   *)
  293. VAR
  294.   Argument : PathStr;
  295. BEGIN
  296.   SignOn;
  297.   Argument := ParamStr(1);
  298.   IF Argument <> '' THEN BEGIN
  299.          IF Argument = '?' THEN GetHelp
  300.     ELSE IF Argument = '+' THEN Enabled := TRUE
  301.     ELSE IF Argument = '-' THEN Enabled := FALSE
  302.     ELSE BEGIN
  303.       RedName := Argument;
  304.       UpperCase(RedName);
  305.       LoadTable(RedName);
  306.       Argument := ParamStr(2);
  307.       IF Argument[1] = '.' THEN
  308.         DefExt := Copy(Argument, 2, 3)
  309.       ELSE BEGIN
  310.         DefExt := Copy(Argument, 1, 3);
  311.       END;
  312.       UpperCase(DefExt);
  313.     END;
  314.   END;
  315.   IF NOT Installed THEN
  316.     WriteLn('Programm resident installiert.')
  317.   ELSE IF (Argument <> '?') THEN BEGIN
  318.     ShowStatus;
  319.   END;
  320. END;
  321. {$F-}
  322.  
  323. (* -------------- Ausgedehnte Dateisuche ---------------- *)
  324.  
  325. FUNCTION Grab(VAR St : STRING) : BOOLEAN;
  326. (* liest eine Zeichenkette vom Bildschirm rückwärts, be-
  327.    ginnend bei der momentanen Cursorposition; der Lesevor-
  328.    gang wird abgebrochen, wenn der linke Bildschirmrand
  329.    erreicht ist oder das letzte gelesene Zeichen definitiv
  330.    das Ende eines Dateinamens kennzeichnet ("Delimiters") *)
  331. TYPE
  332.   TextScreen = ARRAY[1..25, 1..80] OF RECORD
  333.                  Character, Attribute : CHAR
  334.                END;
  335. CONST
  336.   Delimiters : SET OF CHAR =
  337.                  [#0..#32, '│', '>', '<', '|', '+', '/'];
  338. VAR
  339.   Screen : ^TextScreen;
  340.   Ch : CHAR;
  341.   Row, Col : BYTE;
  342.   Delimiter : BOOLEAN;
  343. BEGIN
  344.   St := '';
  345.   IF InTextMode(Col, Row, Pointer(Screen)) THEN
  346.     IF Col > 1 THEN BEGIN
  347.       REPEAT
  348.         Dec(Col);
  349.         Ch := Screen^[Row, Col].Character;
  350.         Delimiter := (Ch IN Delimiters);
  351.         If NOT Delimiter THEN St := Ch + St;
  352.       UNTIL Delimiter
  353.          OR ((Length(St) > 1) AND (St[2]=':'))
  354.          OR (Col = 1);
  355.     END;
  356.   Grab := (St <> '');
  357. END;
  358.  
  359. FUNCTION Expand(VAR FileName : PathStr) : BOOLEAN;
  360.   (* durchsucht Festplatte/Diskette entsprechend den in
  361.      der Suchtabelle spezifizierten Angaben nach der
  362.      durch "FileName" bezeichneten Datei. Im Erfolgsfall
  363.      wird der vollständige Pfadname zurückgegeben.        *)
  364. VAR
  365.   Count : WORD;
  366.   a, b, p : BYTE;
  367.   found : BOOLEAN;
  368.   Path : PathStr;
  369. BEGIN
  370.   Expand := FALSE;
  371.   IF (FileName <> '')
  372.   AND NOT HasWildCards(FileName) THEN BEGIN
  373.     found := FALSE;
  374.     Count := 1;
  375.     DefaultExtension(FileName, DefExt);
  376.     WHILE (Count <= LastEntry) AND NOT found DO BEGIN
  377.       WITH Redirection[Count] DO BEGIN
  378.         IF Match(FileName, Mask^) THEN BEGIN
  379.           Buffer := RedPath^;
  380.           WHILE (Buffer <> '') AND NOT found DO BEGIN
  381.             p := Pos(';', Buffer);
  382.             IF p = 0 THEN p := Succ(Length(Buffer));
  383.             a := 1;  b := p-1;
  384.             WHILE (a <= b) AND (Buffer[a] <= ' ') DO Inc(a);
  385.             WHILE (b >= a) AND (Buffer[b] <= ' ') DO Dec(b);
  386.             IF b >= a THEN BEGIN
  387.               Path := Copy(Buffer, a, Succ(b-a));
  388.               IF Buffer[b] <> '\' THEN Path := Path + '\';
  389.             END ELSE BEGIN
  390.               Path := '';
  391.             END;
  392.             Delete(Buffer, 1, p);
  393.             Assign(Input, Path + FileName); Reset(Input);
  394.             found := (IoResult = 0);
  395.             IF found THEN BEGIN
  396.               FileName := Path + FileName;
  397.               Expand := TRUE;
  398.             END;
  399.           END;
  400.         END;
  401.       END;
  402.       Inc(Count);
  403.     END;
  404.   END;
  405. END;
  406.  
  407. {$F+}
  408. PROCEDURE FetchKey(VAR Regs : IntRegisters);
  409.   (* holt den nächsten Tastencode aus dem Puffer bzw. von
  410.      der Tastatur, falls der Puffer keine Daten enthält.  *)
  411. VAR
  412.   CheckKbd : BOOLEAN;
  413.   Call, DelNum : BYTE;
  414.   FileName : PathStr;
  415. BEGIN
  416.   WITH Regs DO BEGIN
  417.     Call := AH;
  418.     CheckKbd := (Call and $EF = 1);
  419.     REPEAT
  420.       IF Buffer <> '' THEN BEGIN
  421.         AX := Ord(Buffer[1]);
  422.         IF CheckKbd THEN
  423.           Flags := Flags AND NOT FZero
  424.         ELSE
  425.           Delete(Buffer, 1, 1);
  426.       END ELSE BEGIN
  427.         AX := GetKey(Call);
  428.         IF AX = Hotkey THEN BEGIN
  429.           IF Grab(FileName) THEN BEGIN
  430.             DelNum := Length(FileName);
  431.             IF Expand(FileName) THEN BEGIN
  432.               FillChar(Buffer[1], DelNum, ^H);
  433.               Buffer[0] := Chr(DelNum);
  434.               Buffer := Buffer + FileName + ^M
  435.             END ELSE BEGIN
  436.               Buffer := ^M;
  437.             END;
  438.           END;
  439.         END;
  440.       END;
  441.     UNTIL AX <> Hotkey;
  442.   END;
  443. END;
  444. {$F-}
  445.  
  446. (* --------------- Interrupt-Management ----------------- *)
  447.  
  448. PROCEDURE Int16(BP : Word); INTERRUPT;
  449.   (* neue Service-Routine für den Tastatur-Interrupt      *)
  450. VAR
  451.   Regs : IntRegisters ABSOLUTE BP;
  452. BEGIN
  453.   InterruptsOn;
  454.   IF ((Regs.AH AND $EF = 0)
  455.    OR (Regs.AH AND $EF = 1) AND (Buffer <> ''))
  456.   AND Enabled AND NOT StackSwapped THEN
  457.     SwapStackAndCall(@FetchKey, Stack, Regs)
  458.   ELSE BEGIN
  459.     ChainInt(Regs, SaveInt16);
  460.   END;
  461. END;
  462.  
  463. PROCEDURE Int2F(BP : Word); INTERRUPT;
  464.   (* neue Service-Routine für den Multiplex-Interrupt     *)
  465. VAR
  466.   Regs : IntRegisters ABSOLUTE BP;
  467. BEGIN
  468.   InterruptsOn;
  469.   WITH Regs DO BEGIN
  470.     IF NOT StackSwapped               (* nicht reentrant! *)
  471.     AND (AH = $AE) AND (AL <= $01) AND (DX = $FFFF)
  472.     AND (String(Ptr(DS, SI)^) = ProgName) THEN
  473.       IF AL = $00 THEN
  474.         AL := $FF          (* Stufe 1: Kommando erkannt   *)
  475.       ELSE BEGIN           (* Stufe 2: Kommando ausführen *)
  476.         (* Standardausgabe von COMMAND.COM übernehmen:    *)
  477.         Mem[PrefixSeg:$19] := Mem[PSP:$19];
  478.         (* Kommando-Parameter von COMMAND.COM kopieren:   *)
  479.         Move(Mem[DS:$80],
  480.              Mem[PrefixSeg:$80], Mem[DS:$80]+1);
  481.         (* Stapel umschalten und Programm abarbeiten:     *)
  482.       SwapStackAndCall(@Configure, Stack, Regs);
  483.       Mem[DS:SI] := $00;     (* Flag: Kommando ausgeführt *)
  484.     END ELSE BEGIN
  485.       ChainInt(Regs, SaveInt2F);   (* weiter in der Kette *)
  486.     END;
  487.   END;
  488. END;
  489.  
  490. (* ------------------- Installation --------------------- *)
  491.  
  492. PROCEDURE Install;
  493.   (* Initialisierung der Variablen, Erstkonfiguration und
  494.      Installation der beiden Interrupt-Serviceroutinen.   *)
  495. VAR
  496.   Dummy : IntRegisters;
  497. BEGIN
  498.   Installed := FALSE;
  499.   Enabled := TRUE;
  500.   StackSwapped := FALSE;
  501.   FSplit(ParamStr(0), Buffer, ProgName, Buffer);
  502.   Stack := Ptr(SSeg, SPtr-$64);
  503.   FileMode := 0;
  504.   LastEntry := 0;
  505.   RedName := '';
  506.   DefExt := '';
  507.   Configure(Dummy);
  508.   Buffer := '';
  509.   GetIntVec($16, SaveInt16);
  510.   GetIntVec($2F, SaveInt2F);
  511.   SetIntVec($00, SaveInt00);
  512.   {$IFNDEF Ver40}
  513.     SetIntVec($3F, SaveInt3F);
  514.   {$ENDIF}
  515.   SetIntVec($16, @Int16);
  516.   SetIntVec($2F, @Int2F);
  517.   Installed := TRUE;
  518.   Keep(0);
  519. END;
  520.  
  521. BEGIN
  522.   Install;
  523. END.
  524. (* ------------------------------------------------------ *)
  525. (*                   Ende von RED.PAS                     *)
  526.