Core/DBDStrUtils.pas - master - YakuninAV/Convertors

Core/DBDStrUtils.pas
1 985 строк85 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
{*******************************************************}
{                                                       }
{       DBD Core library                                }
{                                                       }
{       Copyright (C) 2020 Databasis Development        }
{                                                       }
{*******************************************************}

{ TODO -cВажно : Важно для разных версий длина Char разная. это нужно учесть в адресной арифметике }

/// Работа со строками в русской кодировке
unit DBDStrUtils;

{$I mormot.defines.inc}

interface

uses
{$IFDEF ISDELPHIXE2}
  System.SysUtils, System.Classes, System.TypInfo, System.StrUtils, System.DateUtils,
  System.Character,
{$ELSE}
  SysUtils, Classes, TypInfo, StrUtils, DateUtils,
{$ENDIF}
  mormot.core.base, mormot.core.variants, mormot.core.os, mormot.core.unicode, mormot.core.text, mormot.core.buffers
  , DBDCommons
  ;

const
  /// наборы символов
  BLNK: String = #7 + #9 + #10 + #11 + #12 + #13 + ' ' + #160;  //пробелы
  DIG:  String = '0123456789';                                   //цифры
  QTS1: String = #39;                                            //одинарые кавычки
  QTS2: String = '"«»“”';                                        //двойные кавычки
  QTSO: String = #39+'"«“';                                      //открывающие кавычки
  QTSC: String = #39+'"»”';                                      //закрывающие кавычки
  /// Русские символы совпадающие по написанию в русском и латинском алфавитах
  SomeRusLetters: string = 'сСаАеЕоОрРхХВНКМТ';
  /// Латинские символы совпадающие по написанию в русском и латинском алфавитах
  SomeLatLetters: string = 'cCaAeEoOpPxXBHKMT';
                          //        10        20
  LatUpLetters:   string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
                          //12345678901234567890123456
  LatLowLetters:  string = 'abcdefghijklmnopqrstuvwxyz';
                          //        10        20        30
  RusUpLetters:   string = 'АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЬЫЪЭЮЯ';
                          //123456789012345678901234567890123
  RusLowLetters:  string = 'абвгдеёжзийклмнопрстуфхцчшщьыъэюя';
  RusPeriodBegin: string = ' с ';
  RusPeriodEnd: string = ' по ';
  RusPeriodSign: string = ' период ';
  RusMonths: array[0..35] of string = (
    'янв', 'фев', 'мар', 'апр', 'май', 'июн', 'июл', 'авг', 'сен', 'окт', 'ноя', 'дек',
    'января', 'февраля', 'марта', 'апреля', 'мая', 'июня', 'июля', 'августа', 'сентября', 'октября', 'ноября', 'декабря',
    'январь', 'февраль', 'март', 'апрель', 'май', 'июнь', 'июль', 'август', 'сентябрь', 'октябрь', 'ноябрь', 'декабрь'
    );

  EndOfLine=#13#10;

  /// Массив цифр
  DIGS: array[0..9] of Char = ('0','1','2','3','4','5','6','7','8','9');

var
  DBDFormatSettings: TFormatSettings;

type

  /// Тип названия месяца
  // dbdMNKShort      - краткое
  // dbdMNKGenitive   - родительный падеж
  // dbdMNKNominative - именительный падеж
  TDBDMonthNameKind = (dbdMNKShort, dbdMNKGenitive, dbdMNKNominative);

  /// Опции корректировки строки
  //  dbdSCAToLower - перевод символов строки в нижний регистр
  //  dbdSCAToUpper - перевод символов строки в верхний регистр
  //  dbdSCAToInitCaption - перевод для всех слов первого символа в верхний регистр
  //  dbdSCARemoveExtaBlanks - удаление лишних пробельных символов
  //  dbdSCALatRus - замена латинских букв на русские совпадающие по написанию
  //  dbdSCARusLat - замена русских букв на латинские совпадающие по написанию
  //  dbdSCAAnsiOnly - замена букв не входящих в набор Ansi1251
  //  dbdSCAAbbreviation - замена в строке фраз на аббревиатуры
  //  dbdSCANoAction - ничего не делать
  TDBDStrCorrectionAction = (dbdSCAToLower, dbdSCAToUpper, dbdSCAToInitCaption, dbdSCARemoveExtaBlanks,
                                   dbdSCALatRus, dbdSCARusLat, dbdSCAAnsiOnly, dbdSCAAbbreviation,
                                   dbdSCANoAction);
  /// Набор опций для корректировки строки
  TDBDStrCorrectionActions = set of TDBDStrCorrectionAction;

  /// Опции поиска в строке
  TDBDFindAction = (dbdFAFirst, dbdFALast, dbdFANext, dbdFAPrevious);
  /// Набор опций поиска в строке
  TDBDFindActions = set of TDBDFindAction;

//  /// Части строки
//  // ! dbdSPLeft  - левая
//  // ! dbdSPRight - правая
//  // ! dbdSPBoth  - обе
//  TDBDStringPart = (dbdSPLeft, dbdSPRight, dbdSPBoth);

  /// Правила склеивания строк
  //  dbdSGPNoSpace      - удалить пробелы
  //  dbdSGPRemoveHipen  - удалить символ переноса строки
  //  dbdSPGDefault      - по умолчанию
  TDBDStringGlueProp = (dbdSGPNoSpace, dbdSGPRemoveHipen, dbdSPGDefault);

const
  /// Замена латинских букв на русские, совпадающие по написанию и удаление лишних пробелов и приведение символов
  //  к нижнему регистру
  dbdSCARusNormAndLower : TDBDStrCorrectionActions = [dbdSCAToLower, dbdSCARemoveExtaBlanks, dbdSCALatRus];
  /// Замена латинских букв на русские, совпадающие по написанию и удаление лишних пробелов и приведение символов
  //  к верхнему регистру
  dbdSCARusNormAndUpper : TDBDStrCorrectionActions = [dbdSCAToUpper, dbdSCARemoveExtaBlanks, dbdSCALatRus];
  /// Замена латинских букв на русские, совпадающие по написанию и удаление лишних пробелов
  dbdSCARusNormalize    : TDBDStrCorrectionActions = [dbdSCARemoveExtaBlanks, dbdSCALatRus];
  /// Замена латинских букв на русские, совпадающие по написанию
  dbdSCARus             : TDBDStrCorrectionActions = [dbdSCALatRus];

type
  TDBDAbbreviationItem = packed record
    Phrase: string;
    Abbreviation: string;
  end;
  TDBDAbbreviations = array of TDBDAbbreviationItem;
  PDBDAbbreviations = ^TDBDAbbreviations;

var
  DBDAbbreviations: TDBDAbbreviations;
  DBDAbbreviationsPtr: PDBDAbbreviations = @DBDAbbreviations;

type
  ///
  //  ddoFirstDay - если день не указан, то первый день месяца
  //  ddoLastDay  - если день не указан, то последний день месяца
  //  ddoMandatoryDay - указание дня обязательно
  TdbdDayOption = (dbdDOFirstDay, dbdDOLastDay, dbdDOMandatoryDay);

  ///

  { TDBDString }

  TDBDString = record
  private
    FText: string;
    FCurrentPos: Integer;
    procedure SetText(const Value: string);
    procedure SetCurrentPos(const Value: Integer);
    /// Процедура устанавливает значение текущей позиции.
    // Если значение Value превышает длину строки то значение устанавливается в 0
    procedure InternalSetCurrentPos(const Value: Integer);
    function GetCurrentChar: Char;
    procedure SetCurrentChar(const Value: Char);
  public
    /// Обрабатываемая строка
    property Text: string read FText write SetText;
    property CurrentChar: Char read GetCurrentChar write SetCurrentChar;
    /// Текущая позиция обрабатываемой строки
    property CurrentPos: Integer read FCurrentPos write SetCurrentPos;
    /// конструктор
    constructor Create(aStr: string; const DoTrim: boolean); overload;
    /// конструктор
    constructor Create(aStr: string; const ConvActions: TDBDStrCorrectionActions=[dbdSCANoAction]); overload;
    /// Замена в строке фраз на аббревиатуры
    class function Abbreviation(const aStr: string; const AbbreviationsPtr: PDBDAbbreviations=nil): string; overload; static;
    /// Замена в строке фраз на аббревиатуры
    procedure Abbreviation(const AbbreviationsPtr: PDBDAbbreviations=nil); overload;
    /// Корректировка строки согласно правилам
    class function CorrectString(const aStr: string;
                                 const ConvActions: TDBDStrCorrectionActions=[dbdSCARemoveExtaBlanks, dbdSCALatRus]): string; overload; inline; static;
    procedure CorrectString(const ConvActions: TDBDStrCorrectionActions=[dbdSCARemoveExtaBlanks, dbdSCALatRus]); overload;
    /// Функция отрезает часть текста слева от текущей позиции и возвращает отрезанную,
    // если IncludeCurChar=true, то текущий символ включатся в отезанный текст
    function CutOffLeft(const IncludeCurChar: Boolean = false): string;
    /// Функция возвращает true, если строка заканчивается на подстроку Substr
    function EndsWith(const aSub: string; const IgnoreCase: Boolean=False): Boolean;
    /// Функция извлекает из строки текст помеченный aMark, и удаляет его, если требуется. В случае успеха указатель перемещаетя
    // В случае успеха указатель на текущую позицию смещается на символ за вторым маркером
    function ExtracrMarkedText(const aMark: string; out MarkedText: string; const RemoveMarked: Boolean=False): Boolean; overload;
    function ExtracrMarkedText(const aMark: Char; out MarkedText: string; const RemoveMarked: Boolean=False): Boolean; overload;
    /// Функция находит стоп-символ в строке начиная с заданной позиции
    class function FindStopChar(const aStr: string; const Stops: array of Char; const vPos: Integer=1): Integer; overload; static;
    /// Функция находит стоп-символ в строке начиная с текущей позиции
    function FindStopChar(const Stops: array of Char): Integer; overload;
    /// Функция перемещает указатель строки на позицию начала aSub
    function FindSubstr(const aSub: string): Integer;
    /// Функция находит первый пробел в строке, начиная с заданной позиции и возвращает true в случае успеха,
    // а также изменяет заданную позицию на найденную
    class function FindWhiteSpace(const aStr: string; const vPos: Integer=1): Integer; static;
    /// Переместить указатель текущей позиции в начало строки, если установлен флаг noWhiteSpace, то
    // указатель устанавливатся на первый непустой символ
    function First(const noWhiteSpace: Boolean=true): Boolean;
    /// Функция проверяет, что указанный символ является цифрой и, если это так, то увеличивает указатель на единицу
    class function isDigit(const aStr:string; var vPos: Integer; const NextOnTrue: Boolean = true): Boolean; overload; static;
    /// Функция проверяет, что текущий символ является цифрой и, если это так, то сдвигает текущую позицию на следующий символ
    function isDigit(const NextOnTrue: Boolean = true): Boolean; overload;
    /// Функция возвращает true, если строка пуста или содержит только пробельные символы
    class function isEmpty(const aStr: string): Boolean; overload; static;
    /// Функция возвращает true, если строка пуста или содержит только пробельные символы
    function isEmpty: Boolean; overload;
    /// Функция проверяет, что заданный символ является стоп-символом и, если это так, то увеличивает указатель на единицу
    class function isStopChar(const aStr:string; const Stops: array of Char; var vPos: Integer; const NextOnTrue: Boolean = true): boolean; overload; static;
    /// Функция проверяет, что текущий символ является стоп-символом и, если это так, то сдвигает текущую позицию
    // на следующий символ
    function isStopChar(const Stops: array of Char; const NextOnTrue: Boolean = true): boolean; overload;
    /// Функция проверяет, что заданый символ является пробелом и, если это так, то сдвигает текущую позицию на следующий символ
    class function isWhiteSpace(const aStr:string; var vPos: Integer; const NextOnTrue: Boolean = true): Boolean; overload; static;
    /// Функция проверяет, что текущий символ является пробелом и, если это так, то сдвигает текущую позицию на следующий символ
    function isWhiteSpace(const NextOnTrue: Boolean = true): Boolean; overload;
    /// Переместить указатель текущей позиции на последний символ, если установлен флаг noWhiteSpace, то
    // указатель устанавливатся на последний непустой символ
    function Last(const noWhiteSpace: Boolean=true): Boolean;
    /// Функция возвращает длину строки
    function LengthTxt: Integer; inline;
    /// Функция изменяет указатель на позицию на стоп-символ или оставляет на месте
    class function MoveToStopChar(const aStr: string; const Stops: array of Char; var vPos: Integer): Boolean; overload; static;
    /// Функция перемещает текущую позицию на стоп-символ или оставляет на месте
    function MoveToStopChar(const Stops: array of Char): Boolean; overload;
    /// Функция перемещает текущую позицию на символ, не входящий в массив стоп-символов, или оставляет на месте
    function MoveToOtherChars(const Stops: array of Char): Boolean; overload;
    /// Переместить указатель на следующий символ с шагом
    function Next(const Step: Word=1): Boolean;
    /// Функция отрезает от строки часть находящуюся после найденной подстроки
    class function NipOffTail(const aStr, aSub: string): string; static;
    /// Переместить указатель на предыдущий символ с шагом
    function Prev(const Step: Word=1): Boolean;
    /// Функция возвращает текст, находящийся перед текущей позицией
    // Если текущая позиция за пределами строки, то возвращается я строка
    function Preceding: string;
    /// прочитать из текста дату
    // DAY{" "|"."|"-"|"/"}MONTH{" "|"."|"-"|"/"}YEAR
    // MONTH{" "|"."|"-"|"/"}YEAR
    // DAY- число               (1..31)
    // MONTH- {число|месяц}     (1..12)
    // YEAR- число
    // ! Str - строка
    // ! vPos - текущая позиция в строке
    // ! oDate - дата, прочитанная из строки
    // ! DayOption - опции формата даты
    // ! Year - год : NB: в настоящий момент не работает
    class function ReadDate(const aStr: string; var vPos:Integer; out oDate: TDateTime;
                           const DayOption: TdbdDayOption=dbdDOMandatoryDay; const Year:Word=0): Boolean; overload; static;
    function ReadDate(out oDate: TDateTime;
                      const DayOption: TdbdDayOption=dbdDOMandatoryDay; const Year:Word=0): Boolean; overload;
    /// Функция считывает из указанной позиции строки цифру и, в случае успеха, возвращает представляющее её число,
    // а также увеличивает указатель позийии на 1
    class function ReadDigit(const aStr: string; var vPos:Integer; out oNum: Byte): Boolean; overload; static;
    /// Функция считывает из текущей позиции строки цифру и, в случае успеха, возвращает представляющее её число,
    // а также сдвигает текущую позицию на 1 символ
    function ReadDigit(out oNum: Byte): Boolean; overload;
    /// Функция читает название месяца с текущей позиции и возвращает его номер и сдвигает текущую позицию
    // на первый символ после названия. В случае если с текущей позиции нет названия, то функция возвращает 0 и
    // текущая позиция не меняется
    class function ReadMonth(const aStr: string; var vPos:Integer): Word; overload; static;
    /// Функция читает название месяца с текущей позиции и возвращает его номер и сдвигает текущую позицию
    // на первый символ после названия. В случае если с текущей позиции нет названия, то функция возвращает 0 и
    // текущая позиция не меняется
    function ReadMonth: Word; overload;
    /// Функция считывает из строки последовательность цифр и возвращает получившееся число, если в указанной позиции
    // находится пробел, то он и последующие пробелы пропускаются. Если текущий символ не является цифрой или
    // пробелом то результат функции будет false
    class function ReadNumber(const aStr: string; var vPos:Integer; out oNum: Cardinal): Boolean; overload; static;
    /// Функция считывает из текущей позиции строки последовательность цифр и возвращает получившееся число,
    // если в текущей позиции находится пробел, то он и последующие пробелы пропускаются,
    // если текущий символ не является цифорой или пробелом то результат функции будет false
    function ReadNumber(out oNum: Cardinal): Boolean; overload;
    /// Функция считывает начиная с текущей позиции начало и конец периода
    function ReadPeriod(out StartDate: TDateTime; out EndDate: TDateTime; const Prefix: string='период'): Boolean;
    /// Функция считывает первое слово (текст между пробелами) начиная с заданной позиции
    class function ReadWord(const aStr: string; var vPos:Integer; out oWord: string): Boolean; overload; static;
    /// Функция считывает первое слово (текст между пробелами) начиная с текущей позиции, в случае успеха
    // текущая позиция становится на первый пробельный символ после прочитанного слова или 0
    function ReadWord(out oWord: string): Boolean; overload;
    /// Функция возвращает текст, находящийся после текущей позиции
    function Remainder: string; inline;
    /// Функция заменяет вхождения паттерна aOld в строке на aNew
    class function Replace(const aStr, aOld, aNew: string; const All: Boolean=True; const IgnoreCase: Boolean=false): string; static;
    /// Функция пропускает пробельные символы в строке, начиная с заданой позиции и установаливает значение позиции
    // первого непробельного символа и возвращае true. Если до конца строки нет непробельных символов, то функция
    // возвращает false, а значение позиции на 1 больше длины строки
    // ! Str - исследуемая строка
    // ! vPos - текущая позиция в строке
    class function SkipWhiteSpaces(const aStr:string; var vPos: Integer): Boolean; overload; static;
    /// Функция перемещает текущую позицию на первый непробельный символ и возвращает true. Если до конца строки
    // нет непробельных символов, то функция возвращает false
    function SkipWhiteSpaces: Boolean; overload;
    /// Процедура разбивает стоку на две части: левую (до текущей позиции) и правую после текущей позиции
    // если CurrentPosSide=0, то текущий символ не включатся не в Left, ни в Right,
    // если CurrentPosSide<0, то текущий символ включатся в Left,
    // если CurrentPosSide>0, то текущий символ включатся в Right
    procedure Split(out Left: string; out Right: string; const CurrentPosSide: Integer=0);
    /// Функция возвращает true, если строка начинается с подстроки Sub
    class function StartsWith(const aStr, aSub: string; const IgnoreCase: Boolean=False): Boolean; overload; static;
    /// Функция возвращает true, если строка начинается с подстроки Substr
    function StartsWith(const aSub: string; const IgnoreCase: Boolean=False): Boolean; overload;
    /// Функция преобразует строку оставляя только алфавитно-цифровые символы в верхнем регистре
    class function StrNormalization(const aStr: string): string; static;
    /// обертка над системными функциями LowerCase
    class function ToLower(const Str: string): string; static;
    /// обертка над системными функциями UpperCase
    class function ToUpper(const Str: string): string; static;
    /// Процедура удаляет с концов строки заданный символ
    procedure TrimChar(const C: Char; const Side:TDBDStringPart=dbdSPBoth);
  end;

/// Замена в строке фраз на аббревиатуры
function DBDAbbreviation(const aStr: string; const AbbreviationsPtr: PDBDAbbreviations=nil): string;
/// Корректировка строки согласно правилам
function DBDCorrectString(const aStr: string; const ConvActions: TDBDStrCorrectionActions=[dbdSCARemoveExtaBlanks, dbdSCALatRus]): string;
/// Функция переводит навание месяца в номер
function DBDRuMonth2Num(const aMonth:string): Word;
/// Функция возвращает true, если строка пуста или содержит только пробелы
function DBDisEmpty(const aStr: string): Boolean;
/// Функция возвращает true, если строка не пуста и содержит число (целое или вещественное)
function DBDisNumber(const aStr: string): Boolean;
/// Функция возвращает true, если заданный символ - пробельный
function DBDisWhiteSpace(const aStr: string; var vPos: Integer): Boolean; inline;
/// Функция находит в строке подстроку и в случае успеха возвращает её позицию
// Action - направление поиска
function DBDFind(const aStr, aSub: string; const vPos: Integer; const Action: TDBDFindAction=dbdFAFirst): Integer;
/// Функция находит позицию первого символа, присутствующего в массиве стоп-символов
function DBDFindStopChar(const aStr: string; Stops: array of Char; vPos: Integer): Integer;
/// Обёртка над функцией поиска подстроки
function DBDFindSubstr(const aStr, Substr: string; const vPos: Integer): Integer;
/// Обёртка над функцией поиска символа
function DBDFindChar(const aStr: string; aChr: Char; const vPos: Integer): Integer;
/// Функция возвращает позицию первого непробельного символа с начала (конца) строки
function DBDFindNonWhiteSpaces(const aStr: string; const LeftToRight: Boolean=True): Integer;
/// функция склеивает две строки и возвращает полученную строку
function DBDGlueStrings(const Str1, Str2: string; const GlueProp: TDBDStringGlueProp = dbdSPGDefault): string;
/// Функция перемещает текущую позицию строки в положение за найденной подстрокой
function DBDMoveAfterSubstr(const aStr, aSub: string; var vPos: integer): Boolean;
/// Функция отрезает от строки часть, находящуюся после заданной подстроки и возвращает её как результат
function DBDNipOffTail(const aStr, aSub: string): string;
///
function DBDReadPeriod(const aStr: string; var vPos: Integer; out StartDate: TDateTime; out EndDate: TDateTime; const Prefix: string='период'): Boolean;
/// Обёртка для функции замены подстрок
function DBDReplace(const aStr, aOld, aNew: string; All: Boolean=False; const IgnoreCase: Boolean=False): string;
/// Функция заменяет в строке символы из массива aOld на соответствующие им символы из массива аNew
function DBDReplaceChars(const aStr: String; const aOld, aNew: array of Char; All: Boolean=False; const IgnoreCase: Boolean=False): string;
/// Функция считывает цифру с текущей позиции и в случае успеха сдвигает позицию
function DBDReadDigit(const aStr: string; var vPos: Integer; out oNum: Byte): Boolean;
/// Функция считывает с указанной позиции строки вещественное значение
function DBDReadDouble(aStr: string; var vPos: Integer; out Val:Double): Boolean; overload;
/// Функция считывает с указанной позиции строки вещественное значение
function DBDReadDouble(aStr: string; out Val:Double): Boolean; inline; overload;
/// Функция считывает с указанной позиции строки вещественное значение
function DBDReadDoubleEx(aStr: string; var vPos: Integer; out Val:Double): Boolean;
/// Функция считывает с указанной позиции строки целое значение
function DBDReadInteger(aStr: string; var vPos: Integer; out Num: Integer): Boolean;
/// Функция считывает с указанной позиции цифры до конца строки или до первого символа не цифры и возвращает в oNum число
function DBDReadNumber(const aStr: string; var vPos: Integer; out oNum: Cardinal): Boolean;
/// Функция перемещает текущую позицию строки к стоп-символу заданному в Stops
function DBDMoveToStopChar(const aStr: string; Stops: array of Char; var vPos: Integer): Boolean;
/// Функция перемещает текущую позицию на символ, не входящий в массив стоп-символов, или оставляет на месте
function DBDMoveToOtherChar(const aStr: string; Rejects: array of Char; var vPos: Integer): Boolean;
/// Функция разбивает строку на две части по символу-разделителю
procedure DBDSplitString(const aStr, aSep: string; out oLeft, oRight: string); overload;
/// Функция разбивает строку на две части по символу-разделителю
{ TODO -oв развитие : Реализовать CurrentPosSide }
procedure DBDSplitString(const aStr: string; const aSep: Char; out oLeft, oRight: string; const CurrentPosSide: Integer=0); overload;
/// Функция конвертирует вещественное число в строку
function DBDDoubleToString(const D: Double; const Prec: Integer=4): string;
/// Функция конвертирует вещественное число в строку
function DBDDoubleToStringEx(const D: Double; const Prec: Integer=4): string;
/// функция формирует массив строк, разбивая строку по символу-разделителю
procedure DBDStringToArray(const aStr, aSep: string; out oStrArray: TStringDynArray);
/// Функция конветирует строку в число
function DBDStringToDouble(const S: string; out D: Double): Boolean;
/// Функция возвращает текст помеченный aMark и, в случае успеха, устанавливат vPos на позицию символа за вторым маркером
function DBDExtracrMarkedText(const aStr, aMark: string; var vPos: Integer; out MarkedText: string): Boolean; overload;
/// Функция возвращает текст помеченный aMark и, в случае успеха, устанавливат vPos на позицию символа за вторым маркером
function DBDExtracrMarkedText(var aStr: string; const aMark: Char; var vPos: Integer; out MarkedText: string;
                              const RemoveMarked: Boolean=True): Boolean; overload;
/// Преобразовать номер месяца в строку с названием
function DBDMonthFromNum(const aMon: Word; const aKind: TDBDMonthNameKind=dbdMNKNominative): string; overload;
/// Преобразовать номер месяца в строку с названием
function DBDMonthFromNum(const aMon: Word; out oMonth: string; const aKind: TDBDMonthNameKind=dbdMNKNominative): Boolean; overload;
/// Функция преобразует строку - название месяца в число
function DBDMonthToNum(const Month: string): Word;
/// Функция читает слово в параметр oWord, начиная с заданой позиции,
// если после заданной позиции ничего кроме пробелов нет фунция возвращает false
function DBDReadWord(const aStr: string; var vPos: Integer; out oWord: string): Boolean;
/// Функция читает дату в параметр oDate, начиная с заданой позиции,
// если текст в строке не соответствует дате, то результат функции будет false
// ! aStr - читаемая строка
// ! vPos - на входе - позиция в строке, на выходе - позиция после считанной даты
// ! oDate - дата, прочитанная из строки
// ! DayOption - требования к дате в строке
// ! Year - год по умолчанию
function DBDReadDate(const aStr: string; var vPos: Integer; out oDate: TDateTime;
                     const DayOption: TdbdDayOption; const Year: Word): Boolean;
/// Функция читает из строки месяц, представленный текстом
function DBDReadMonth(const aStr: string; var vPos: Integer): Word;
/// Функция находит позицию первого непробельного символа
function DBDSkipWhiteSpaces(const aStr: string; var vPos: Integer): Boolean;
/// Функция проверяет указанный символ строки и в случае успеха переходит к следующему символу
function DBDSkipChar(const aStr: string; const Ch: Char; var vPos: Integer): Boolean;
/// Функция находит первую позицию символа не входящего в заданный массив символов
function DBDSkipChars(const aStr: string; const Chars: string; var vPos: Integer): Boolean;
/// Функция возвращает true, если строка aStr заканчивается на aSub
function DBDEndsWith(const aStr, aSub: string; const IgnoreSpaces: Boolean=False; const IgnoreCase: Boolean=false): Boolean;
/// Функция возвращает true, если строка aStr начинается с aSub
function DBDStartsWith(const aStr, aSub: string; const IgnoreSpaces: Boolean=False; const IgnoreCase: Boolean=false): Boolean;
/// Обёртка над SysUtils.Trim
function DBDTrim(const aStr: String): string; inline;
/// Функция удаляет с краёв строки заданный символ
function DBDTrimChar(const aStr: string; const C: Char; const Side:TDBDStringPart=dbdSPBoth): string;
/// Функция удаляет с краёв строки пробельные символы
function DBDTrimSpaces(const aStr: string; const Side:TDBDStringPart=dbdSPBoth): string;
/// Функция удаляет с краёв строки подстроку
function DBDTrimSubstr(const aStr, aSub: string; const Side:TDBDStringPart=dbdSPBoth): string;
/// Функция отрезает от строки часть слева от позиции и возвращает остаток
function DBDCutLeft(const aStr: string; const aPos: Integer; const BeforePos: Boolean=True): string;
/// Функция отрезает от строки часть слева от позиции и возвращает остаток
function DBDCutRight(const aStr: string; const aPos: Integer; const AfterPos: Boolean=True): string;
/// Функция конвертирует Variant в Currency
function DBDVariantToCurrency(const aVal: Variant; out oVal: Currency): Boolean;
/// Функция конвертирует Variant в Currency
function DBDVariantToCurrencyDef(const aVal: Variant; const Def: Currency=0): Currency;

/// Функция конвертирует Variant в вещественное число
function DBDVariantToDouble(const aVal: Variant; out oVal: Double): Boolean;
/// Функция конвертирует Variant в вещественное число
function DBDVariantToDoubleDef(const aVal: Variant; const Def: Double=0): Double;

function DBDToLower(const aStr: string): string; inline;
function DBDToUpper(const aStr: string): string;// inline;
{$IFNDEF ISDELPHIXE2}
function DBDUpperChar1251(const c: Char): Char;
function DBDLowerChar1251(const c: Char): Char;
{$ENDIF}

procedure DBDConvertFileUTF8ToWin1251(const fileIn, fileOut: string);

function DBDSaveUTF8ToFile(const FN: TFileName; const S: RawUTF8): boolean;

function IsFormula(const Frml: string): Boolean;


implementation

function IsFormula(const Frml: string): Boolean;
var ds: TDBDString;
begin
  if Frml='' then Result:=False
  else begin
    ds:= TDBDString.Create(Frml);
    Result := not ds.MoveToOtherChars(['=','0','1','2','3','4','5','6','7','8','9',',','.','+','-','*']);
  end;
end;


function Translit(s: string): string;
const
  rus: string = 'абвгдеёжзийклмнопрстуфхцчшщьыъэюя';
  lat: array[1..33] of string = ('a', 'b', 'v', 'g', 'd', 'e', 'yo', 'zh', 'z', 'i', 'y', 'k', 'l', 'm', 'n', 'o', 'p', 'r', 's',
                                 't', 'u', 'f', 'h', 'ts', 'ch', 'sh', 'shch', '''', 'y', '''', 'e', 'yu', 'ya');
var p, i, l: integer;
begin
  s:=widelowercase(s);
  Result := '';
  l := Length(s);
  for i := 1 to l do begin
    p := Pos(s[i], rus);
   if p<1 then Result := Result + s[i] else Result := Result + lat[p];
  end;
end;

{$IFNDEF ISDELPHIXE2}
function DBDUpperChar1251(const c: Char): Char;
var b: Byte;
begin
  b:=Ord(c);
  if (b>=$61) and (b<=$7A) then b:= b -$20
  else if (b>=$D0) then b:=b-$10
  else if b=$B8 then b:=$A8;
  Result:=Char(b);
end;

function DBDLowerChar1251(const c: Char): Char;
var b: Byte;
begin
  b:=Ord(c);
  if (b>=41) and (b<=90) then b:=b+$20
  else if (b>=$C0) and (b<=$DF) then b:=b+$10
  else if b=$A8 then b:=$B8;
  Result:=Char(b);
end;
{$ENDIF}
function DBDTrim(const aStr: String): string;
begin
{$IFDEF ISDELPHIXE2}
  Result:=System.SysUtils.Trim(aStr);
{$ELSE}
  Result:=SysUtils.Trim(aStr);
{$ENDIF}
end;

function DBDCutLeft(const aStr: string; const aPos: Integer; const BeforePos: Boolean=True): string;
var i: Integer;
begin
  if (aPos<1) or ((aPos=1) and BeforePos) then Result:=''
  else if aPos>Length(aStr) then Result:=aStr
  else begin
    if BeforePos then i:=aPos-1 else i:=aPos;
    Result:=LeftStr(aStr,i);
  end;
end;

function DBDCutRight(const aStr: string; const aPos: Integer; const AfterPos: Boolean=True): string;
var i: Integer;
begin
  if (aPos<1) then Result:=aStr
  else if aPos>Length(aStr) then Result:=''
  else begin
    if AfterPos then i:=aPos else i:=aPos-1;
    Result:=RightStr(aStr,Length(aStr)-i);
  end;
end;

function DBDVariantToCurrency(const aVal: Variant; out oVal: Currency): Boolean;
var val: Double;
begin
  Result:=DBDVariantToDouble(aVal, val);
  if Result then oVal:=val else oVal:=0;
end;
function DBDVariantToCurrencyDef(const aVal: Variant; const Def: Currency=0): Currency;
var val: Double;
begin
  if DBDVariantToDouble(aVal, val) then Result:=val else Result:=Def;
end;
function DBDVariantToDouble(const aVal: Variant; out oVal: Double): Boolean;
var s: string; i: Integer;
begin
  try
    s:=aVal; i:=1; if not DBDReadDouble(s,i,oVal) then oVal:=0;
    Result:=True;
  except
    Result:=False;
    oVal:=0;
  end;
end;
function DBDVariantToDoubleDef(const aVal: Variant; const Def: Double=0): Double;
var val: Double;
begin
  if DBDVariantToDouble(aVal, val) then Result:=val else Result:=Def;
end;

procedure DBDConvertFileUTF8ToWin1251(const fileIn, fileOut: string);
begin
  //TODO:
end;

function DBDGlueStrings(const Str1, Str2: string; const GlueProp: TDBDStringGlueProp = dbdSPGDefault): string;
begin
  if Str1='' then Result := DBDTrim(Str2)
  else if Str2='' then Result := DBDTrim(Str1)
  else begin
    case GlueProp of
      dbdSGPNoSpace: Result := DBDTrim(Str1) + DBDTrim(Str2);          { TODO : проработать функцию }
      dbdSGPRemoveHipen: begin
        if Str1[Length(Str1)]='-' then begin
          Result := DBDTrim(Copy(Str1,1,Length(Str1)-1)) + DBDTrim(Str2);
        end;
      end;
      dbdSPGDefault: Result := DBDTrim(Str1) + ' ' + DBDTrim(Str2);
    end;
  end;
end;

function DBDTrimChar(const aStr: string; const C: Char; const Side:TDBDStringPart): string;
var iSt,iEn:Integer;
begin
  iSt:=1; iEn:=Length(aStr); Result := aStr;
  if Side in [dbdSPLeft, dbdSPBoth] then begin
    while iSt<=iEn do begin
      if aStr[iSt]=C then Inc(iSt) else Break;
    end;
  end;
  if iSt>iEn then Result := ''
  else begin
    if Side in [dbdSPRight, dbdSPBoth] then begin
      while iEn>=iSt do begin
        if aStr[iEn]=C then Dec(iEn) else Break;
      end;
    end;
    if iEn<iSt then Result := ''
    else Result := Copy(aStr, iSt, iEn-iSt+1);
  end;
end;

function DBDDoubleToString(const D: Double; const Prec: Integer): string;
var p: Integer; e: Extended;
begin
  if D=0 then Result := '0'
  else begin
    if Prec<0 then p:=7 else p:=Prec;
    e:=d+(POW10[-p-1]/2.0);
    Result:=FloatToStrF(e, ffFixed, 15, p, DBDFormatSettings);
    if Prec>2 then Result := DBDTrimChar(Result,'0', dbdSPRight);
    Result := DBDTrimChar(Result,'.', dbdSPRight);
  end;
end;
function DBDDoubleToStringEx(const D: Double; const Prec: Integer): string;
var p: Integer; e: Extended;
begin
  result:=FloatToStrF(d, ffFixed, 15, prec, DBDFormatSettings);
end;

function IndexOfChar(const Ch: Char; const Chars: array of char): Integer;
var i: Integer;
begin
  result := -1;
  for i := Low(Chars) to High(Chars) do  if Ch=Chars[i] then begin Result := i; Break; end;
end;

function DBDToLower(const aStr: string): string;
begin
{$ifdef ISDELPHIXE2}
  Result:=aStr.ToLower;
{$else}
  Result:= SysUtils.AnsiLowerCase(aStr);
{$endif}
end;

function DBDToUpper(const aStr: string): string;
begin
{$ifdef ISDELPHIXE2}
  Result:=aStr.ToUpper;
{$else}
  Result:= SysUtils.AnsiUpperCase(aStr);
{$endif}
end;

function DBDAbbreviation(const aStr: string; const AbbreviationsPtr: PDBDAbbreviations=nil): string;
var r: TDBDAbbreviationItem; p: PDBDAbbreviations;
begin
  result:=aStr;
  if Result<>'' then begin
    if AbbreviationsPtr<>nil then p:=AbbreviationsPtr else p:=DBDAbbreviationsPtr;
    if p=nil then Exit;
    for r in p^ do Result := DBDReplace(Result, r.Phrase, r.Abbreviation, True, True);
  end;
end;

function DBDCorrectString(const aStr: string; const ConvActions: TDBDStrCorrectionActions=[dbdSCARemoveExtaBlanks, dbdSCALatRus]): string;
var i: integer; c,t: Char; b,f: boolean;
{$ifdef ISDELPHIXE2} //delphiXE2 or newer
    sb: TStringBuilder;
{$else}
    sb: string; j: Integer;
{$endif}
begin
  result := aStr; if (aStr = '') or (dbdSCANoAction in ConvActions) then Exit;
{$ifdef ISDELPHIXE2} //delphiXE2 or newer
  sb := TStringBuilder.Create; b:= True; f:=True; t:=#0;
  for c in aStr do begin
    if c.isLetter then begin
      if t=' ' then sb.Append(t);
      if dbdSCALatRus in ConvActions then begin
        i := SomeLatLetters.IndexOf(c);
        if i >= 0 then t := SomeRusLetters.Chars[i] else t := c;
      end else t := c;
      if b and (dbdSCAToInitCaption in ConvActions) then t := t.ToUpper
      else if  (dbdSCAToInitCaption in ConvActions) then t := t.ToLower
      else if  (dbdSCAToLower in ConvActions) then t := t.ToLower
      else if  (dbdSCAToUpper in ConvActions) then t := t.ToUpper;
      b:=False; sb.Append(t); f:=False;
    end else if BLNK.IndexOf(c) >= 0 then begin
      if (dbdSCARemoveExtaBlanks in ConvActions) and b then Continue;
      if not f then t:=' ';
      b:=True;
    end else begin
      if t=' ' then sb.Append(t);
      b:=false; sb.Append(c); f:=False;
    end;
  end;
  result := sb.ToString;
  FreeAndNil(sb);
{$else}
   // TODO:
{$endif}
end;

function DBDFindSubstr(const aStr, Substr: string; const vPos: Integer): Integer;
begin
  if (vPos>0) and (Substr<>'') and (aStr<>'') and (vPos<=Length(aStr)) then begin
{$ifdef ISDELPHIXE2}
  Result:=aStr.IndexOf(Substr,vPos-1)+1;
{$else}
  Result:=StrUtils.PosEx(Substr,aStr,vPos);
{$endif ISDELPHIXE2}
  end else Result:=-1;
end;

function DBDFindChar(const aStr: string; aChr: Char; const vPos: Integer): Integer;
begin
  if (vPos>0) and (aStr<>'') and (vPos<=Length(aStr)) then begin
{$ifdef ISDELPHIXE2}
  Result:=aStr.IndexOf(aChr,vPos-1)+1;
{$else}
  Result:=StrUtils.PosEx(aChr,aStr,vPos);
{$endif ISDELPHIXE2}
  end else Result:=-1;
end;

function DBDRuMonth2Num(const aMonth: string): Word;
var i:Integer; s: string;
begin
  Result:=0;
  if aMonth<>'' then begin
    s := DBDToLower(aMonth);
    for i := Low(RusMonths) to High(RusMonths) do
      if RusMonths[i]=s then begin
        Result := (i mod 12)+1; Exit;
      end;
  end;
end;

function DBDFind(const aStr, aSub: string; const vPos: Integer; const Action: TDBDFindAction=dbdFAFirst): Integer;
begin
  Assert((aStr<>'') and (aSub<>'') and (vPos>0));
  if Action in [dbdFAFirst, dbdFANext] then begin
{$ifdef ISDELPHIXE2}
    Result:=aStr.IndexOf(aSub,vPos-1)+1;
{$else}
    Result:=StrUtils.PosEx(aSub,aStr,vPos);
//    Result:=StrUtils.PosEx(aSub,aStr,vPos);
{$endif ISDELPHIXE2}
  end else begin
{$ifdef ISDELPHIXE2}
    Result:=aStr.LastIndexOf(aSub,vPos-1)+1;
{$else}
    Result :=0;
//    Result:=StrUtils.PosEx(Sub,Str,vPos);
{$endif ISDELPHIXE2}
  end;
end;

function DBDFindStopChar(const aStr: string; Stops: array of Char; vPos: Integer): Integer;
var i: Integer;
begin
  Assert((Length(Stops)<>0) and (aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
{$ifdef ISDELPHIXE2}
  i := aStr.IndexOfAny(Stops, vPos-1);
  if i>=0 then Result:=i+1
          else Result:=0;
{$else}
  Result := 0;
  for i := vPos to Length(aStr) do
    if IndexOfChar(aStr[i], Stops)>=0 then begin
      Result:=i; Break;
    end;
//  Result:=SysUtils.FindDelimiter(string(Stops),Str,vPos);
{$endif ISDELPHIXE2}
end;

function DBDEndsWith(const aStr, aSub: string; const IgnoreSpaces: Boolean=False; const IgnoreCase: Boolean=false): Boolean;
var s: string;
begin
  if IgnoreSpaces then s := DBDTrim(aStr)    // TODO
                  else s:=aStr;
{$ifdef ISDELPHIXE2}
  Result:=s.EndsWith(aSub, IgnoreCase);
{$else}
  if IgnoreCase then Result:=AnsiEndsText(aSub, s)
                else Result:=AnsiEndsStr(aSub, s);
{$endif}
end;

function DBDStartsWith(const aStr, aSub: string; const IgnoreSpaces: Boolean=False; const IgnoreCase: Boolean=false): Boolean;
var s: string;
begin
  if IgnoreSpaces then s:=DBDTrim(aStr)    // TODO
                  else s:=aStr;
{$ifdef ISDELPHIXE2}
  Result:=s.StartsWith(aSub, IgnoreCase);
{$else}
  if IgnoreCase then Result:=AnsiStartsText(aSub, s)
                else Result:=AnsiStartsStr(aSub, s);
{$endif}

end;

function DBDFindNonWhiteSpaces(const aStr: string; const LeftToRight: Boolean=True): Integer;
begin
  if LeftToRight then begin
    Result:=1;
    while (Result<=Length(aStr)) and DBDisWhiteSpace(aStr, Result) do Inc(Result);
    if Result>Length(aStr) then Result := 0;
  end else begin
    Result:=Length(aStr);
    while (Result>0) and DBDisWhiteSpace(aStr, Result) do Dec(Result);
  end;
end;

function DBDTrimSpaces(const aStr: string; const Side:TDBDStringPart=dbdSPBoth): string;
var i,j: Integer;
begin
  Result := ''; i:=0; j:=0;
  if Side in [dbdSPLeft, dbdSPBoth]  then i:=DBDFindNonWhiteSpaces(aStr); if i=0 then Exit;
  if Side in [dbdSPRight, dbdSPBoth] then j:=DBDFindNonWhiteSpaces(aStr, False);
  Result := Copy(aStr,i,j-i+1);
end;

function DBDTrimSubstr(const aStr, aSub: string; const Side:TDBDStringPart=dbdSPBoth): string;
var i,j: Integer;
begin
  if (Side in [dbdSPLeft, dbdSPBoth]) and DBDStartsWith(aStr,aSub) then i:=Length(aSub)+1 else i:=1;
  if (Side in [dbdSPRight, dbdSPBoth]) and DBDEndsWith(aStr,aSub)  then j:=Length(aStr)-Length(aSub) else j:=Length(aStr);
  Result:=Copy(aStr, i, j-i+1);
end;

function DBDisDigit(const aStr: string; const vPos: Integer): Boolean; inline;
var c: Char;
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
//  Result := (Str<>'') and (vPos>0) and (vPos<=Length(Str)); if not Result then Exit;
  c := aStr[vPos];
{$ifdef ISDELPHIXE2}
  Result := c.IsDigit;
{$else}
  {$ifdef FPC_OR_UNICODE}
  Result := System.Pos(c,'0123456789')>0;
  {$else}
  Result := c in ['0'..'9'];
  {$endif FPC_OR_UNICODE}
{$endif ISDELPHIXE2}
end;

function DBDisEmpty(const aStr: string): Boolean;
var i: Integer;
begin
  if aStr='' then Result := True
  else begin
    i:=1;
    while (i<=Length(aStr)) and DBDisWhiteSpace(aStr, i) do Inc(i);
    Result:=(i>Length(aStr));
  end;
end;

function DBDisNumber(const aStr: string): Boolean;
var d: Double; i:Integer;
begin
  i:=1;
  if DBDisEmpty(aStr) then Result:=False
                      else Result:=DBDReadDouble(aStr,i,d);
end;

function DBDisStopChar(const aStr: string; const Stops: array of Char; const vPos: Integer):Boolean;
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
{$ifdef ISDELPHIXE2}
  Result:=aStr.IndexOfAny(Stops, vPos-1)>=0;
{$else}
  Result:=IndexOfChar(aStr[vPos], Stops)>0;
//  Result:=SysUtils.FindDelimiter(String(Stops),aStr,vPos)>1; //??????????????????????????????????????????
{$endif ISDELPHIXE2}
end;

function DBDMonthFromNum(const aMon: Word; const aKind: TDBDMonthNameKind=dbdMNKNominative): string; overload;
begin
  if not DBDMonthFromNum(aMon, Result, aKind) then Result := '';
end;

function DBDMonthFromNum(const aMon: Word; out oMonth: string; const aKind: TDBDMonthNameKind=dbdMNKNominative): Boolean;
begin
  if (aMon<1) or (aMon>12) then Result :=False
  else begin
    case aKind of
      dbdMNKShort:      oMonth := RusMonths[aMon-1];
      dbdMNKGenitive:   oMonth := RusMonths[aMon+11];
      dbdMNKNominative: oMonth := RusMonths[aMon+23];
    end;
    Result := True;
  end;
end;

function DBDMonthToNum(const Month: string): Word;
var i: Integer;
begin
  if Month='' then Result:=0
  else
    for i:=0 to 35 do
      if Month=RusMonths[i] then begin
        result:=(i mod 12)+1; Break;
      end;

end;

function DBDMoveAfterSubstr(const aStr, aSub: string; var vPos: integer): Boolean;
var i: Integer;
begin
  Assert((aStr<>'') and (aSub<>'') and (vPos>0));
  i:= DBDFindSubstr(aStr, aSub, vPos);
  Result:= (i>=vPos);
  if Result then vPos := i+Length(aSub);
end;

function DBDMoveToOtherChar(const aStr: string; Rejects: array of Char; var vPos: Integer): Boolean;
var i: Integer;
begin
  Assert((Length(Rejects)<>0) and (aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
  Result:=False;
  for i := vPos to Length(aStr) do
    if IndexOfChar(aStr[i], Rejects)<0 then begin
      vPos:=i; Result := True; Break;
    end;
end;

function DBDMoveToStopChar(const aStr: string; Stops: array of Char; var vPos: Integer): Boolean;
var i: Integer;
begin
  Assert((Length(Stops)<>0) and (aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
  Result:=False;
{$ifdef ISDELPHIXE2}
  i := aStr.IndexOfAny(Stops, vPos-1);
  if i>=0 then begin vPos:=i+1; Result:=True; end;
{$else}
  for i := vPos to Length(aStr) do
    if IndexOfChar(aStr[i], Stops)>=0 then begin
      vPos:=i; Result := True; Break;
    end;
//  i:=SysUtils.FindDelimiter(string(Stops),Str,vPos);
//  if i>=0 then begin vPos:=i; Result:=True; end;
{$endif ISDELPHIXE2}
end;

function DBDisWhiteSpace(const aStr: string; var vPos: Integer): Boolean; inline;
var c: Char;
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
  c := aStr[vPos];
{$ifdef ISDELPHIXE2}
  Result := c.IsWhiteSpace;
{$else}
  {$ifdef FPC_OR_UNICODE}
    Result := (c=' ') or (c=#9) or (c=#10) or (c=#11) or (c=#12) or (c=#13) or (c='') or (c=#160);
  {$else}
    Result := (c=' ') or (c=#9) or (c=#10) or (c=#11) or (c=#12) or (c=#13) or (c='') or (c=#160);
  {$endif}
{$endif}
end;

function DBDSkipChar(const aStr: string; const Ch: Char; var vPos: Integer): Boolean;
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
{$ifdef ISDELPHIXE2}
  Result:=aStr.Chars[vPos-1]=Ch;
{$else}
  Result:=aStr[vPos]=Ch;
{$endif ISDELPHIXE2}
  if Result then Inc(vPos);
end;

function DBDSkipChars(const aStr: string; const Chars: string; var vPos: Integer): Boolean;
var s: string;
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)) and (Length(Chars)>0));
  while (vPos<=Length(aStr)) do begin
    s := aStr[vPos];
    if Pos(s, Chars)<=0 then Break;
    Inc(vPos);
  end;
  Result:=(vPos<=Length(aStr));
end;

function DBDSkipWhiteSpaces(const aStr: string; var vPos: Integer): Boolean;
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
  while (vPos<=Length(aStr)) and DBDisWhiteSpace(aStr, vPos) do Inc(vPos);
  Result:=(vPos<=Length(aStr));
end;

function DBDFindWhiteSpaces(const aStr: string; const aPos: integer): Integer;
var i: Integer;
begin
  Assert((aStr<>'') and (aPos>0) and (aPos<=Length(aStr)));
  i:=aPos; Result:=0;
  while (i<=Length(aStr)) and (not DBDisWhiteSpace(aStr,i)) do Inc(i);
  if i<=Length(aStr) then Result:=i;
end;

function DBDReadWord(const aStr: string; var vPos: Integer; out oWord: string): Boolean;
var i: Integer;
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
  i:=vPos; oWord:='';
  Result := DBDSkipWhiteSpaces(aStr, i); if not Result then Exit;
  vPos:=DBDFindWhiteSpaces(aStr,i);
  if vPos<1 then vPos:=Length(aStr)+1;
  oWord:=Copy(aStr,i,vPos-i);
end;

function DBDisYearSuffix(const aStr: string; var vPos:Integer; const NextOnTrue:Boolean=True): Boolean;
var i: Integer;
//const YearChars: array[1] of Char = ['г','Г'];
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
  if DBDisWhiteSpace(aStr, vPos) then begin
    Result:=True; i:=vPos+1;
    if not DBDSkipWhiteSpaces(aStr,i) then begin
      if NextOnTrue then vPos:= Length(aStr)+1;
      Exit;
    end;
  end else begin
    Result:=False; i:=vPos;
  end;
  if DBDisStopChar(aStr, ['г','Г'], i) then begin
    if i=Length(aStr) then Result:=True
    else begin
      Inc(i);
      Result:= DBDisStopChar(aStr,[' ','.',','], i);
      if not Result then begin

      end;
    end;
  end;
  if Result and NextOnTrue then vPos:=i;
end;

function DBDNipOffTail(const aStr, aSub: string): string;
var i: Integer;
begin
  result := ''; if DBDisEmpty(aStr) or DBDisEmpty(aSub) then Exit;
{$ifdef ISDELPHIXE2}
  i := aStr.IndexOf(aSub); if i < 0 then Exit;
  result := aStr.Substring(i + aSub.Length).Trim;
{$else}
  i := StrUtils.PosEx(aSub,aStr,1); if i < 0 then Exit;
  Result := Trim(Copy(aStr,i+Length(aSub)));
  i := StrUtils.PosEx(aSub,aStr,1); if i < 0 then Exit;
  Result := Trim(Copy(aStr,i+Length(aSub)));
{$endif ISDELPHIXE2}
end;

function DBDReadDigit(const aStr: string; var vPos: Integer; out oNum: Byte): Boolean;
var c: Char; i: Integer;
begin
  oNum:=0; Result :=((aStr<>'') and (vPos>0) and (vPos<=Length(aStr))); if not Result then Exit;
  c := aStr[vPos];
{$ifdef ISDELPHIXE2}
  i := System.Pos(c,'0123456789')-1;
  Result := i>=0;
{$else}
  {$ifdef FPC_OR_UNICODE}
  i := System.Pos(c,'0123456789')-1;
  Result := i>=0;
  {$else}
  i := Ord(c)-$30;
  Result := (i>=0) and (i<=9);
  {$endif FPC_OR_UNICODE}
{$endif ISDELPHIXE2}
  if Result then begin oNum:=i; Inc(vPos); end;
end;

function DBDReadNumber(const aStr: string; var vPos: Integer; out oNum: Cardinal): Boolean;
var f: Boolean; b: Byte;
const maxCardinal = 429496729; // ~ (4294967295 div 10);
begin
{$IFDEF DEBUG}
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
{$ENDIF}
  Result:=(aStr<>'') and (vPos>0) and (vPos<=Length(aStr)); if not Result then Exit;
  Result := DBDReadDigit(aStr,vPos, b); oNum:=0; if not Result then Exit;
  f := True;
  try
    while f do begin
      oNum := oNum*10+b;
      f := (vPos<=Length(aStr)) and DBDReadDigit(aStr,vPos, b);
    end;
  except
    Result := false; // слишком много цифр подряд
  end;
end;

function DBDReadUInt64(const aStr: string; var vPos: Integer; out oNum: UInt64): Boolean;
var f: Boolean; b: Byte;
const MaxUInt64 = 18446744073709551615;
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
  Result := DBDReadDigit(aStr,vPos, b); if not Result then Exit;
  f := vPos<=Length(aStr);
  if not f then begin oNum:=b; Exit; end;
  oNum:=0;
  try
    while f do begin
      oNum := oNum*10+b;
      f := DBDReadDigit(aStr,vPos, b) or (vPos<=Length(aStr));
    end;
  except
    Result := false; // слишком много цифр подряд
  end;
end;

function DBDReadMonth(const aStr: string; var vPos: Integer): Word;
var s: string; c: Char; i: Integer;
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
  c := aStr[vPos]; i:=vPos; Result:=0;
{$ifdef ISDELPHIXE2} //delphiXE2 or newer
  c:=c.ToLower;
  if (c='а') or (c='м') or (c='и') or (c='д') or (c='н') or (c='о') or (c='с') or (c='я') then begin
    i:=DBDFindStopChar(aStr,[' ','-','.'], vPos);
    if i=0 then i:= Length(aStr)+1;
    s := Copy(aStr,vPos, i-vPos);
    Result:= DBDRuMonth2Num(s);
  end;
{$else}
  {$ifdef FPC_OR_UNICODE}
  {$else}
  {$endif}
{$endif}
  if Result>0 then vPos:=i;
end;

function DBDReadTime(const aStr: string; var vPos: Integer; out oTime: TDateTime): Boolean;
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
  // TODO
end;

function DBDReadDate(const aStr: string; var vPos: Integer; out oDate: TDateTime; const DayOption: TdbdDayOption; const Year: Word): Boolean;
var iPos: Integer; d,m,y: Word; n: Cardinal; Sep: Char; dt: TDateTime;
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
  Result:=False;
  iPos:= vPos; if not DBDSkipWhiteSpaces(aStr, iPos) then Exit;
  d:=0; m:=0; y:=0; n:=0; Sep:=#0; oDate:=0;
  Result := DBDReadNumber(aStr, iPos, n);
  if Result then begin
    if (n=0) or (n>31) then begin Result := False; Exit; end;
    d:=n;
  end else if DayOption=dbdDOMandatoryDay then Exit   // день должен быть указан
  else begin
    m:=DBDReadMonth(aStr, iPos); if m=0 then Exit;      // не месяц
  end;
  if m=0 then begin
    //////
    Sep:= aStr[iPos];
    Result:= DBDisStopChar(aStr,[' ','.','/','-'],iPos); if not Result then Exit;
    Inc(iPos);
    //////
    Result := DBDReadNumber(aStr, iPos, n);
    if not Result then begin
      m:=DBDReadMonth(aStr, iPos); if m=0 then Exit;       // не месяц
    end else if n=0 then begin Result := False; Exit; end  //цифры должны быть
    else if n<=12 then m:=n
    else if (d<=12) and (DayOption<>dbdDOMandatoryDay) then begin
      m:=d; y:=n; d:=0;
    end else begin Result := False; Exit; end;
  end;
  if y=0 then begin
    Result:=(Sep=aStr[iPos]) or (Sep=#0);
    if not Result then begin // возможно, что день или год не представлены, т.е. только один разделитель
      if DayOption=dbdDOMandatoryDay then y:= Year
                                     else begin m:=d; y:=m; d:=0; end;
      if y=0 then Exit;
      { TODO : проверить хвост года (г.) }
    end else begin
      Inc(iPos);
      Result := DBDReadNumber(aStr, iPos, n);
      if Result then begin
        if n=0 then Exit;
        y:=n;
      { TODO : проверить хвост года (г.) }
      end else begin
        if Year>0 then y := Year;
      end;
    end;
  end else begin
    { TODO : проверить хвост года (г.) }
  end;
  if      y<50   then y:=y+2000
  else if y<99   then y:=y+1900
  else if y<1960 then Exit;     //до моего дня рождения жизни не было
  if (d=0) and (DayOption=dbdDOFirstDay) then d:=1;
  if d<>0 then begin
    Result:=TryEncodeDate(y,m,d,dt);
  end else if (DayOption=dbdDOLastDay) then begin
    Result:=TryEncodeDate(y,m,1,dt);
    dt:=EndOfTheMonth(dt); ReplaceTime(dt,0);
  end else begin Result:=False; Exit; end;
  if Result then begin vPos:=iPos; oDate:= dt; end;
end;

function DBDReadPeriod(const aStr: string; var vPos: Integer; out StartDate: TDateTime; out EndDate: TDateTime; const Prefix: string='период'): Boolean;
const PeriodBegin: string = 'с '; PeriodSep: string = 'по ';
var i: Integer;
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
  Result:= False; StartDate:=0; EndDate:=0;
  i:=DBDFindSubstr(aStr, Prefix, vPos); if i<0 then Exit;
  i:=i+Length(Prefix); if not DBDSkipWhiteSpaces(aStr,i) then Exit;
  Result:=(Copy(aStr,i, Length(PeriodBegin))=PeriodBegin); if not Result then Exit;
  i:=i+Length(PeriodBegin);
  Result:=DBDReadDate(aStr,i,StartDate, dbdDOMandatoryDay, 0); if not Result then Exit;
  i := DBDFindSubstr(aStr, PeriodSep, i); if i<0 then Exit;
  if not DBDSkipWhiteSpaces(aStr,i) then Exit;
  Result:=(Copy(aStr,i, Length(PeriodSep))=PeriodSep); if not Result then Exit;
  i:=i+Length(PeriodSep);
  Result:=DBDReadDate(aStr,i,EndDate, dbdDOMandatoryDay,0);
  if Result then vPos:=i;
end;

function DBDReadInteger(aStr: string; var vPos: Integer; out Num: Integer): Boolean;
var Minus: Boolean; iPos: Integer; u: UInt64;
begin
  Assert((aStr<>'') and (vPos>0) and (vPos<=Length(aStr)));
  Result:=False; iPos:=vPos; if not DBDSkipWhiteSpaces(aStr, iPos) then Exit;
  if      aStr[iPos]='-' then begin Minus:= True; Inc(iPos); end
  else if aStr[iPos]='+' then begin Minus:= False; Inc(iPos); end
  else Minus:= False;
  Result:=DBDReadUInt64(aStr,iPos, u);
  if Result then begin
    Result := (iPos>Length(aStr)) or DBDisStopChar(aStr,[' ',','], vPos);
    if Minus then Num:=-u else Num:=u;
  end;
end;

function DBDReplace(const aStr, aOld, aNew: string; All: Boolean=False; const IgnoreCase: Boolean=False): string;
var rf: TReplaceFlags;
begin
  if (aStr='') or (aOld='') then Result := aStr
  else begin
    rf:=[];
    if All then rf:=rf+[rfReplaceAll];
    if IgnoreCase then rf:=rf+[rfIgnoreCase];
{$ifdef ISDELPHIXE2}
//  Result:=aStr;
    Result := aStr.Replace(aOld, aNew, rf);
{$else}
    Result:=StringReplace(aStr,aOld,aNew,rf);
{$endif}
  end;
end;

function DBDReplaceChars(const aStr: String; const aOld, aNew: array of Char; All: Boolean=False; const IgnoreCase: Boolean=False): string;
  function IdxChar(const Ch: Char): Integer;
  var i: Integer;
  begin
    Result:=-1;
    for i := Low(aOld) to High(aOld) do
      if Ch=aOld[i] then begin Result:=i; Break; end;
  end;
var i,j: Integer; c: Char;
begin
  Result:='';
  for i := 1 to Length(aStr) do begin
    c:=aStr[i];
    if IgnoreCase then
    {$IFDEF DELPHIXE2}
       c.ToUpper;
    {$ELSE}
       c := UpCase(c); 
    {$ENDIF}
    j:=IdxChar(c);
    if (j>=0) and (j<=High(aNew)) then begin
      Result := Result + aNew[j];
      if not All then begin
        Result := Result + Copy(aStr,i+1, Length(aStr)-i);
        Break;
      end;
    end else Result := Result + c;
  end;
end;

function DBDReadDouble(aStr: string; out Val:Double): Boolean; overload;
var i: Integer;
begin
  i:=1; Result:=DBDReadDouble(aStr,i,Val);
end;

function DBDReadDouble(aStr: string; var vPos: Integer; out Val:Double): Boolean;
var Minus: Boolean; iPos: Integer; u,i: UInt64;
var f: Boolean; b: Byte;
begin
  Val := 0;
  result:=(aStr<>'') and (vPos>0) and (vPos<=Length(aStr)); if not Result then Exit;
  Result:=False; iPos:=vPos; if not DBDSkipWhiteSpaces(aStr, iPos) then Exit;
  if      aStr[iPos]='-' then begin Minus:= True; Inc(iPos); end
  else if aStr[iPos]='+' then begin Minus:= False; Inc(iPos); end
  else Minus:= False;
  Result := DBDReadDigit(aStr,iPos, b);
  if not Result then begin
    Result := (aStr[iPos]='.') or (aStr[iPos]=',');
    if not Result then Exit;
  end;
  f:=True; u:=0;
  try
    while f do begin
      u := u*10+b;
      f := (iPos<=Length(aStr)) and DBDReadDigit(aStr,iPos, b);
    end;
    if (iPos>Length(aStr)) or (Ord(aStr[iPos])=0) or DBDisWhiteSpace(aStr,iPos) then begin
      Val:=u; vPos:=iPos;
    end else if (aStr[iPos]='.') or (aStr[iPos]=',') then begin
      Inc(iPos);
      if (iPos>Length(aStr)) or (Ord(aStr[iPos])=0) or DBDisWhiteSpace(aStr,iPos) then begin
         Val:=u; vPos:=iPos;
      end else begin
        i:=1; f:=True; Val:=u;
        Result := DBDReadDigit(aStr,iPos, b); u:=0; if not Result then Exit;
        while f do begin
          u := u*10+b; i:=i*10;
          f := (iPos<=Length(aStr)) and DBDReadDigit(aStr,iPos, b);
        end;
        Val := Val + u/i;
        vPos:=iPos;
      end;
    end else if (Ord(aStr[iPos])=0) then begin
      f:= False;
    end;
    if Minus then Val:=-Val;
  except
    Result := False;
  end;
end;

function DBDReadDoubleEx(aStr: string; var vPos: Integer; out Val:Double): Boolean;
var Minus: Boolean; iPos: Integer; u,i: UInt64;
var f: Boolean; b: Byte; TSep,DSep: Char;
begin
{ TODO 1 -oHomer -cВажно :
Прочитать из строки число в расширенном формате
число может содержать разделители тысяч
отрицательное число может быть заключено в скобки
число может начинаться или заканчиваться символом валюты }
end;

function DBDStringToDouble(const S: string; out D: Double): Boolean;
var i: Integer;
begin
  i:=1; Result := DBDSkipWhiteSpaces(S,i) and DBDReadDouble(S,i,D);
end;

procedure DBDSplitString(const aStr, aSep: string; out oLeft, oRight: string);
var i,l,m: Integer;
begin
  oLeft:=''; oRight:='';
  if (not DBDisEmpty(aStr)) and (not DBDisEmpty(aSep)) then begin
    l:=Length(aStr); m:=Length(aSep); i:=Pos(aSep, aStr);
    if      i=1 then oRight:=Copy(aStr, m+1, l-m)
    else if i=l-m+1 then oLeft:=Copy(aStr,1, l-m)
    else if i>1 then begin
      oLeft:=Copy(aStr,1,i-1);
      oRight:=Copy(aStr, i+m, l-i-m+1);
    end else oLeft:=aStr;
  end;
end;

procedure DBDSplitString(const aStr: string; const aSep: Char; out oLeft, oRight: string; const CurrentPosSide: Integer=0); overload;
var i: Integer;  {$IFNDEF ISDELPHIXE2} p: PChar; {$ENDIF}
begin
  oLeft:=''; oRight:='';
{$ifdef ISDELPHIXE2}
  i:=aStr.IndexOf(aSep);
  if i=0 then oRight:= aStr
  else if i=aStr.Length-1 then oLeft:=aStr.Substring(0,aStr.Length-1)
  else if i>0 then begin
    oLeft:=aStr.Substring(0,i);
    oRight:=aStr.Substring(i+1);
  end else oLeft:=aStr;
{$else}
  p := StrScan(@aStr[1],aSep);
  if p=nil then oRight:=aStr
  else if p=@aStr[1] then oLeft:=aStr
  else if p = @aStr[Length(aStr)] then oLeft:=Copy(aStr,1,Length(aStr)-1)
  else begin
    i:=p-@aStr[1];                                 ////Unicode char =2byte??????????????????????????
    oLeft:=Copy(aStr,1,i);
    oRight:=Copy(aStr, i+1+1, Length(aStr)-i);
  end;
{$endif ISDELPHIXE2}
end;

procedure DBDStringToArray(const aStr, aSep: string; out oStrArray: TStringDynArray);
var i,iPos: Integer;
begin
  SetLength(oStrArray,0);
  if (not DBDisEmpty(aStr)) and (not DBDisEmpty(aSep)) then begin
    iPos:=1;
    i := DBDFindSubstr(aStr,aSep,iPos);
    while i>=iPos do begin
      SetLength(oStrArray, Length(oStrArray)+1);
      if i>iPos then oStrArray[High(oStrArray)]:=Copy(aStr,iPos, i-iPos)
                else oStrArray[High(oStrArray)]:='';
      iPos:=i+Length(aSep);
      i := DBDFindSubstr(aStr,aSep,iPos);
    end;
    SetLength(oStrArray, Length(oStrArray)+1);
    oStrArray[High(oStrArray)]:=Copy(aStr,iPos, Length(aStr)-iPos+1);
  end;
end;

function DBDExtracrMarkedText(var aStr: string; const aMark: Char; var vPos: Integer; out MarkedText: string;
                              const RemoveMarked: Boolean=True): Boolean;
var i,j,l: Integer; {$IFNDEF ISDELPHIXE2} p: PChar; {$ENDIF}
begin
  Result:=false;
{$ifdef ISDELPHIXE2}
  i:=aStr.IndexOf(aMark, vPos-1);
  if i>=0 then begin
    j:=aStr.IndexOf(aMark, i+1);
    l:=j-i+1; if l<2 then Exit;
    if RemoveMarked then begin
      vPos:=i+1;
      MarkedText := aStr.Substring(i,l);
      aStr:=aStr.Remove(i,l);
    end else begin
      vPos:=j+1;
    end;
    Result:= True;
  end;
{$else}
  p := StrScan(@aStr[1],aMark);
  if p<> nil then begin
    i :=p-@aStr[1];
  end;
{$endif ISDELPHIXE2}
end;

function DBDExtracrMarkedText(const aStr, aMark: string; var vPos: Integer; out MarkedText: string): Boolean;
var i,j,l,m: Integer;
begin
  MarkedText:=''; Result:=False;
  if (not DBDisEmpty(aStr)) and (not DBDisEmpty(aMark)) and (vPos>0) then begin
    l:=Length(aStr); m:=Length(aMark);
    if vPos>l-2*m then Exit;
    i := DBDFind(aStr,aMark,vPos); if (i<=0) or (i+m>l) then Exit;
    l:=i+m;
    j := DBDFind(aStr,aMark,l); if j<=l then Exit;
    if l<j then MarkedText:= Copy(aStr, l+1, j-l);
    vPos:=j+m; Result := True;
  end;
end;

function DBDSaveUTF8ToFile(const FN: TFileName; const S: RawUTF8): boolean;
var mp: TMemoryMapText;
begin
  mp:=TMemoryMapText.Create;
  try
    mp.AddInMemoryLine(S);
    try
      if FileExists(FN) then Result := DeleteFile(FN)
                        else Result:=True;
      if not Result then Exit;
      mp.SaveToFile(FN);
      Result:=True;
    except
      Result:=False;
    end;
  finally
    mp.Free;
  end;
end;

//===========================================================================================================

{ TDBDString }

class function TDBDString.Abbreviation(const aStr: string; const AbbreviationsPtr: PDBDAbbreviations): string;
begin
  if (aStr<>'') then Result:=DBDAbbreviation(aStr, AbbreviationsPtr);
end;

procedure TDBDString.Abbreviation(const AbbreviationsPtr: PDBDAbbreviations);
begin
  if (FCurrentPos>0) then begin
    FText:=DBDAbbreviation(FText, AbbreviationsPtr);
    FCurrentPos:=1;
  end;
end;

class function TDBDString.CorrectString(const aStr: string; const ConvActions: TDBDStrCorrectionActions=[dbdSCARemoveExtaBlanks, dbdSCALatRus]): string;
var i: integer; c,t: Char; b: boolean;
{$ifdef ISDELPHIXE2} //delphiXE2 or newer
    sb: TStringBuilder;
{$else}
    sb: string; j: Integer;
{$endif}
begin              { TODO -cВажно : Удлить пробелы в начале и конце исходной строки при необходимости }
  result := aStr; if (aStr = '') or (dbdSCANoAction in ConvActions) then Exit;
{$ifdef ISDELPHIXE2} //delphiXE2 or newer
  sb := TStringBuilder.Create; b:= true;
  for c in aStr do begin
    if c.isLetter then begin
      if dbdSCALatRus in ConvActions then begin
        i := SomeLatLetters.IndexOf(c);
        if i >= 0 then t := SomeRusLetters.Chars[i] else t := c;
      end else t := c;
      if b and (dbdSCAToInitCaption in ConvActions) then t := t.ToUpper
      else if  (dbdSCAToInitCaption in ConvActions) then t := t.ToLower
      else if  (dbdSCAToLower in ConvActions) then t := t.ToLower
      else if  (dbdSCAToUpper in ConvActions) then t := t.ToUpper;
      b:= false;
    end else if BLNK.IndexOf(c) >= 0 then begin
      if (dbdSCARemoveExtaBlanks in ConvActions) and b then Continue;
      b:=true; t := ' ';
    end else begin t := c; b:= false; end;
    sb.Append(t);
  end;
  result := sb.ToString;
  sb.Free;
{$else}
  sb := '';
  for i := 1 to Length(aStr) do begin
    c := aStr[i];
    if Pos(c,BLNK)>0 then  begin
      if (dbdSCARemoveExtaBlanks in ConvActions) and b then Continue;
      b:=true; t := ' ';
    end else begin;
      if dbdSCALatRus in ConvActions then begin
        j:=Pos(c, SomeLatLetters);
        if j>0 then t:=SomeRusLetters[j] else t:=c;
      end else if dbdSCARusLat in ConvActions then begin
        j:=Pos(aStr[i], SomeRusLetters);
        if j>0 then t:=SomeLatLetters[j] else t:=c;
      end;
      if b and ((dbdSCAToInitCaption in ConvActions)) then t:=DBDUpperChar1251(c)
      else if  (dbdSCAToInitCaption in ConvActions) then t:=DBDLowerChar1251(c)
      else if  (dbdSCAToLower in ConvActions) then t:=DBDLowerChar1251(c)
      else if  (dbdSCAToUpper in ConvActions) then t:=DBDUpperChar1251(c);
      b := False;
    end;
    sb:=sb+t;
  end;
  Result := sb;
{$endif}
  if dbdSCAAbbreviation in ConvActions then DBDAbbreviation(aStr);
end;

procedure TDBDString.CorrectString(const ConvActions: TDBDStrCorrectionActions=[dbdSCARemoveExtaBlanks, dbdSCALatRus]);
begin
  FText := CorrectString(FText, ConvActions);
end;

constructor TDBDString.Create(aStr: string; const DoTrim: boolean);
begin
  if DoTrim then SetText(DBDTrim(aStr))
            else SetText(aStr);
end;

constructor TDBDString.Create(aStr: string; const ConvActions: TDBDStrCorrectionActions);
begin
  SetText(DBDCorrectString(aStr,ConvActions));
end;

function TDBDString.CutOffLeft(const IncludeCurChar: Boolean): string;
var s: string;
begin
  if IncludeCurChar then Split(Result,s, -1) else Split(Result,s,0);
  SetText(s);
end;

function TDBDString.EndsWith(const aSub: string; const IgnoreCase: Boolean): Boolean;
begin
{$ifdef ISDELPHIXE2}
  Result:=FText.EndsWith(aSub, IgnoreCase);
{$else}
  if IgnoreCase then Result:=AnsiEndsText(aSub, FText)
                else Result:=AnsiEndsStr(aSub, FText);
{$endif}
end;

function TDBDString.ExtracrMarkedText(const aMark: Char; out MarkedText: string; const RemoveMarked: Boolean): Boolean;
begin
  Result := DBDExtracrMarkedText(FText, aMark, FCurrentPos, MarkedText, False);
end;

function TDBDString.ExtracrMarkedText(const aMark: string; out MarkedText: string; const RemoveMarked: Boolean): Boolean;
var i,l: Integer;
begin
  i:=FCurrentPos;
  Result := DBDExtracrMarkedText(FText, aMark, i, MarkedText);
  if Result then begin
    l := Length(MarkedText)+2*Length(aMark);
    FCurrentPos:=FCurrentPos-l+1;
    FText:=Copy(FText, 1, FCurrentPos-1) + Copy(FText,FCurrentPos, Length(FText)-1);
  end;
end;

class function TDBDString.FindStopChar(const aStr: string; const Stops: array of Char; const vPos: Integer): Integer;
begin
  if (aStr='') or (vPos<1) or (vPos>Length(aStr)) or (Length(Stops)=0) then Result:=0
  else Result:=DBDFindStopChar(aStr,Stops,vPos);
end;

function TDBDString.FindStopChar(const Stops: array of Char): Integer;
begin
  if (FText='') or (FCurrentPos<1) or (Length(Stops)=0) then Result := 0
  else Result := DBDFindStopChar(FText, Stops, FCurrentPos);
end;

function TDBDString.FindSubstr(const aSub: string): Integer;
begin
  if (FText='') or (FCurrentPos<1) or (Length(aSub)=0) then Result := 0
  else begin
    Result:=DBDFindSubstr(FText,aSub,FCurrentPos);
    if Result>0 then FCurrentPos:=Result;
  end;
end;

class function TDBDString.FindWhiteSpace(const aStr: string; const vPos: Integer): Integer;
var i: Integer;
begin
  Result:=0; if (aStr='') or (vPos<1) or (vPos>Length(aStr)) then Exit;
  i := vPos;
  while i <= Length(aStr) do begin
    if isWhiteSpace(aStr, i, False) then begin Result:=i; Break; end;
    Inc(i);
  end;
end;

function TDBDString.First(const noWhiteSpace: Boolean): Boolean;
begin
  Result:=(FCurrentPos>0);
  if Result then begin
    FCurrentPos:=1;
    if noWhiteSpace then Result:=SkipWhiteSpaces;
  end;
end;

function TDBDString.GetCurrentChar: Char;
begin
  if (FCurrentPos<=0) or (FCurrentPos>Length(FText)) then Result:=#0
                                                     else Result := FText[FCurrentPos];
end;

procedure TDBDString.InternalSetCurrentPos(const Value: Integer);
begin
  if (Value<0) then FCurrentPos:=-1
  else if Value>Length(FText) then FCurrentPos:=0
  else FCurrentPos:=Value;
end;

class function TDBDString.isDigit(const aStr: string; var vPos: Integer; const NextOnTrue: Boolean): Boolean;
begin
  if (aStr<>'') and (vPos>0) and (vPos<=Length(aStr)) then Result:=DBDisDigit(aStr, vPos)
                                                    else Result:=False;
  if Result and NextOnTrue then Inc(vPos);
end;

function TDBDString.isDigit(const NextOnTrue: Boolean): Boolean;
begin
  if (FText='') or (FCurrentPos<1) then Result:=False
  else if DBDisDigit(FText, FCurrentPos) then begin
    Result:=True;
    if NextOnTrue then InternalSetCurrentPos(FCurrentPos+1);
  end else Result:=False;
end;

class function TDBDString.isEmpty(const aStr: string): Boolean;
begin
  Result:=DBDisEmpty(aStr);
end;

function TDBDString.isEmpty: Boolean;
begin
  Result := (FCurrentPos<1) or DBDisEmpty(FText);
end;

class function TDBDString.isStopChar(const aStr: string; const Stops: array of Char; var vPos: Integer; const NextOnTrue: Boolean): boolean;
begin
  if (aStr<>'') and (vPos>=1) and (vPos<=Length(aStr)) and (Length(Stops)<>0) then begin
    Result:=DBDisStopChar(aStr,Stops,vPos);
    if Result and NextOnTrue then Inc(vPos);
  end else Result:=False;
end;

function TDBDString.isStopChar(const Stops: array of Char; const NextOnTrue: Boolean): boolean;
begin
  if (Length(Stops)=0) or (FCurrentPos<1) then Result:=False
  else if DBDisStopChar(FText,Stops,FCurrentPos) then begin
    Result:=True;
    if NextOnTrue then InternalSetCurrentPos(FCurrentPos+1);
  end else Result:=False;
end;

class function TDBDString.isWhiteSpace(const aStr: string; var vPos: Integer; const NextOnTrue: Boolean): Boolean;
begin
  Result := (aStr<>'') and (vPos>0) and (vPos<=Length(aStr)); if not Result then Exit;
  Result:= DBDisWhiteSpace(aStr,vPos);
  if Result and NextOnTrue then Inc(vPos);
end;

function TDBDString.isWhiteSpace(const NextOnTrue: Boolean): Boolean;
begin
  if (FCurrentPos<1) then Result:=False
  else if DBDisWhiteSpace(FText,FCurrentPos) then begin
    Result:=True;
    if NextOnTrue then InternalSetCurrentPos(FCurrentPos+1);
  end else Result:=False;
end;

function TDBDString.Last(const noWhiteSpace: Boolean=true): Boolean;
var i: Integer;
begin
  Result:=FCurrentPos>0;
  if Result then begin
    i:=Length(FText);
    if noWhiteSpace then
      while i>0 do begin
        Result := not isWhiteSpace(FText, i, False);
        if Result then Break;
        Dec(i);
      end;
    FCurrentPos:=i;
  end;
end;

function TDBDString.LengthTxt: Integer;
begin
  Result:= Length(FText);
end;

class function TDBDString.MoveToStopChar(const aStr: string; const Stops: array of Char; var vPos: Integer): Boolean;
begin
  if (aStr='') or (vPos<1) or (vPos>Length(aStr)) then Result:=False
  else Result:=DBDMoveToStopChar(aStr, Stops, vPos);
end;

class function TDBDString.StrNormalization(const aStr: string): string;
var s: string; c: char;
begin
  Result:=DBDTrimSpaces(aStr); if Result='' then Exit;
  s:=DBDToUpper(Result);
  Result:='';
  for c in s do
    if (Pos(c, RusUpLetters)>0) or (pos(c,'0123456789')>0) or (Pos(c, LatUpLetters)>0) then Result:=Result+c;
end;

function TDBDString.MoveToOtherChars(const Stops: array of Char): Boolean;
begin
  if (FText='') or (FCurrentPos<1) or (FCurrentPos>Length(FText)) then Result:=False
  else
    repeat
       Result := (not isStopChar(Stops)); if Result then Exit;
    until (FCurrentPos<1) or (FCurrentPos>Length(FText));
end;

function TDBDString.MoveToStopChar(const Stops: array of Char): Boolean;
begin
  if (FText='') or (FCurrentPos<1) or (FCurrentPos>Length(FText)) then Result:=False
  else Result := DBDMoveToStopChar(FText,Stops,FCurrentPos);
end;

function TDBDString.Next(const Step: Word=1): Boolean;
var n: Word;
begin
  if Step<=1 then n:=1 else n:=Step;
  Result := (FCurrentPos>0) and (FCurrentPos+n<Length(FText));
  if Result then Inc(FCurrentPos, n);
end;

class function TDBDString.NipOffTail(const aStr, aSub: string): string;
begin
  if (aStr='') or (aSub='') then Result := ''
                          else Result := DBDNipOffTail(aStr, aSub);
end;

function TDBDString.Preceding: string;
begin
  if FCurrentPos<1 then result:=FText
                   else Result:= Copy(FText,1, FCurrentPos-1);
end;

function TDBDString.Prev(const Step: Word): Boolean;
var n: Word;
begin
  if Step<=1 then n:=1 else n:=Step;
  Result := (FCurrentPos>n);
  if Result then Dec(FCurrentPos,n);
end;

class function TDBDString.ReadDate(const aStr: string; var vPos:Integer; out oDate: TDateTime; const DayOption: TdbdDayOption; const Year: Word): Boolean;
begin
  if (aStr<>'') and (vPos>0) and (vPos<=Length(aStr)) then Result:=DBDReadDate(aStr, vPos, oDate, DayOption, Year)
                                                    else Result:=False;
end;

function TDBDString.ReadDate(out oDate: TDateTime; const DayOption: TdbdDayOption; const Year: Word): Boolean;
begin
  Result:=DBDReadDate(FText, FCurrentPos, oDate, DayOption, Year);
  if FCurrentPos>Length(FText) then FCurrentPos:=0;
end;

class function TDBDString.ReadDigit(const aStr: string; var vPos: Integer; out oNum: Byte): Boolean;
begin
  if (aStr<>'') and (vPos>0) and (vPos<=Length(aStr)) then Result := DBDReadDigit(aStr, vPos, oNum)
                                                    else Result:=False;
end;

function TDBDString.ReadDigit(out oNum: Byte): Boolean;
begin
  if FCurrentPos<1 then Result:=False
  else if DBDReadDigit(FText, FCurrentPos, oNum) then begin
    Result:=True;
    if FCurrentPos>Length(FText) then FCurrentPos:=0;
  end else Result:=False;
end;

class function TDBDString.ReadMonth(const aStr: string; var vPos: Integer): Word;
begin
  if (aStr='') or (vPos<1) or (vPos>Length(aStr)-2) then Result:=0
                                                  else Result:=DBDReadMonth(aStr,vPos);
end;

function TDBDString.ReadMonth: Word;
begin
  if (FCurrentPos<1) or (FCurrentPos>(Length(FText)-2)) then Result:=0
  else begin
    Result:=DBDReadMonth(FText,FCurrentPos);
    if (Result>0) and (FCurrentPos>Length(FText)) then FCurrentPos:=0;
  end;
end;

class function TDBDString.ReadNumber(const aStr: string; var vPos: Integer; out oNum: Cardinal): Boolean;
begin
  if (aStr='') or (vPos<1) or (vPos>Length(aStr)) then Result:= False
                                                  else Result:=DBDReadNumber(aStr,vPos,oNum);
end;

function TDBDString.ReadNumber(out oNum: Cardinal): Boolean;
begin
  if FCurrentPos<1 then Result:=False
  else if DBDSkipWhiteSpaces(FText,FCurrentPos) and DBDReadNumber(FText,FCurrentPos,oNum) then begin
    Result:=True;
    if FCurrentPos>Length(FText) then FCurrentPos:=0;
  end else Result:=False;
end;

function TDBDString.ReadPeriod(out StartDate: TDateTime; out
  EndDate: TDateTime; const Prefix: string): Boolean;
begin
  if FCurrentPos>0 then Result:=DBDReadPeriod(FText, FCurrentPos, StartDate, EndDate, Prefix)
                   else begin Result:=False; StartDate:=0;EndDate:=0; end;
end;

function TDBDString.ReadWord(out oWord: string): Boolean;
begin
  oWord:='';
  if FCurrentPos<1 then Result:=False
  else begin
    Result := DBDReadWord(FText, FCurrentPos, oWord);
    if FCurrentPos>Length(FText) then FCurrentPos:=0;
  end;
end;

function TDBDString.Remainder: string;
begin
  if FCurrentPos<1 then result:=''
                   else Result:= Copy(FText,FCurrentPos+1);
end;

class function TDBDString.Replace(const aStr, aOld, aNew: string;
  const All: Boolean; const IgnoreCase: Boolean): string;
begin
  if (aStr='') or (aOld='') then Result:=aStr
                            else Result:=DBDReplace(aStr,aOld,aNew,All,IgnoreCase);
end;

class function TDBDString.ReadWord(const aStr: string; var vPos: Integer; out oWord: string): Boolean;
begin
  oWord:='';
  if (aStr<>'') and (vPos>0) and (vPos<=Length(aStr)) then Result := DBDReadWord(aStr,vPos, oWord)
                                                      else Result:=false;
end;

procedure TDBDString.SetCurrentChar(const Value: Char);
var i: Integer;
begin
 if Value=#0 then begin
   i:=FCurrentPos;
   if i<2 then SetText('') else SetText(Copy(FText,1,i-1));
//текущая позиция уходит к первому символу
 end else if (FCurrentPos>0) and (FCurrentPos<=Length(FText)) then FText[FCurrentPos] := Value;
end;

procedure TDBDString.SetCurrentPos(const Value: Integer);
begin
  if FText='' then FCurrentPos:=-1
  else if (Value<1) and (Value>Length(FText)) then
    raise Exception.Create('Номер позиции в строке не может быть меньше 1 и больше длины строки')
  else FCurrentPos := Value;
end;

procedure TDBDString.SetText(const Value: string);
begin
  if               Value='' then FCurrentPos:=-1
  else if DBDisEmpty(Value) then FCurrentPos:= 0
  else                           FCurrentPos:= 1;
  FText := Value;
end;

class function TDBDString.SkipWhiteSpaces(const aStr: string; var vPos: Integer): Boolean;
begin
  if (aStr<>'') and (vPos>0) and (vPos<=Length(aStr)) then Result:=DBDSkipWhiteSpaces(aStr,vPos)
                                                    else Result:=False;
end;

function TDBDString.SkipWhiteSpaces: Boolean;
begin
  if FCurrentPos<1 then Result:=False
  else if DBDSkipWhiteSpaces(FText,FCurrentPos) then Result:=True
  else begin FCurrentPos:=0; Result:=False; end;
end;

procedure TDBDString.Split(out Left: string; out Right: string;
  const CurrentPosSide: Integer);
var i,j: Integer;
begin
  if FCurrentPos<1 then begin
    Left:=''; Right:='';
  end else begin
    if      CurrentPosSide = 0 then begin i:=FCurrentPos-1; j:=FCurrentPos+1; end
    else if CurrentPosSide < 0 then begin i:=FCurrentPos;   j:=FCurrentPos+1; end
    else                            begin i:=FCurrentPos-1; j:=FCurrentPos;   end;
    if i<=0 then Left:='' else Left:=Copy(FText,1,i);
    if j>Length(FText) then Right:='' else Right:=Copy(FText,j,Length(FText)-j+1);
  end;
end;

class function TDBDString.StartsWith(const aStr, aSub: string; const IgnoreCase: Boolean): Boolean;
begin
{$ifdef ISDELPHIXE2}
  Result:=aStr.StartsWith(aSub, IgnoreCase);
{$else}
  if IgnoreCase then Result:=AnsiStartsText(aSub, aStr)
                else Result:=AnsiStartsStr(aSub, aStr);
{$endif}
end;

function TDBDString.StartsWith(const aSub: string; const IgnoreCase: Boolean): Boolean;
begin
{$ifdef ISDELPHIXE2}
  Result:=FText.StartsWith(aSub, IgnoreCase);
{$else}
  if IgnoreCase then Result:=AnsiStartsText(aSub, FText)
                else Result:=AnsiStartsStr(aSub, FText);
{$endif}
end;

class function TDBDString.ToLower(const Str: string): string;
begin
{$ifdef ISDELPHIXE2}
  Result:=Str.ToLower;
{$else}
  Result:= AnsiLowerCase(Str);
{$endif}
end;

class function TDBDString.ToUpper(const Str: string): string;
begin
{$ifdef ISDELPHIXE2}
  Result:=Str.ToUpper;
{$else}
  Result:= AnsiUpperCase(Str);
{$endif}
end;

procedure TDBDString.TrimChar(const C: Char; const Side: TDBDStringPart);
begin
  SetText(DBDTrimChar(FText,C,Side));
end;

procedure InitAbbreviations;
begin
  SetLength(DBDAbbreviations,3);
  DBDAbbreviations[0].Abbreviation:='ООО'; DBDAbbreviations[0].Phrase:='Общество с ограниченной ответственностью';
  DBDAbbreviations[1].Abbreviation:='ЗАО'; DBDAbbreviations[1].Phrase:='Закрытое акционерное общество';
  DBDAbbreviations[2].Abbreviation:='ИП'; DBDAbbreviations[2].Phrase:='Индивидуальный предприниматель';
end;

initialization

  InitAbbreviations;
{$IFDEF ISDELPHIXE2}
  DBDFormatSettings:= TFormatSettings.Create();
{$ELSE}
  GetLocaleFormatSettings(0,DBDFormatSettings);
{$ENDIF}
  DBDFormatSettings.DecimalSeparator:='.';

end.