Защита формы паролем, шифрация пароля

unit SubRosa;
 
{
+----------------------+
|Примеры использования:|
+----------------------+------------------------+
|...                                            |
|  Write('Введите старый пароль: ');            |
|  ReadLn(pass);                                |
|  Write('Введите новый пароль: ');             |
|  ReadLn(newpass);                             |
|  if bTesseraMuto('pass.bin',pass,newpass) then|
|    WriteLn('Пароль успешно изменён!');        |
|...                                            |
+------------------------------------------+----+
|...                                       |
|  Write('Введите пароль: ');              |
|  ReadLn(pass);                           |
|  if bTesseraComparo('pass.bin',pass) then|
|    begin                                 |
|      WriteLn('Пароль принят!');          |
|...                                       |
+------------------------------------------+
}
 
interface
 
type
  dtString=WideString;
  dtChar=WideChar;
 
/// <summary>
///   Процедура записи сигнатуры ключа в файл
/// </summary>
/// <param name="sThesaurum">
///   Имя файла хранилища
/// </param>
/// <param name="sTessera">
///    Ключ
/// </param>
procedure vTesseraHabio(sThesaurum, sTessera:dtString);
/// <summary>
///   Функция сравнения сигнатуры ключа с сигнатурой из*хранилища
/// </summary>
/// <param name="sThesaurum">
///   Имя файла хранилища
/// </param>
/// <param name="sTessera">
///   Ключ
/// </param>
/// <returns>
///   Возвращает истину, если сигнатуры совпадают
/// </returns>
function bTesseraComparo(sThesaurum, sTessera:dtString):Boolean;
/// <summary>
///   Функция перезаписи сигнатуры хранилища
/// </summary>
/// <param name="sThesaurum">
///   Имя файла хранилища
/// </param>
/// <param name="sPriscusTessera">
///   Старый ключ
/// </param>
/// <param name="sNovusTessera">
///   Новый ключ
/// </param>
/// <returns>
///   Возвращает истину, если сигнатура была перезаписана
/// </returns>
function bTesseraMuto(sThesaurum, sPriscusTessera, sNovusTessera:dtString):Boolean;
/// <summary>
///   Функция вычисления сигнатуры строки
/// </summary>
/// <param name="sVersus">
///   Строка для вычисления сигнатуры
/// </param>
/// <returns>
///   $65daec1d8e6f466 - сигнатура пустой строки
/// </returns>
function lliVerificatus(sVersus:dtString):Int64;
 
implementation
 
uses
  SysUtils,
  Classes;
 
const
  lliUnificatus:Int64=$65daec1d8e6f466;
  lliUMultiplicator:Int64=lliUnificatus div $f8;
  lliUAdditor:Int64=lliUnificatus div $1e3;
 
var
  lliMultiplicator:Int64;
  lliAdditor:Int64;
 
type
  Mass8=array[1..8] of Byte;
 
procedure vTesseraHabio(sThesaurum, sTessera:dtString);
var
  oPlica:TFileStream;
  lliSignificatio:Int64;
  m8AliusSignificatio:Mass8 absolute lliSignificatio;
begin
  if not DirectoryExists(ExtractFilePath(sThesaurum)) then
    ForceDirectories(ExtractFilePath(sThesaurum));
  try
    oPlica:=TFileStream.Create(sThesaurum, fmCreate);
    lliSignificatio:=lliVerificatus(sTessera);
    oPlica.Write(m8AliusSignificatio, 8)
  finally
    if oPlica<>nil then
      oPlica.Free
  end
end;
 
function bTesseraComparo(sThesaurum, sTessera:dtString):Boolean;
var
  oPlica:TFileStream;
  lliSignificatio:Int64;
  m8AliusSignificatio:Mass8 absolute lliSignificatio;
begin
  Result:=false;
  if not FileExists(sThesaurum) then
    Exit;
  try
    oPlica:=TFileStream.Create(sThesaurum, fmOpenRead);
    oPlica.Read(m8AliusSignificatio, 8);
    Result:=lliSignificatio=lliVerificatus(sTessera)
  finally
    if oPlica<>nil then
      oPlica.Free
  end
end;
 
function bTesseraMuto(sThesaurum, sPriscusTessera, sNovusTessera:dtString):Boolean;
var
  oPlica:TFileStream;
  lliSignificatio:Int64;
  m8AliusSignificatio:Mass8 absolute lliSignificatio;
begin
  if not FileExists(sThesaurum) then
    begin
      Result:=sPriscusTessera='';
      if Result then
        vTesseraHabio(sThesaurum, sNovusTessera);
      Exit
    end;
  if sPriscusTessera=sNovusTessera then
    Exit(bTesseraComparo(sThesaurum, sPriscusTessera));
  try
    oPlica:=TFileStream.Create(sThesaurum, fmOpenReadWrite);
    oPlica.Read(m8AliusSignificatio,8);
    Result:=lliSignificatio=lliVerificatus(sPriscusTessera);
    if Result then
      begin
        oPlica.Seek(0,soBeginning);
        oPlica.Write(Mass8(lliVerificatus(sNovusTessera)), 8)
      end
  finally
    if oPlica<>nil then
      oPlica.Free
  end
end;
 
function lliAccidentalis(cSignum:dtChar):Int64;inline;
begin
  Result:=Ord(cSignum)*lliMultiplicator+lliAdditor
end;
 
function lliPermutatio(lliPrimus, lliSecundus:Int64):Int64;inline;
begin
  Result:=((lliPrimus shl 16) or (lliSecundus shr 48)) xor
  ((lliPrimus shr 48) or (lliSecundus shl 16))
end;
 
function lliVerificatus(sVersus:dtString):Int64;
var
  iOrigo, iIndex:Integer;
begin
  Result:=lliUnificatus;
  if sVersus='' then
    Exit;
  iOrigo:=Length(sVersus);
  lliAdditor:=lliAccidentalis(chr(iOrigo))+1;
  lliMultiplicator:=lliAccidentalis(chr(iOrigo))-1;
  if lliMultiplicator=0 then
    lliMultiplicator:=lliUMultiplicator;
  for iIndex:=1 to iOrigo do
    Result:=lliPermutatio(Result+iIndex, lliAccidentalis(sVersus[iIndex]));
  lliMultiplicator:=lliUMultiplicator;
  lliAdditor:=lliUAdditor
end;
 
initialization
  lliMultiplicator:=lliUMultiplicator;
  lliAdditor:=lliUAdditor
end.