home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / communic / tp55 / exstr.pas next >
Encoding:
Pascal/Delphi Source File  |  1979-11-29  |  6.1 KB  |  240 lines
  1. program exstr;
  2.  
  3. uses
  4. dos,crt;
  5.  
  6. const
  7. t                  :  array [1..26] of byte =
  8.                       (2,2,2,3,3,3,4,4,4,5,5,5,6,6,6,7,7,7,7,8,8,8,9,9,9,9);
  9. var
  10. found              :  boolean;
  11. linecount          :  longint;
  12. line               :  string;
  13. wort               :  string;
  14. a                  :  array[1..256] of byte absolute line;
  15. b                  :  array[1..256] of byte absolute wort;
  16. func,p1,p2,i,j     :  integer;
  17. c                  :  char;
  18. n,fields           :  word;
  19. fpos               :  array[1..30] of byte;
  20. flen               :  array[1..30] of byte;
  21. out                :  text;
  22.  
  23.  
  24. procedure std_inout;
  25.  
  26. begin
  27.   assign (input,''); Reset (input);
  28.   assign (output,''); Rewrite (output);
  29. end;
  30.  
  31.  
  32. procedure crt_inout;
  33.  
  34. begin
  35.   close (input); assigncrt (input); Reset (input);
  36.   close (output); assigncrt (output); Rewrite (output);
  37. end;
  38.  
  39.  
  40. procedure cypher;
  41.  
  42. var
  43. i    : integer;
  44. j    : integer;
  45.  
  46. begin
  47.   j := 2;
  48.   for i := 2 to length(line)+1 do
  49.   begin
  50.     a[i] := a[i] xor b[j];
  51.     if (a[i] in [10,13,26]) then
  52.       a[i] := a[i] xor b[j];
  53.     j := j+1;
  54.     if (j > length(wort)) then j := 2;
  55.   end;
  56. end;
  57.  
  58.  
  59.  
  60. function phone_number : boolean;
  61.  
  62. begin
  63.   p1               := pos('#',line);
  64.   if (p1 > 0) then
  65.   begin
  66.     wort           := copy(line,p1 + 1,200);
  67.     for i          := 1 to length(wort) do
  68.     begin
  69.       if (wort[i] in ['a'..'z']) then b[i+1] := b[i+1] - 32;
  70.       if (wort[i] in ['A'..'Z']) then b[i+1] := t[b[i+1] - 64] + 48;
  71.     end;
  72.     phone_number   := TRUE;
  73.   end
  74.   else phone_number := FALSE;
  75. end;
  76.  
  77.  
  78.  
  79. procedure dialout;
  80.  
  81. begin
  82.   writeln(paramstr(5),wort);
  83.   halt;
  84. end;
  85.  
  86.  
  87.  
  88. function print : boolean;
  89.  
  90. begin
  91.   print            := FALSE;
  92.   case func of
  93.     0,
  94.     4 : begin
  95.           if (func = 4) then writeln(out,line);
  96.           print    := TRUE;
  97.           if (p1 > 0) then
  98.           begin
  99.             if (linecount >= p1) then
  100.             begin
  101.               c    := readkey;
  102.               if (c = #3) then halt;
  103.               if (c = #13) then linecount := p1 - 1
  104.               else linecount := 0;
  105.             end;
  106.           end;
  107.         end;
  108.     1 : if (linecount <= p1) then print := TRUE;
  109.     2 : if (linecount >  p1) then print := TRUE;
  110.     3 : if (length(line) <= 0) then
  111.         begin
  112.           if (i < p1) then
  113.           begin
  114.             print  := TRUE;
  115.             i      := i + 1;
  116.           end;
  117.         end
  118.         else
  119.         begin
  120.           print    := TRUE;
  121.           i        := 0;
  122.     end;
  123.     5 : if (i < (p1 - 1)) then
  124.         begin
  125.           write(line);
  126.           if ((p2 > 0) and ((length(line) + 1) < (p2 - 1))) then
  127.             for j  := (length(line) + 1) to (p2 - 1) do
  128.               write(' ');
  129.           write(paramstr(4));
  130.           i        := i + 1;
  131.         end
  132.         else
  133.         begin
  134.           print    := TRUE;
  135.           i        := 0;
  136.         end;
  137.     6 : if (pos(paramstr(4),line) > 0) then print := TRUE;
  138.     7 : if (pos(paramstr(4),line) = 0) then print := TRUE;
  139.     8 : begin
  140.           line     := copy(line,p1,p2);
  141.           print    := TRUE;
  142.         end;
  143.     9 : begin
  144.           delete(line,p1,p2);
  145.           print    := TRUE;
  146.         end;
  147.    10 : begin
  148.           insert(paramstr(4),line,p1);
  149.           print    := TRUE;
  150.         end;
  151.    11 : begin
  152.           i        := pos(paramstr(4),line);
  153.           if (i > 0) then
  154.           begin
  155.             delete(line,i,length(paramstr(4)));
  156.             insert(paramstr(5),line,i);
  157.           end;
  158.           print    := TRUE;
  159.         end;
  160.    12 : begin
  161.           cypher;
  162.           print    := TRUE;
  163.         end;
  164.    13,
  165.    14 : begin
  166.           if (pos(paramstr(4),line) > 0) then found := TRUE;
  167.           if (found = TRUE) then
  168.             if (func = 13) then
  169.             begin
  170.               if (phone_number) then dialout;
  171.             end
  172.             else print := TRUE;
  173.           if (length(line) <= 0) then found := FALSE;
  174.         end;
  175.    15 : begin
  176.           for n    := 1 to fields do
  177.           begin
  178.             wort   := copy(line,fpos[n],flen[n]);
  179.             writeln(wort);
  180.           end;
  181.           print    := false;
  182.         end;
  183.   end;
  184. end;
  185.  
  186.  
  187. begin
  188.   if (paramcount < 4) then
  189.   begin
  190.     writeln(paramstr(0),' <function> <p1> <p2> <string> [<string2>]');
  191.     writeln('function:');
  192.     writeln('   0 - Write every line to stdout; pause after <p1> lines.');
  193.     writeln('   1 - Write only first <p1> lines.');
  194.     writeln('   2 - Skip first <p1> lines.');
  195.     writeln('   3 - Write max.<p1> blank lines.');
  196.     writeln('   4 - Like function 0 - plus write also to file <string>.');
  197.     writeln('   5 - Concatenate <p1> lines;blank to col <p2>;write <string> in between.');
  198.     writeln('   6 - Write only lines that contain <string>.');
  199.     writeln('   7 - Write only lines that do not contain <string>.');
  200.     writeln('   8 - Extract substring at pos <p1> with length <p2> from every line.');
  201.     writeln('   9 - Delete substring at pos <p1> with length <p2> from every line.');
  202.     writeln('  10 - Insert <string> at pos <p1> in every line.');
  203.     writeln('  11 - Replace <string> with <string2> only once every line.');
  204.     writeln('  12 - Cypher/Uncypher every line with <string>.');
  205.     writeln('  13 - Find <string> in paragraph, then dial <string2>+#phone#.');
  206.     writeln('  14 - Write only paragraphs that contain <string>.');
  207.     writeln('  15 - Break lines in fields; Will ask for parameters.');
  208.     exit;
  209.   end;
  210.   val(paramstr(1),func,i);
  211.   val(paramstr(2),p1,i);
  212.   val(paramstr(3),p2,i);
  213.  
  214.   if (func = 4) then
  215.   begin
  216.     assign(out,paramstr(4));
  217.     rewrite(out);
  218.   end;
  219.   if (func = 15) then
  220.   begin
  221.     write ('# of fields: '); readln(fields);
  222.     for n          := 1 to fields do
  223.     begin
  224.     write ('#',n:2,' pos: ');readln(fpos[n]);
  225.     write ('#',n:2,' len: ');readln(flen[n]);
  226.     end;
  227.   end;
  228.   std_inout;
  229.   i                := 0;
  230.   linecount        := 0;
  231.   while not eof(input) do
  232.   begin
  233.     readln(line);
  234.     linecount      := linecount + 1;
  235.     if (print) then writeln(line);
  236.   end;
  237.   if (func = 4) then close(out);
  238. end.
  239.  
  240.