home *** CD-ROM | disk | FTP | other *** search
/ Chip: Shareware for Win 95 / Chip-Shareware-Win95.bin / ostatni / delphi / delphi2 / wowsrc.exe / WINPWD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-11-05  |  2.9 KB  |  82 lines
  1. unit Winpwd;
  2.  
  3. interface
  4. Uses WinProcs;
  5.  
  6. Function  EncryptString(Var S : String) : Boolean;
  7. Procedure EncryptCString(S : PChar);
  8.  
  9.  
  10. implementation
  11.  
  12.  
  13.  
  14. procedure WinEncrypt(Strg: PChar);
  15.   procedure Exor (x1: byte; var x2: byte);
  16.  
  17.   const NotAllowed = [0..$20, $7f..$90, $93..$9f, $3d, $5b, $5d];
  18.                    { the last three are '[]=' - not allowed in profile string }
  19.   begin
  20.    if not ((x2 xor x1) in NotAllowed) then x2 := x2 xor x1;
  21.   end; { Exor }
  22.  
  23. var
  24.   StrgPt, Strglg : Integer;                                { Local Vars }
  25.   TheByte : Byte;                                          { Working Char }
  26.  
  27. begin
  28.   StrgLg := lstrlen(Strg);                                 { Get String Length }
  29.   if (StrgLg = 0) then exit;                               { empty string => nothing to do }
  30.   AnsiUpper (Strg);                                        { capitalize the string }
  31.  
  32.  
  33.   {================================ First Pass ==================================}
  34.  
  35.   for StrgPt := 0 to StrgLg - 1 do begin                   { proceed from left to right }
  36.     TheByte := byte (Strg [StrgPt]);                       { get character to encrypt }
  37.     Exor (StrgLg, TheByte);                                { xor it using string length...}
  38.     if (StrgPt = 0) then                                   { If EOS }
  39.       Exor ($2a, TheByte)                                  {...a constant...}
  40.     else begin
  41.       Exor (StrgPt, TheByte);                              {...actual string pointer...}
  42.       Exor (byte (Strg [StrgPt-1]), TheByte);              {...previous character }
  43.       end;
  44.     Strg [StrgPt] := char (TheByte);                       { store encrypted byte back }
  45.     end; { for };
  46.  
  47.  
  48.   {=============================== Second Pass ==================================}
  49.  
  50.   if (StrgLg > 1) then                                     { no second pass for one-byte-strings }
  51.     for StrgPt := StrgLg-1 downto 0 do begin               { proceed from right to left }
  52.       TheByte := byte (Strg [StrgPt]);                     {  encrypt similar as in first pass }
  53.       Exor (StrgLg, TheByte);                              { xor it using string length...}
  54.       if (StrgPt = StrgLg - 1) then                        { If BOS }
  55.         Exor ($2a, TheByte)                                {...a constant...}
  56.       else begin
  57.         Exor (StrgPt, TheByte);                            {...actual string pointer...}
  58.         Exor (byte (Strg [StrgPt+1]), TheByte);            {...Next character }
  59.         end;
  60.       Strg [StrgPt] := char (TheByte);                     { store encrypted byte back }
  61.       end; { for };
  62.  
  63. end; { WinCrypt }
  64.  
  65.  
  66. Procedure EncryptCString(S : PChar);
  67. Begin
  68.   WinEncrypt(S);
  69. end;
  70.  
  71. Function EncryptString(Var S : String) : Boolean;
  72. begin
  73.   Result := False;
  74.   if S[0] < #254 then begin
  75.     S[Integer(S[0]) + 1] := Chr(0);
  76.     WinEncrypt(@S[1]);
  77.     Result := True;
  78.     end;
  79. end;
  80.  
  81. end.
  82.