home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 08 / tricks / schloss.pas < prev    next >
Pascal/Delphi Source File  |  1990-07-05  |  14KB  |  429 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      SCHLOSS.PAS                       *)
  3. (*            Codierung von Pascal-Programmen             *)
  4. (*       (c) 1990 P.Kurzweil, A.Dengler & TOOLBOX         *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM Schloss;
  7.  
  8. USES Crt;
  9.  
  10. CONST
  11.   maxvar = 500;
  12.   hfil   = 'SCHLOSS.HLP';
  13.   p      = 65;
  14.  
  15.   cmd    : ARRAY [1..p] OF STRING [15] =
  16.            ('ABSOLUTE', 'AND', 'ARRAY', 'BEGIN', 'CASE',
  17.             'CONST', 'DIV', 'DO', 'DOWNTO', 'ELSE', 'END',
  18.             'EXTERNAL', 'FILE', 'FOR', 'FORWARD',
  19.             'FUNCTION', 'GOTO', 'IF', 'IMPLEMENTATION',
  20.             'IN', 'INLINE', 'INTERFACE', 'INTERRUPT',
  21.             'LABEL', 'MOD', 'NIL', 'NOT', 'OF', 'OR',
  22.             'PACKED', 'PROCEDURE', 'PROGRAM', 'RECORD',
  23.             'REPEAT', 'SET', 'SHL', 'SHR', 'STRING', 'THEN',
  24.             'TO', 'TYPE', 'UNIT', 'UNTIL', 'USES', 'VAR',
  25.             'WHILE', 'WITH', 'XOR', 'REAL', 'SINGLE',
  26.             'DOUBLE', 'EXTENDED', 'COMP', 'INTEGER',
  27.             'SHORTINT', 'LONGINT', 'BYTE', 'WORD',
  28.             'BOOLEAN', 'CHAR', 'TEXT', 'CRT', 'DOS',
  29.             'PRINTER', 'GRAPH');
  30. TYPE
  31.   strg        = STRING [30];        { Länge der Bezeichner }
  32.   Varnamen    = ARRAY [1..maxvar] OF strg;
  33.   Varnamenptr = ^Varnamen;
  34.  
  35. VAR
  36.   varalt,
  37.   varaltup,
  38.   varneu      : Varnamenptr;        { Variablennamen       }
  39.   quelle,
  40.   ziel, hilf,
  41.   xref        : TEXT;
  42.   qfil, zfil,
  43.   xfil,
  44.   schluessel  : STRING [40];
  45.   nvar,
  46.   nstart,
  47.   wahl,
  48.   methode     : WORD;
  49.   s, sup      : strg;
  50.  
  51.   PROCEDURE PointerInit;
  52.   { Speicherplatz für Variablen reservieren }
  53.   VAR
  54.     size : LONGINT;
  55.   BEGIN
  56.     size := SizeOf(Varnamen);
  57.     IF MaxAvail < (3 * size) THEN BEGIN
  58.       Write('Nicht genügend Speicher!');  Halt(1);
  59.     END;
  60.     varalt := NIL;  varaltup := NIL;  varneu := NIL;
  61.     GetMem(varalt,   size);
  62.     GetMem(varaltup, size);
  63.     GetMem(varneu,   size);
  64.   END {PointerInit};
  65.  
  66.   PROCEDURE KommentareEntfernen;               { Schritt 1 }
  67.   VAR
  68.     ch : CHAR;
  69.   BEGIN
  70.     Assign(quelle, qfil);  Reset(quelle);
  71.     Assign(hilf,   hfil);  Rewrite(hilf);
  72.     WHILE NOT EOF(quelle) DO BEGIN
  73.       Read(quelle, ch);
  74.       CASE ch OF
  75.         #39: BEGIN                             { 1. String }
  76.                Write(hilf, #39);
  77.                REPEAT
  78.                  Read(quelle, ch);  Write(hilf, ch);
  79.                UNTIL ch = #39;
  80.              END;
  81.         '{': BEGIN
  82.                REPEAT
  83.                  Read(quelle, ch);
  84.                UNTIL ch <> #32;
  85.                IF ch = '$' THEN
  86.                  Write(hilf, #123 + '$')
  87.                                       { 2a. Compileroption }
  88.                ELSE
  89.                  REPEAT
  90.                    Read(quelle, ch);
  91.                  UNTIL ch = #125;     { 2b. Kommentar      }
  92.              END;
  93.         '(': BEGIN
  94.                Read(quelle, ch);
  95.                CASE ch OF
  96.                  '*': BEGIN           { 3a. Compileroption }
  97.                         Read(quelle, ch);
  98.                         IF ch = '$' THEN BEGIN
  99.                           Write(hilf, #123 + '$');
  100.                           WHILE ch <> '*' DO BEGIN
  101.                             Read(quelle, ch);
  102.                             IF ch <> '*' THEN
  103.                               Write(hilf, ch);
  104.                           END;
  105.                           REPEAT
  106.                             Read(quelle, ch);
  107.                           UNTIL ch = ')';
  108.                           Write(hilf, #125);
  109.                         END ELSE BEGIN
  110.                           REPEAT      { 3b. Kommentar      }
  111.                             REPEAT
  112.                               Read(quelle, ch);
  113.                             UNTIL ch = '*';
  114.                             Read(quelle, ch);
  115.                           UNTIL ch = ')';
  116.                         END;
  117.                       END;
  118.                  #39: BEGIN         { 4. Menge von Strings }
  119.                         Write(hilf, '(' + #39);
  120.                         REPEAT
  121.                           Read(quelle, ch);
  122.                           Write(hilf, ch);
  123.                         UNTIL ch = #39;
  124.                       END;
  125.                ELSE               { 5. gewöhnliche Klammer }
  126.                  Write(hilf, '(' + ch);
  127.                END;
  128.              END;
  129.       ELSE
  130.         Write(hilf, ch);
  131.       END;
  132.     END;
  133.     Close(hilf);  Close(quelle);
  134.   END {KommentareEntfernen};
  135.  
  136.   PROCEDURE VariablenSuche;                    { Schritt 2 }
  137.   VAR
  138.     ch                            : CHAR;
  139.     i                             : BYTE;
  140.     Stop, Pascalwort, Deklaration : BOOLEAN;
  141.  
  142.     PROCEDURE WortLesen;
  143.     BEGIN
  144.       REPEAT
  145.         Read(hilf, ch);
  146.         Stop := (ch = #26);
  147.         IF Stop THEN Exit {WortLesen};            { 1. EOF }
  148.         IF ch IN ['A'..'Z', 'a'..'z'] THEN BEGIN
  149.                                            { 2. Bezeichner }
  150.           s := ch;  sup := UpCase(ch);
  151.           REPEAT
  152.             Read(hilf, ch);
  153.             s := s + ch;  sup := sup + UpCase(ch);
  154.           UNTIL NOT
  155.                 (ch IN ['A'..'Z', 'a'..'z', '0'..'9', '_']);
  156.           Delete(s,   Length(s),   1);
  157.           Delete(sup, Length(sup), 1);
  158.         END;
  159.         IF ch = #39 THEN
  160.           REPEAT
  161.             Read(hilf, ch);
  162.           UNTIL ch = #39;                      { 3. String }
  163.       UNTIL s[1] IN ['A'..'Z', 'a'..'z'];
  164.     END {WortLesen};
  165.  
  166.     PROCEDURE Entdoppeln;
  167.                         { doppelte Bezeichner aussortieren }
  168.     VAR
  169.       k : WORD;
  170.     BEGIN
  171.       IF nvar < 2 THEN Exit {Entdoppeln};
  172.       FOR k := 1 TO nvar-1 DO BEGIN
  173.         IF varaltup^[k] = varaltup^[nvar] THEN BEGIN
  174.           nvar := nvar - 1;  Exit {Entdoppeln};
  175.         END;
  176.       END;
  177.     END {Entdoppeln};
  178.  
  179.   BEGIN
  180.     Assign(hilf, hfil);  Reset(hilf);
  181.     REPEAT
  182.       WortLesen;
  183.       Deklaration := ((sup = 'CONST')     OR
  184.                       (sup = 'FUNCTION')  OR
  185.                       (sup = 'PROCEDURE') OR
  186.                       (sup = 'PROGRAM')   OR
  187.                       (sup = 'RECORD')    OR
  188.                       (sup = 'TYPE')      OR
  189.                       (sup = 'VAR'));
  190.       IF Deklaration AND (NOT Stop) THEN BEGIN
  191.         REPEAT                          { Deklarationsteil }
  192.           WortLesen;
  193.           i := 0;
  194.           REPEAT
  195.             i := i + 1;
  196.             Pascalwort := (sup = cmd[i]);
  197.           UNTIL Pascalwort OR (i >= p);
  198.           IF (NOT Pascalwort) AND
  199.              (nvar < maxvar) THEN BEGIN
  200.             nvar := nvar + 1;
  201.             varalt^[nvar] := s;
  202.             varaltup^[nvar] := sup;
  203.             Entdoppeln;
  204.           END;
  205.         UNTIL Stop OR (sup = 'BEGIN');    { Anweisungsteil }
  206.       END;
  207.     UNTIL Stop;
  208.     Close(hilf);
  209.   END {VariablenSuche};
  210.  
  211.   PROCEDURE NeueBezeichner;                    { Schritt 3 }
  212.   VAR
  213.     i, fac, len : WORD;
  214.  
  215.     FUNCTION Kennung(x, xmax : WORD) : strg;
  216.                                  { Variablennamen erzeugen }
  217.     CONST
  218.       n = 5;  b : STRING [n] = '0O1Il';
  219.                           { Null, Oscar, Eins, India, Lima }
  220.                           { 5-er System                    }
  221.     VAR
  222.       i, j, k, c, h : WORD;
  223.       s             : strg;
  224.     BEGIN
  225.       s := '';
  226.       k := Trunc(Ln(xmax) / Ln(n) + 1);
  227.                                        { Länge der Kennung }
  228.       FOR i := k-1 DOWNTO 0 DO BEGIN
  229.         h := 1;
  230.         IF i > 0 THEN BEGIN
  231.           h := n;
  232.           FOR j := 2 TO i DO h := h * n;
  233.         END;                                         { n^i }
  234.         c := x DIV h;
  235.         x := x MOD h;
  236.         s := s + b[c+1];
  237.       END;
  238.       WHILE (s[1] = b[1]) AND (Length(s) > 1) DO
  239.         Delete(s, 1, 1);        { Oh, oh: führende Null... }
  240.       Kennung := s;
  241.     END {Kennung};
  242.  
  243.   BEGIN
  244.     Assign(xref, xfil);  Rewrite(xref);
  245.     FOR i := 1 TO nstart DO
  246.       WriteLn(xref, varalt^[i], #32, varneu^[i]);
  247.     FOR i := nstart+1 TO nvar DO BEGIN
  248.       CASE methode OF
  249.         1: BEGIN
  250.              Str(i, s);
  251.              varneu^[i] := schluessel + s;
  252.            END;                         { Numerische Namen }
  253.         2: varneu^[i] := schluessel + Kennung(i, nvar);
  254.                                        { Permutationsnamen }
  255.       END;
  256.       WriteLn(xref, varalt^[i], #32, varneu^[i]);
  257.     END;
  258.     Close(xref);
  259.   END {NeueBezeichner};
  260.  
  261.   PROCEDURE Umbenennen(filename : strg);       { Schritt 4 }
  262.   VAR
  263.     a     : strg;
  264.     ch    : CHAR;
  265.     Stop  : BOOLEAN;
  266.     i     : WORD;
  267.     alpha : BOOLEAN;
  268.   BEGIN
  269.     Assign(ziel, zfil);     Rewrite(ziel);
  270.     Assign(hilf, filename); Reset(hilf);
  271.     REPEAT
  272.       s := '';  a := '';
  273.       REPEAT
  274.         Read(hilf, ch);
  275.         alpha := ch IN ['A'..'Z', 'a'..'z', '0'..'9', '_'];
  276.                                           { Wort oder Zahl }
  277.         IF alpha THEN BEGIN
  278.           a := a + ch;
  279.           s := s + UpCase(ch);
  280.         END;
  281.         IF ch = #39 THEN BEGIN                    { String }
  282.           Write(ziel, ch);
  283.           alpha := TRUE;
  284.           REPEAT
  285.             Read(hilf, ch);  Write(ziel, ch);
  286.           UNTIL ch = #39;
  287.         END;
  288.         IF ch = #123 THEN BEGIN           { Compileroption }
  289.           Write(ziel, ch);
  290.           alpha := TRUE ;
  291.           REPEAT
  292.             Read(hilf, ch);  Write(ziel, ch);
  293.           UNTIL ch = #125;
  294.         END;
  295.       UNTIL NOT alpha;                          { Wortende }
  296.       Stop := ((s = 'END') AND (ch = '.')) OR (ch = #26);
  297.                                                      { EOF }
  298.       IF (NOT Stop) AND (s[1] IN ['A'..'Z']) THEN BEGIN
  299.         i := 0;                        { Variable ersetzen }
  300.         REPEAT
  301.           i := i + 1;
  302.           IF s = varaltup^[i] THEN BEGIN
  303.             a := varneu^[i];
  304.             i := nvar;
  305.             Write('.');
  306.           END;
  307.         UNTIL i >= nvar;
  308.       END;
  309.       Write(ziel, a + ch);
  310.     UNTIL Stop;
  311.     Close(hilf);  Close(ziel);
  312.   END {Umbenennen};
  313.  
  314.   PROCEDURE CrossreferenceLesen(VAR varneu,
  315.                                     varalt : Varnamenptr);
  316.   VAR
  317.     s    : STRING;
  318.     i, j : WORD;
  319.     x    : strg;
  320.   BEGIN
  321.     Assign(xref, xfil);  Reset(xref);
  322.     WHILE NOT EOF(xref) DO BEGIN
  323.       ReadLn(xref, s);  nvar := nvar + 1;
  324.       i := 1;
  325.       WHILE (s[i] IN ['a'..'z', '0'..'9', 'A'..'Z', '_']) DO
  326.         i := i + 1;
  327.       varneu^[nvar] := Copy(s, 1, i-1);
  328.       Delete(s, 1, i);
  329.       WHILE NOT
  330.             (s[1] IN ['a'..'z', '0'..'9', 'A'..'Z', '_']) DO
  331.         Delete(s, 1, 1);
  332.       varalt^[nvar] := Copy(s, 1, Length(s));
  333.     END;
  334.     Close(xref);
  335.   END {CrossreferenceLesen};
  336.  
  337.   PROCEDURE Varaltupper;    { Umwandlung in Großbuchstaben }
  338.   VAR
  339.     i, j : WORD;
  340.     x    : strg;
  341.   BEGIN
  342.     FOR i := 1 TO nvar DO BEGIN
  343.       varaltup^[i] := '';
  344.       x := varalt^[i];
  345.       FOR j := 1 TO Length(x) DO
  346.         varaltup^[i] := varaltup^[i] + UpCase(x[j]);
  347.     END;
  348.   END {Varaltupper};
  349.  
  350.   PROCEDURE LeerzeilenEntfernen;               { Schritt 5 }
  351.   VAR
  352.     s, s2 : STRING;
  353.   BEGIN
  354.     Assign(quelle, zfil);  Reset(quelle);
  355.     Assign(hilf,   hfil);  Rewrite(hilf);
  356.     WHILE NOT EOF(quelle) DO BEGIN
  357.       Readln(quelle, s);
  358.       WHILE s[Length(s)] = #32 DO Delete(s, Length(s), 1);
  359.       IF (Length(s) > 0) THEN WriteLn(hilf, s);
  360.     END;
  361.     Close(quelle);  Close(hilf);
  362.     Assign(ziel, zfil);  Erase(ziel);  Rename(hilf, zfil);
  363.   END {LeerzeilenEntfernen};
  364.  
  365. BEGIN
  366.   PointerInit;  nstart := 0;  nvar := 0;
  367.   ClrScr;  WriteLn('SCHLOSS - versteckt Variablen', #13#10);
  368.   REPEAT                                     { Eingabemenü }
  369.     WriteLn('(1)  Codieren                       ');
  370.     WriteLn('(2)  -  mit altem Crossreferencefile');
  371.     WriteLn('(3)  Decodieren                     ');
  372.     ReadLn(wahl);
  373.   UNTIL wahl IN [1..3];
  374.   IF wahl < 3 THEN BEGIN
  375.     WriteLn('(1)  Numerische Variablennamen      ');
  376.     WriteLn('(2)  Permutationsnamen              ');
  377.     ReadLn(methode);
  378.   END;
  379.   IF methode <> 1 THEN methode := 2;
  380.   WriteLn;
  381.   Write('Quellfile:                      ');  ReadLn(qfil);
  382.  
  383.   IF wahl < 3 THEN BEGIN                      { Datentypen }
  384.     IF Pos('.', qfil) = 0 THEN
  385.       qfil := qfil + '.pas';
  386.     zfil := Copy(qfil, 1, Pos('.', qfil)) + 'sch';
  387.     Write('Schluesselstring:               ');
  388.     ReadLn(schluessel);
  389.   END ELSE BEGIN
  390.     IF Pos('.', qfil) = 0 THEN qfil := qfil + '.sch';
  391.     zfil := Copy(qfil, 1, Pos('.', qfil)) + 'org';
  392.   END;
  393.   xfil := Copy(qfil, 1, Pos('.', qfil)) + 'crf';
  394.   WriteLn('bestehendes Quellfile:          ', qfil);
  395.   WriteLn('erzeugtes Zielfile:             ', zfil);
  396.   WriteLn('erzeugtes Crossreferencefile:   ', xfil);
  397.   WriteLn;
  398.   IF wahl = 2 THEN BEGIN                        { Codieren }
  399.     Write('bestehendes Crossreferencefile: ');
  400.     ReadLn(xfil);
  401.     IF Pos('.', xfil) = 0 THEN xfil := xfil + '.crf';
  402.     WriteLn('Crossreferencefile einlesen...');
  403.     CrossreferenceLesen(varalt, varneu);
  404.     nstart := nvar;
  405.     Varaltupper;
  406.     xfil := Copy(qfil, 1, Pos('.', qfil)) + 'crf';
  407.   END;
  408.   IF wahl IN [1,2] THEN BEGIN
  409.     WriteLn;
  410.     WriteLn('Kommentare entfernen...');
  411.     KommentareEntfernen;
  412.     WriteLn('Variablenliste erstellen...');  Variablensuche;
  413.     WriteLn('Neue Namen erfinden...');       NeueBezeichner;
  414.     Write  ('Umbenennen');                 Umbenennen(hfil);
  415.     WriteLn;
  416.     WriteLn('Leerzeilen entfernen...');
  417.     LeerzeilenEntfernen;
  418.   END;
  419.   IF wahl = 3 THEN BEGIN                      { Decodieren }
  420.     WriteLn('Crossreferencefile einlesen...');
  421.     CrossreferenceLesen(varneu, varalt);  Varaltupper;
  422.     Write('Originalnamen einsetzen...');  Umbenennen(qfil);
  423.     WriteLn;
  424.   END;
  425.   WriteLn(#13#10, 'OK.');
  426. END {Schloss}.
  427. (* ------------------------------------------------------ *)
  428. (*                Ende von SCHLOSS.PAS                    *)
  429.