{ функции форматирования кодов БК.
  вынесены в отдельный модуль, поскольку такие же фукнции могут быть
  в других скриптах.

  exchange #2591 - переход на символьные КБК}

const
  { константы для форматирования кодов БК по маске в функции FormatKbk.
     kbkMaskDefault - только получения кода по длине (с добавлением нулей слева)
                        ( по умолчанию);
     kbkMaskOfChar - форматирование кода по маске.
                      перед этим выполняется удлинение кода с добавлением 0-х
                      символов (как с kbkMaskDefault), а затем выполняется
                      форматирование.
    }
  kbkMaskDefault = 0;
  kbkMaskOfChar = 1;

  // нулевой код БК
  // считаем что самый длинный нулевой код не будет длинее 70 символов.
  // тогда дополнение када до нужной длины будем выполнять копированием
  // подстроки из этой константы.
  // код длиннее этой строки дополняется посимвольно.
  cnKBK_Null_Str =
       '000000000000000000000000000000000000000000000000000000000000000000000';


{ поскольку операции получения длины и маски формата длительные,
  для ускорения используются кеши.
    чтобы ускорить работу кешей решено использовать три списка строк, которые
    ведуться синхронно.
    vCachQueryKBKFormat_Name - список строк: budgetID+название_кода
    vCachQueryKBKFormat_Null - список строк нулевых кодов.
                                длина строки такого кода есть длина кода.
                                это дает то, что по сути длина не нужна.
                                нужно лишь дополнить указанный код до нужной
                                длины, добавляя нулевые символы.
                                поэтому, имея уже заранее строку с 0-м кодом,
                                можно добавлять не по одному символу, а сразу
                                подстрокой.
                                а при указания кода = "0" подставить результат
                                сразу.
    vCachQueryKBKFormat_Mask - список строк масок.

    кэш из разных списков ускоряет операцию - не надо парсить строку,
  если бы все было замешано в одной строке, а так же ускоряет операцию
  поиска, если бы это был var array, поскольку поиск выполняется не
  скриптовыми средствами.

  при инициализации создаются объекты списков, но не заполняются.
  по ходу вызова функции FormatKbk эти списки заполняються.}
var
  vCachQueryKBKFormat_Name: TStringList;
  vCachQueryKBKFormat_Null: TStringList;
  vCachQueryKBKFormat_Mask: TStringList;


{~InitializeQueryKBKFormat
  инициализация кеша для получения форматированных КБК.}
procedure InitializeQueryKBKFormat;
begin

    try
      if (vCachQueryKBKFormat_Name = NIL) then begin
        vCachQueryKBKFormat_Name    := TStringList.Create;
        vCachQueryKBKFormat_Null    := TStringList.Create;
        vCachQueryKBKFormat_Mask    := TStringList.Create;
      end;
      except
        ExceptionLog( 'Сбой QueryKbkFormat.InitializeQueryKBKFormat;');
    end;

end;


{~FinalizeQueryKBKFormat
  освобождение памяти из под кеша форматированных КБК.}
procedure FinalizeQueryKBKFormat;
begin

    try
      if (vCachQueryKBKFormat_Name <> NIL) then begin
        vCachQueryKBKFormat_Name.Free;
        vCachQueryKBKFormat_Null.Free;
        vCachQueryKBKFormat_Mask.Free;

        vCachQueryKBKFormat_Name    := NIL;
        vCachQueryKBKFormat_Null    := NIL;
        vCachQueryKBKFormat_Mask    := NIL;
      end;
      except
        ExceptionLog( 'Сбой QueryKbkFormat.FinalizeQueryKBKFormat;');
    end;

end;



{~QueryKbkFormat
  получение форматированного кода aCode с наименованием в таблице
  шаблонов: aCodeName для бюджета aBudget_Id.

  подобная функция есть в проекте AzkExchange
  в модуле: ExtLib\Form_KBK.pas.

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

  параметры:
    aFormatType - =0 - указывает что код нужно форматировать по длине
                      (добавление нулей слева).
                      длина кода берется из маски.
                  =1 - указывает что код нужно форматиовать по маске.

  aCodeName - название кода: поле NAME в таблице CODETYPE
      GRANTINVESTMENT - коды субсидий
      INDUSTRYCODE - отр.коды
      FUNDSOURCE - Код источника образования средств}
function FormatKbk( aCodeName, aCode, aBudget_Id: String;
                    const aFormatType: Integer = 0): String;
var
  xCodeMask: string;
  xCodeLength: integer;
  xCodeNull: string;
  xCachCodeName: string;
  xCachCodeIndex: integer;
begin

    try
      // пробуем найти код маски в кеше
      xCachCodeName := aBudget_Id + '_' + aCodeName;

      xCachCodeIndex:= vCachQueryKBKFormat_Name.IndexOf( xCachCodeName);
      if (xCachCodeIndex <> -1) then begin
        // в кеше уже есть описание кода, поэтому получаем длину и маску из кеша

        xCodeNull     := vCachQueryKBKFormat_Null[ xCachCodeIndex];
        xCodeMask     := vCachQueryKBKFormat_Mask[ xCachCodeIndex];
        xCodeLength   := LENGTH( xCodeNull);
      end else begin
        // код не найден в кеше.
        // тогда получаем длину, маску из БД

        GetFormatKbkLengthAndMask( aCodeName,
                                   aBudget_Id,
                                   xCodeLength,
                                   xCodeMask,
                                   xCodeNull);

        // сохраняем нулевой код, длину и маску в кеше.
        // для этого синхронно сохраняем строки в разных списках.
        // здесь важно отключить все опции у stringlist: сохранять и пустые
        // и одинаковые строки и отключить сортировки.
        vCachQueryKBKFormat_Name.Add( xCachCodeName);
        vCachQueryKBKFormat_Null.Add( xCodeNull);
        vCachQueryKBKFormat_Mask.Add( xCodeMask);
      end;


      // если код указан нулевым, т.е. требуется вернуть форматированный
      // нулевой код, тогда возвращаем нулевой код.
      if ( aCode = '0')
        then Result := xCodeNull
        else begin
          // разница длины строки входного кода и длины кода дает
          // количество нулевых символов для форматирования кода по длине
          // относительно нулевого кода.
          xCodeLength := xCodeLength - LENGTH( aCode);
          if ( xCodeLength <= 0)
            then Result := aCode
            else Result := COPY( xCodeNull, 1, xCodeLength) + aCode;
        end;


      // если требуется вернуть форматированный код, то форматируем код по
      // маске кода из кеша.
      if (aFormatType = kbkMaskOfChar)
        then Result := FormatMaskText( xCodeMask, Result);
      except
        ExceptionLog( 'Сбой QueryKbkFormat.FormatKbk');
    end;

end;


{~GetFormatKbkLengthAndMask
  получение длины, маски и нулевого кода для указанного кода КБК aCodeName.
  результат:
    aCodeLength - длина кода
    aMask - полная маска для функции FormatMaskText
    aNullCode - нулевой код (без форматирования по маске).}
procedure GetFormatKbkLengthAndMask( aCodeName, aBudget_Id: String;
                                     var aCodeLength: integer;
                                     var aMask: string;
                                     var aNullCode: string);
var
  i: integer;
  xCodeName: string;
  xCodeLengthStr: string;
  xXmlAplabet: Variant;
  xMaskAplabet: string;
begin

    try
      // exchange #3062 - поправка
      // необходимо приводить регистр к одному виду, иначе могут быть проблемы
      // при поиске в бд
      xCodeName := UPPERCASE( aCodeName);

      // нулевой код пока не определен но здесь ВАЖНО инициализировать строку.
      aNullCode := '';

      // загружаем длину и маску из бд
      aMask := QueryField( 'Select Tree_Mask From CodeType Where upper(Name) = ? '
                          +'and Budget_Id = ?',
                          [ xCodeName,
                            aBudget_Id],
                          'TREE_MASK');
      // длина кода из поля в таблице масок
      xCodeLengthStr := QueryField( 'Select TREE_MASK_LENGTH From CodeType '
                                   +'Where upper(Name) = ? and Budget_Id = ?',
                                    [ xCodeName,
                                      aBudget_Id],
                                    'TREE_MASK_LENGTH');
      // если длина прописана явно - берем ее.
      // если нет - будем вычислять по маске.
      if (LENGTH( TRIM( xCodeLengthStr)) <= 0)
        then aCodeLength := 0
        else aCodeLength := STRTOINT( xCodeLengthStr);



      { здесь загружаем все названия строк символов в масках кодов БК.
        фактически это является алфовитом масок.
        это нужно чтобы понять, какие символы в строке масок являются
        шаблонами для символов, а какие разделителями.
        символы в маске, которые отсутствуют в загруженном алфавите
        являются разделителями.
        например:
          алфавит в БД: Aж
          маска: AA.ж
        символ "." не входит в алфавит и является разделителем,
        поэтому длина кода по маске =3, а не 4!}
      xXmlAplabet := QueryXml( 'select bm.name from budgetmask bm where bm.budget_id=?',
                                [ aBudget_Id]);
      xXmlAplabet := xXmlAplabet.documentElement;
      for i := 0 to xXmlAplabet.ChildNodes.length - 1
        do xMaskAplabet := xMaskAplabet
                            + xXmlAplabet.ChildNodes.item[ i].GetAttribute( 'NAME');


      if (aCodeLength <= 0) then begin
        // если длина явно не указана в БД - расчитываем по маске.
        // для этого в начале определяем длину символьной маски, а затем
        // исключаем символы, которых нет в алфавите масок
        aCodeLength := LENGTH( aMask);
        // проверяем символы строки маски на вхождение в алфавит
        // те символы которые не входят в алфавит - исключаем из длины.

        for i := 1 to LENGTH( aMask) do
          if (POS( aMask[i], xMaskAplabet) <= 0)
            then DEC( aCodeLength);
      end;

      if ( aCodeLength <= 0) then begin
        WriteInfo( FORMAT( 'Ошибка определения длины кода %s бюджета %s.',
                            [ xCodeName,
                              aBudget_Id]));
        EXIT;
      end;

      // получение нулевого кода, отформатированного по длине.
      // в реализации с кешем, сохраняется именно такой код, а не длина.
      // длину можно определить по длине строки нулевого кода.
      if ( aCodeLength < LENGTH( cnKBK_Null_Str))
        then aNullCode := COPY( cnKBK_Null_Str, 1, aCodeLength)
        else
          while (LENGTH( aNullCode) < aCodeLength)
            do aNullCode := aNullCode + '0';

      // если нужно отобразить код по маске, получаем набор символов маски,
      // и те символы, которые описывают наборы символов маски заменяем на
      // символ A, а прочие - оставляем как есть.
      // тем самым будет получена маска для функции FormatMaskText.
      // поскольку в эксче точку не закладываем как разделитель, то
      // те символы которые описаны как подмножества, определяются как маска
      // под символ кода, а прочие - фиксированные символы.
      // в начале получаем все символы для маски, маскирующие символы кода
      // в строку xMaskAplabet.
      for i := 1 to LENGTH( aMask) do
        if (POS( aMask[i], xMaskAplabet) > 0)
          then aMask[i] := 'A';
      // формируем маску для функции FormatMaskText
      // эта же строка пойдет в кэш для маски.
      aMask := aMask + ';0;*';
      except
        ExceptionLog( 'Сбой QueryKbkFormat.GetFormatKbkLengthAndMask');
    end;

end;



{~QueryKbkFormatByMaska
  получение форматированного кода aCode с наименованием в таблице
  шаблонов: aCodeName для бюджета aBudget_Id.}
function QueryKbkFormatByMaska( aCodeName, aCode, aBudget_Id: String): string;
begin

    try
      Result := FormatKbk( aCodeName, aCode, aBudget_Id, kbkMaskOfChar);

      except
        ExceptionLog( 'Сбой QueryKbkFormat.QueryKbkFormatByMaska');
    end;

end;



{~GetLengthCode
  Возвращает длину кода aCodeName по маске из таблицы шаблонов.
  exchange #2591
    при переходе на символьные КБК шаблон указывается по другому.

    при переходе на символьные КБК, длина кода по маске берется из другого
    поля: TREE_MASK_LENGTH, а не из Tree_Mask (АЦК-Ф ниже v2.31)
    чтобы не городить огород, выполняем расчет нулевого кода, и длина
    строки этого кода и будет результатом.}
function GetLengthCode( aCodeName, aBudget_Id: String): Integer;
begin

    try
      Result := LENGTH( FormatKbk( aCodeName, '0', aBudget_Id));
      except
        ExceptionLog( 'Сбой QueryKbkFormat.GetLengthCode');
    end;

end;

{------------------------------------------------------------------------------}
{ exchange #3062
  удаляется косгу для всех эд кроме эд ау/бу.
  здесь добавлены функции, для которых это влияет.
  маски в ацк-ф общие для всех, но для ау/бу некоторые коды должны укоротится,
  а для прочих эд коды должны остаться как есть.
  в результате:
    если aCheckKES = false, то:
      код косгу всегда будет пустым, а прочие коды остануться как в ацк-ф
      с учетом маски.
    если aCheckKES = true, то:
      код косгу останется как есть, а кцср, кви и квд будут сокращены на
      длину кода косгу (3 символа), если они превышают длину относительно
      старых длин кодов (до доработки отмены косгу).
{------------------------------------------------------------------------------}
function CheckLengthCodeKES( aCode: string; aCheckKES: boolean): string;
begin

    try
      if aCheckKES
        then Result := aCode
        else Result := '';
      except
        ExceptionProc( 'CheckLengthCodeKES');
    end;

end;

function CheckLengthCodeKI( aCode: string; aCheckKES: boolean): string;
begin

    try
      Result := aCode;
      // если косгу учитывается, то код урезается на 3 символа, если он
      // длиннее чем 14 символов
      if aCheckKES then
        if (LENGTH( Result) > 14)
          then Result := COPY( Result, 1, 14);
      except
        ExceptionProc( 'CheckLengthCodeKI');
    end;

end;

function CheckLengthCodeKD( aCode: string; aCheckKES: boolean): string;
begin

    try
      Result := aCode;
      // если косгу учитывается, то код урезается на 3 символа, если он
      // длиннее чем 14 символов
      if aCheckKES then
        if (LENGTH( Result) > 14)
          then Result := COPY( Result, 1, 14);
      except
        ExceptionProc( 'CheckLengthCodeKD');
    end;

end;

function CheckLengthCodeKCSR( aCode: string; aCheckKES: boolean): string;
begin

    try
      Result := aCode;
      // если косгу учитывается, то код урезается на 3 символа, если он
      // длиннее чем 7 символов
      if aCheckKES then
        if (LENGTH( Result) > 7)
          then Result := COPY( Result, 1, 7);
      except
        ExceptionProc( 'CheckLengthCodeKCSR');
    end;

end;



begin
end.
