{
  ===
  Класс расчета хэш-кода по строке (из множества атрибутов библиографического описания)
  для реализации алгоритма проверки записей на дублетность
  ===

  Свойства:

  Методы:
    Execute - рассчитывает значение хэша. Сохраняет их в свойствах HashCode64 и HashCode32

    procedure Execute(const Text: string);      - по заданной строке
    procedure Execute(AttrValueField: TField);  - по заданному полю набора данных


    (с) Чудин Андрей aka Xelby, август 2002
}
unit gcBiblioHashCode;

interface
uses SysUtils, DB;

type

  TgcBiblioHashCode = class{(TComponent)}
  private
    FText: string;
    FHashCode64: int64;
    FHashCode32: integer;
    procedure CalculateHashCode(Value: string);
  protected
  public
    procedure Execute(const Text: string); overload;
    procedure Execute(AttrValueField: TField); overload;
  published
    property HashCode32: integer read FHashCode32 write FHashCode32 stored false;
    property HashCode64: int64 read FHashCode64 write FHashCode64 stored false;
  end;


implementation

{ TgcBiblioHashCode }

procedure TgcBiblioHashCode.Execute(const Text: string);
begin
  CalculateHashCode(Text);
end;

{
 собирает строку из записей переданого поля набора данных
 Предусловия: НД открыт и установлен на начальнуб позицию
}
procedure TgcBiblioHashCode.Execute(AttrValueField: TField);
var
  Text: string;
begin
  Text := ''; 
  while not AttrValueField.DataSet.EOF do
  begin
    Text := Text + AttrValueField.AsString;
    AttrValueField.DataSet.Next;
  end;
  CalculateHashCode(Text);
end;

{
Рассчитывает 32-битный и 64-битный хэши по строке.
Учитывает только согласные кириллицы и латиницы и цифры.
Игнорирует регистр.

В значении хэша под кодировку и разрешение коллизий места не отводится
}
procedure TgcBiblioHashCode.CalculateHashCode(Value: string);
var
  i: integer;
  CharCode: byte;
  { возвращает код символа. гласные, пробелы и служ. символы - игнорируются }
  function TranslateCharCode(CharCode: Char): byte;
  var
    index: integer;
  const
    aAllChars = 'абвгдеёжзийклмнопрстуфхцчшщэюяabcdefghijklmnopqrstuvwxyz1234567890';
    aGoodChars = 'бвгджзклмнпрстфхцчшщbcdfghklmnpqrstuvwxyz1234567890';
  begin
    index := pos(CharCode, aGoodChars); // возможна замена на aAllChars
    if index > 0 then
      Result := ord(CharCode)
    else
      Result := 0;
  end;
begin
  HashCode32 := 0;
  HashCode64 := 0;

  Value := LowerCase(Value); // игнорируем регистр

  { цифры заменяем на строки для увеличения их веса }
  Value := StringReplace(Value, '0', 'нуль', [rfReplaceAll]);
  Value := StringReplace(Value, '1', 'один', [rfReplaceAll]);
  Value := StringReplace(Value, '2', 'два', [rfReplaceAll]);
  Value := StringReplace(Value, '3', 'три', [rfReplaceAll]);
  Value := StringReplace(Value, '4', 'четыре', [rfReplaceAll]);
  Value := StringReplace(Value, '5', 'пять', [rfReplaceAll]);
  Value := StringReplace(Value, '6', 'шесть', [rfReplaceAll]);
  Value := StringReplace(Value, '7', 'семь', [rfReplaceAll]);
  Value := StringReplace(Value, '8', 'восемь', [rfReplaceAll]);
  Value := StringReplace(Value, '9', 'девять', [rfReplaceAll]);

  for i := 1 to length(Value) do
  begin
    CharCode := TranslateCharCode(Value[i]);
    if CharCode = 0 then continue; // незначащие символы пропускаются

    { сдвиг и наложение кода символа на хэш }
    HashCode32 := (HashCode32 shl 1) xor CharCode;
    HashCode64 := (HashCode64 shl 1) xor CharCode;
  end;
end;



end.