Использование функции FindNLSStringEx в Delphi для поиска строк с учетом регистра и локали

Delphi , Синтаксис , Текст и Строки

Введение

В современных приложениях часто возникает необходимость выполнять поиск подстрок с учетом различных языковых особенностей, таких как регистрозависимость, диакритические знаки, ширина символов и другие локализационные аспекты. Стандартная функция Pos в Delphi не всегда справляется с этими задачами, особенно при работе с текстами на разных языках.

В этой статье мы рассмотрим использование функции Windows API FindNLSStringEx, которая предоставляет расширенные возможности для поиска строк с учетом локали и различных языковых особенностей. Мы также реализуем удобную обертку на Object Pascal для интеграции этой функции в Delphi-приложения.

Основы работы с FindNLSStringEx

Функция FindNLSStringEx является частью Windows API и предоставляет мощные возможности для поиска строк с учетом национальных настроек. Она позволяет учитывать такие параметры, как:

• Регистрозависимость/регистронезависимость
• Диакритические знаки
• Типы символов (ширина, символы, пробелы)
• Языковые особенности

Прототип функции

function FindNLSStringEx(
  lpLocaleName: LPCWSTR;
  dwFindNLSStringFlags: DWORD;
  lpStringSource: LPCWSTR;
  cchSource: Integer;
  lpStringValue: LPCWSTR;
  cchValue: Integer;
  pcchFound: PInteger;
  lpVersionInformation: LPNLSVERSIONINFO;
  lpReserved: LPVOID;
  sortHandle: LPARAM
): Integer; stdcall;

Реализация обертки на Object Pascal

Рассмотрим реализацию удобной обертки для работы с FindNLSStringEx в Delphi:

unit NLSStringSearch;

interface

uses
  Windows, SysUtils;

type
  TNLSFindKind = (
    nlsFindFromStart,    // Поиск с начала
    nlsFindFromEnd,      // Поиск с конца
    nlsFindStartsWith,   // Начинается с
    nlsFindEndsWith      // Заканчивается на
  );

  TNLSCaseKind = (
    nlsNotSpecified,        // Не указано (по умолчанию)
    nlsLangIgnoreCase,      // Игнорировать регистр (лингвистически)
    nlsLangIgnoreDiacritic, // Игнорировать диакритические знаки
    nlsNormIgnoreCase,      // Игнорировать регистр (нормально)
    nlsNormIgnoreKanatype,  // Игнорировать тип каны
    nlsNormIgnoreNonspace,  // Игнорировать непробельные символы
    nlsNormIgnoreSymbols,   // Игнорировать символы
    nlsNormIgnoreWidth,     // Игнорировать ширину символов
    nlsNormLangCasing       // Лингвистическая обработка регистра
  );

function TextPos(
  const ASubText: UnicodeString; 
  const AText: UnicodeString; 
  ACaseKind: TNLSCaseKind = nlsNotSpecified;
  var FoundLen: Integer;
  ALocale: PChar = nil; 
  AFromPos: Integer = 1
): Integer;

function FindAllOccurrences(
  const ASubText: UnicodeString;
  const AText: UnicodeString;
  ACaseKind: TNLSCaseKind = nlsNotSpecified;
  ALocale: PChar = nil
): TArray<Integer>;

implementation

function TextPos(
  const ASubText: UnicodeString; 
  const AText: UnicodeString; 
  ACaseKind: TNLSCaseKind = nlsNotSpecified;
  var FoundLen: Integer;
  ALocale: PChar = nil; 
  AFromPos: Integer = 1
): Integer;
var
  Flags: DWORD;
  SourceLen: Integer;
begin
  // Проверка корректности параметров
  if (AFindPos < 1) or (AFindPos > Length(AText) + 1) then
  begin
    Result := -1;
    Exit;
  end;

  if (Length(ASubText) = 0) then
  begin
    Result := AFromPos;
    FoundLen := 0;
    Exit;
  end;

  Flags := FIND_FROMSTART;

  case ACaseKind of
    nlsLangIgnoreCase: 
      Flags := Flags or LINGUISTIC_IGNORECASE;
    nlsLangIgnoreDiacritic: 
      Flags := Flags or LINGUISTIC_IGNOREDIACRITIC;
    nlsNormIgnoreCase: 
      Flags := Flags or NORM_IGNORECASE;
    nlsNormIgnoreKanatype: 
      Flags := Flags or NIGNORM_IGNOREKANATYPE;
    nlsNormIgnoreNonspace: 
      Flags := Flags or NORM_IGNORENONSPACE;
    nlsNormIgnoreSymbols: 
      Flags := Flags or NORM_IGNORESYMBOLS;
    nlsNormIgnoreWidth: 
      Flags := Flags or NORM_IGNOREWIDTH;
    nlsNormLangCasing: 
      Flags := Flags or NORM_LINGUISTIC_CASING;
    // nlsNotSpecified - ничего не добавляем
  end;

  // Корректируем длину исходной строки для поиска с позиции AFromPos
  SourceLen := Length(AText) - AFromPos + 1;

  // Выполняем поиск
  Result := FindNLSStringEx(
    ALocale,
    Flags,
    @AText[AFindPos],        // Указатель на начало поиска
    SourceLen,               // Длина оставшейся части строки
    PChar(ASubText),         // Искомая подстрока
    Length(ASubText),        // Длина подстроки
    @FoundLen,               // Указатель для получения длины найденной строки
    nil,                     // Информация о версии (не используется)
    nil,                     // Зарезервировано
    0                        // Дескриптор сортировки (0 по умолчанию)
  );

  // Корректируем позицию результата
  if Result >= 0 then
    Inc(Result, AFromPos - 1)
  else
    FoundLen := 0;
end;

function FindAllOccurrences(
  const ASubText: UnicodeString;
  const AText: UnicodeString;
  ACaseKind: TNLSCaseKind = nlsNotSpecified;
  ALocale: PChar = nil
): TArray<Integer>;
var
  Positions: array of Integer;
  FoundPos, FoundLen: Integer;
  Count: Integer;
begin
  SetLength(Positions, 0);
  Count := 0;
  FoundPos := 1;

  while FoundPos <= Length(AText) do
  begin
    FoundLen := 0;
    FoundPos := TextPos(ASubText, AText, ACaseKind, FoundLen, ALocale, FoundPos);

    if FoundPos < 0 then
      Break;

    // Увеличиваем размер массива и добавляем позицию
    SetLength(Positions, Count + 1);
    Positions[Count] := FoundPos;
    Inc(Count);

    // Переходим к следующей позиции после найденной подстроки
    Inc(FoundPos, Max(1, FoundLen));
  end;

  // Возвращаем результат
  Result := Positions;
end;

end.

Пример использования

Вот пример использования нашей реализации:

program NLSStringSearchDemo;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows,
  NLSStringSearch;

procedure DemoSearch;
var
  Text: UnicodeString;
  SubText: UnicodeString;
  FoundPos, FoundLen: Integer;
  Positions: TArray<Integer>;
  i: Integer;
begin
  // Тестовый текст с немецкими символами
  Text := 'Götterdämmerung - это оперный цикл. ' +
          'Götterdämmerung состоит из нескольких частей. ' +
          'В Götterdämmerung заканчивается история о кольце Нибелунга.';

  SubText := 'Götterdämmerung';

  WriteLn('Исходный текст:');
  WriteLn(Text);
  WriteLn;

  // Простой поиск
  FoundLen := 0;
  FoundPos := TextPos(SubText, Text, nlsNotSpecified, FoundLen);

  if FoundPos > 0 then
  begin
    WriteLn('Найдено в позиции: ', FoundPos);
    WriteLn('Длина найденной строки: ', FoundLen);
    WriteLn('Найденная строка: ', Copy(Text, FoundPos, FoundLen));
  end
  else
    WriteLn('Подстрока не найдена');

  WriteLn;

  // Поиск всех вхождений
  Positions := FindAllOccurrences(SubText, Text, nlsNotSpecified);

  WriteLn('Все вхождения:');
  for i := 0 to High(Positions) do
  begin
    FoundLen := 0;
    TextPos(SubText, Text, nlsNotSpecified, FoundLen, nil, Positions[i]);
    WriteLn('  Позиция ', i + 1, ': ', Positions[i], 
            ' (длина: ', FoundLen, ') - ', 
            Copy(Text, Positions[i], FoundLen));
  end;

  WriteLn;

  // Поиск с игнорированием регистра
  FoundLen := 0;
  FoundPos := TextPos('götterdämmerung', Text, nlsNormIgnoreCase, FoundLen);

  if FoundPos > 0 then
  begin
    WriteLn('Поиск с игнорированием регистра:');
    WriteLn('Найдено в позиции: ', FoundPos);
    WriteLn('Длина: ', FoundLen);
  end;
end;

begin
  try
    SetConsoleOutputCP(CP_UTF8);
    DemoSearch;
  except
    on E: Exception do
      WriteLn('Ошибка: ', E.Message);
  end;

  WriteLn('Нажмите Enter для выхода...');
  ReadLn;
end.

Альтернативные решения

Хотя FindNLSStringEx предоставляет мощные возможности, существуют и другие подходы к решению задачи поиска строк с учетом локали:

1. Использование регулярных выражений

Для более сложных сценариев можно использовать регулярные выражения с поддержкой Unicode:

uses
  System.RegularExpressions;

function RegexTextPos(const ASubText, AText: string; 
  AIgnoreCase: Boolean = False): Integer;
var
  Options: TRegExOptions;
  Match: TMatch;
begin
  Options := [];
  if AIgnoreCase then
    Include(Options, roIgnoreCase);

  Match := TRegEx.Match(AText, TRegEx.Escape(ASubText), Options);
  if Match.Success then
    Result := Match.Index + 1
  else
    Result := -1;
end;

2. Собственная реализация с учетом Unicode

function CustomUnicodePos(const SubStr, Str: UnicodeString; 
  IgnoreCase: Boolean = False): Integer;
var
  i, j: Integer;
  Match: Boolean;
begin
  Result := -1;

  if (Length(SubStr) = 0) or (Length(Str) = 0) then
    Exit;

  for i := 1 to Length(Str) - Length(SubStr) + 1 do
  begin
    Match := True;
    for j := 1 to Length(SubStr) do
    begin
      if IgnoreCase then
      begin
        if WideUpperCase(Str[i + j - 1]) <> WideUpperCase(SubStr[j]) then
        begin
          Match := False;
          Break;
        end;
      end
      else
      begin
        if Str[i + j - 1] <> SubStr[j] then
        begin
          Match := False;
          Break;
        end;
      end;
    end;

    if Match then
    begin
      Result := i;
      Exit;
    end;
  end;
end;

3. Использование TStringHelper (Delphi XE3+)

uses
  System.SysUtils;

function HelperTextPos(const SubStr, Str: string; 
  AFromPos: Integer = 1): Integer;
begin
  Result := Str.IndexOf(SubStr, AFromPos - 1);
  if Result >= 0 then
    Inc(Result)
  else
    Result := -1;
end;

Рекомендации по использованию

1. Используйте FindNLSStringEx для задач, требующих точного учета локализационных особенностей и сложных правил сравнения строк.

2. Для простых случаев можно использовать стандартные функции Delphi или регулярные выражения.

3. Всегда проверяйте возвращаемые значения и обрабатывайте ошибки, особенно при работе с API Windows.

4. Учитывайте кодировку при выводе результатов в консоль или другие компоненты.

5. Для производительности при частом поиске в больших текстах рассмотрите использование индексов или других оптимизационных техник.

Заключение

Функция FindNLSStringEx предоставляет мощные возможности для поиска строк с учетом различных локализационных особенностей. Наша реализация обертки делает использование этой функции более удобным и безопасным в Delphi-приложениях. Однако важно понимать, что для простых задач может быть достаточно стандартных средств Delphi, а для сложных сценариев стоит рассматривать комбинацию различных подходов.

Правильный выбор метода зависит от конкретных требований приложения, объема данных и необходимой точности поиска.

Создано по материалам из источника по ссылке.

Статья описывает использование функции Windows API `FindNLSStringEx` в Delphi для поиска строк с учетом локали и различных языковых особенностей, таких как регистр и диакритические знаки, с реализацией удобной обертки на Object Pascal.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Текст и Строки ::