String (swapping two chars in a string)

My server is unable to send email to the poster's server which
explains my posting yet another solution (though improved) to swapping
two characters within a string.
           <clifp...@airmail.net>

========
Newsgroups: comp.lang.pascal.misc
Subject: String
From: Chris McCann <wp...@freenet.victoria.bc.ca>
Date: Fri, 2 Feb 1996 07:08:08 GMT
***
I would also like to know how to take say all the 'e''s and
switch them with 'i's

Thanks for any help
Chris   Wp...@freenet.victoria.bc.ca
~

****************************************************************************

PROGRAM SwapChar;
{ Swapping two characters in a string. At the choice of the user the
swap can be either case sensitive or not. If the string is 'AZaz'
and the swap is case sensitive:
selection of az, a z, a;z, z a, or z,a all yield AZza,
selection of Aa, etc. yields aZAz, AZ yields ZAaz and so on.
No case sensitivity selected--AZ, az, ZA, aZ etc. ALL yield ZAza.
The swapping is performed by scanning the input string a character
at a time and determining whether that character is present in a
character set. If so, the replacement character is chosen from the
same character set. Turbo Pascal v6.0 words are all CAPS.
           <clifp...@airmail.net>  Feb 4, 1996  }

USES CRT;
LABEL 1, 2;

CONST  Esc = CHR(27);

VAR    sx, sy : STRING;
       Ans : CHAR;
       CaseSens : BOOLEAN;

FUNCTION LCase(chx:CHAR):CHAR;
BEGIN
{ The following OR operation combines two binary numbers, rather
than selecting between two values. This is a "tradition" from
the time when cpu's did binary OR's faster than addition. }

     IF chx IN ['A'..'Z'] THEN LCase := Chr( Ord(chx) OR 32 )
     ELSE LCase := chx;
END;

PROCEDURE Swap(ca, cb: Char; VAR s:String);
VAR    CharSet : STRING[4];
       dup : STRING;
       L, n, p : INTEGER;
BEGIN
     L := LENGTH(s);
     dup := s;
     IF CaseSens THEN
        CharSet := ca + cb + cb + ca
     ELSE
        CharSet := UPCASE(ca) + LCase(ca) + UPCASE(cb) + LCase(cb);

     For n := 1 TO L DO
     BEGIN
          p:= POS(dup[n], CharSet);
          IF p <> 0 THEN
          BEGIN
               p := 1 + ((p + 1) MOD 4);  (* position of substitute *)
               dup[n] := CharSet[p];
          END;
     END;
     s:=dup;
END;

BEGIN   { SwapChar }
1:
      CLRSCR;
      WRITELN('*** PRESS <ESC> TO QUIT ***');
      WRITELN('Swapping two characters throughout a string.');
      WRITE('Include both cases of both characters (Y/N)? ');
      Ans := READKEY;
      IF Ans = Esc THEN GOTO 2;
      WRITELN(Ans);
      CaseSens := UPCASE(Ans) = 'N';    (* setting boolean value *)
      WRITELN;
      WRITELN('***When finished, just press <Enter> ***');

      REPEAT
            WRITELN;
            WRITELN('Enter a string:');
            READLN(sx);
            IF sx = '' THEN GOTO 1;

            WRITE('Enter two characters to swap: ');
            READLN(sy);
            WRITELN(sx);
            { swap first and last chars of sy within sx }
            Swap(sy[1], sy[ LENGTH(sy) ], sx);
            WRITELN(sx);
2:
      UNTIL Ans = Esc;
CLRSCR;
END.