unit Encrypt;

{****************************************************************************
*****************************************************************************
*                                                                           *
*  EncryptString encrypts a string in the same way as Windows' ScreenSaver  *
*  library does. The same function will be available as a DLL in CLMFORUM,  *
*  Lib 9.                                                                   *
*                                                                           *
*  Published in WinTech Journal, February 1993.                             *
*                                                                           *
*****************************************************************************
*                                                                           *
*  Written by Manfred Keul [100031,12].                                     *
*                                                                           *
*  Compiler: Turbo Pascal for Windows 1.5                                   *
*                                                                           *
*****************************************************************************
*                                                                           *
*  Rev. 0.1   28.3.93   MK  IR                                              *
*                                                                           *
*****************************************************************************
****************************************************************************}

interface

uses WinProcs;

procedure EncryptString (Strg: PChar);

implementation

{****************************************************************************
*                                                                           *
*                      E n c r y p t S t r i n g                            *
*                                                                           *
*   Encrypts (password-) string the way Windows' ScreenSaver does           *
*                                                                           *
*   INPUT : Strg = string to encrypt                                        *
*                                                                           *
*   OUTPUT: Strg = encrypted string                                         *
*                                                                           *
****************************************************************************}


procedure EncryptString (Strg: PChar);


{***----------------------------------------------------------------------***
*                                                                           *
*                              E x o r                                      *
*                                                                           *
*   local to EncryptString: xors two bytes, tests and stores result         *
*                                                                           *
*   INPUT : x1, x2 = bytes to be xored                                      *
*                                                                           *
*   OUTPUT: x2 = x1 xor x2, if the resulting x2 isn't one of the            *
*                                               "special cases" (see code)  *
*              else x2 unmodified                                           *
*                                                                           *
*   NOTE  : Using a handful of compares probably would be faster than       *
*           testing on set membership - which, however, is more elegant.    *
*                                                                           *
***----------------------------------------------------------------------***}

procedure Exor (x1: byte; var x2: byte);

const NotAllowed = [0..$20, $7f..$90, $93..$9f, $3d, $5b, $5d];
                   { the last three are '[]=' - not allowed in profile string }
begin
if not ((x2 xor x1) in NotAllowed) then
    x2 := x2 xor x1;
end; { Exor }


{***------------------ Start of EncryptString ----------------------------***}

var   StrgPt, TheByte, StrgLg: byte;

begin
StrgLg := Byte(lstrlen(Strg));
if (StrgLg = 0) then exit;      { empty string => nothing to do }
AnsiUpper (Strg);               { capitalize the string }


{================================ First Pass ==================================}

for StrgPt := 0 to StrgLg-1 do                    { proceed from left to right }
      begin
      TheByte := byte (Strg [StrgPt]);              { get character to encrypt }
      Exor (StrgLg, TheByte);                   { xor it using string length...}
      if (StrgPt = 0) then
            Exor ($2a, TheByte)                               {...a constant...}
        else
            begin
            Exor (StrgPt, TheByte);                {...actual string pointer...}
            Exor (byte (Strg [StrgPt-1]), TheByte);     {...previous character }
            end;
      Strg [StrgPt] := char (TheByte);             { store encrypted byte back }
      end; { for };


{=============================== Second Pass ==================================}

if (StrgLg > 1) then                     { no second pass for one-byte-strings }
   for StrgPt := StrgLg-1 downto 0 do             { proceed from right to left }
       begin                               {  encrypt similar as in first pass }
       TheByte := byte (Strg [StrgPt]);
       Exor (StrgLg, TheByte);
       if (StrgPt = StrgLg - 1) then
             Exor ($2a, TheByte)
         else
             begin
             Exor (StrgPt, TheByte);
             Exor (byte (Strg [StrgPt+1]), TheByte);
             end;
       Strg [StrgPt] := char (TheByte);            { store encrypted byte back }
       end; { for };

end; { EncryptString }

begin
end.