// Модуль описания функций, использующихся только для экспорта
// exchange #3062
// часть кода вынесена в модуль Un_ExportKBK, поскольку используется при
// импорте с целью унификации кода.
uses
  'Un_ExportKBK';

const
  // параметры в ini файле (send.dat)
  cnExportIniLastData            = 'дата_последней_выгрузки';
  cnExportIniPackedNumber        = 'номер_пакета';
var
  // exchange #2968
  vCfg_Zip: boolean;

{~GetFileName
  Функция формирования имени файла: XXXXXDNN.TTM
    где:
      XXXXX - Org_Code
      D - день по модулю 32
      NN - номер пакета по модулю 36
      TT - маркер формата (ZR,ZS,...)
      M - день месяца по модулю 26.
          если CodeIsFk=false, день месяца 0...12,
          если CodeIsFk=true, день месяца 13...25,

  Org_Code - Код организации из первого документа в выгрузке.
  Marker - маркер документов, см. табл.2 раздел 3, описания формата.
  Exch_Date - дата выгрузки документов.
  Exch_Packet - номер выгрузки за дату Exch_Date.
  LocalNet д.б. True - если ф-л, формир-ся в выделенной локальной вычислительной сети.
  CodeIsFk д.б. True - если код организации Org_Code присвоен ФК.}
function GetFileName(Org_Code, Marker: String; Exch_Date: TDateTime;
  Exch_Packet: Integer; LocalNet, CodeIsFk: Boolean): String;
var
  d, m, y: Word;
  xXml: Variant;
  xXmlDoc: Variant;
  xExch_Packed_Num: string;
begin

    try
      //XXXXXDNN.TTM

//    if LocalNet then Exch_Packet := Exch_Packet + OffsetNumFileName;
      if LocalNet
        then xExch_Packed_Num := IntToSS(Exch_Packet + OffsetNumFileName, 36, 2)
        else xExch_Packed_Num := IntToSS(Exch_Packet, 36, 2);

      DecodeDate(Exch_Date, y, m, d);

      { exchange #2686
        теперь получаем номер не как номер пакета, а из процессора АЦК-Ф.

        формируем задание:
        <EXCHNUMBERINFO action="getData" FORMAT="ZR" ORG_CODE="00541"/>
        ответ:
        <EXCHNUMBERINFO NUMBER="NN"/>
        обязательно строка из 2х символов.
        }
      xXml := CreateOleObject( 'Microsoft.XmlDom');
      xXmlDoc := xXml.appendChild( xXml.createElement( 'EXCHNUMBERINFO'));
      xXmlDoc.setAttribute( 'action', 'getData');
      xXmlDoc.setAttribute( 'FORMAT', Marker);
      xXmlDoc.setAttribute( 'ORG_CODE', Org_Code);

      xXml.LoadXml( ExecXml( xXmlDoc.xml));

      xXmlDoc := xXml.documentElement;

      try
        xExch_Packed_Num := VarToStr( xXmlDoc.getAttribute( 'NUMBER'));
        if (LENGTH( xExch_Packed_Num) <> 2)
          then raise( 'Сбой');
        except
          raise( 'Сбой получения ответа от процессора EXCHNUMBERINFO:'
                  + xXmlDoc.xml);
      end;


      // константа OffsetMonthFileName определена в модуле Un_Const: =12.
      if CodeIsFk then m := m + OffsetMonthFileName;
      Result := Org_Code
                 + IntToSS(d, 32, 1)
                 + xExch_Packed_Num
                 + '.'
                 + Marker
                 + IntToSS(m, 26, 1);

      except
        ExceptionLog( 'Сбой GetFileName');
    end;

end;


{~GetExchDateFromSourceXml
  возвращает строку даты выгрузки из XML входного задания aSourceXml.
  для получения даты, нужно выполнить:
      XmlToDateTime( GetExchDateFromSourceXml( xml));
  ~результат~
    строка атрибута EXCH_DATE. }
function GetExchDateFromSourceXml( var aSourceXml: Variant): string;
begin

    try
      Result := aSourceXml.getAttribute('EXCH_DATE');

      except
        ExceptionLog( 'Сбой Un_Export.GetExchDateFromSourceXml');
    end;

end;



{~GetFileNameEx
  формирование имени файла экспорта.
  aOrg_Code - Код организации из первого документа в выгрузке.
  aMarker - маркер документов, см. табл.2 раздел 3, описания формата.
  aSourceXml - узел корневого элемента входного задания XML;
  aPackedNumber - номер пакета. добавляется к номеру пакета из атрибута
                  aSourceXml.EXCH_PACKET. это дает то, что можно формировать
                  имена файлов, с учетом исходного пакета из входного задания
                  для одинаковых организаций. т.е. если существует несколько ЭД
                  с разными адресными данными но одной организацией, то можно
                  сформировать несколько разных файлов, при этом код организации
                  будет один, но за счет увеличения номера пакета, имена файлов
                  будут разными.
  aPacketNumberAsOfs - (вх,необяз)Ж
              если =TRUE (по умолчанию), то параметр aPackedNumber будет
                     смещением относительно номера задания по исходному XML.
              если =FALSE - то aPackedNumber будет номером пакета, который явно
                            подставляется в имя файла.
  ~результат~
    строка имени файла (с расширением) но без пути.}
function GetFileNameEx( aOrg_Code: String;
                        aMarker: String;
                        var aSourceXml: Variant;
                        aPackedNumber: integer = 0;
                        aPacketNumberAsOfs: boolean = TRUE): String;
begin

    try

      if aPacketNumberAsOfs
        then Result := GetFileName( aOrg_Code,
                                     aMarker,
                                     XmlToDateTime( GetExchDateFromSourceXml( aSourceXml)),
                                     aSourceXml.getAttribute('EXCH_PACKET') + aPackedNumber,
                                     FileOutIsLocalNet,
                                     FileOutOrgCodeIsFk)
        else Result := GetFileName( aOrg_Code,
                                     aMarker,
                                     XmlToDateTime( GetExchDateFromSourceXml( aSourceXml)),
                                     aPackedNumber,
                                     FileOutIsLocalNet,
                                     FileOutOrgCodeIsFk);
      except
        ExceptionLog( 'Сбой Un_Export.GetFileNameEx');
    end;

end;

//Функция устанавливает соответсвие поля вида платежа м/у АЦК и форматом FK
function PayKindSetAsFk(PayKind: String): String;
begin
  case PayKind of
    '1': Result := '3'; //электронно
    '2': Result := '1'; //почтой
    '3': Result := '2'; //телеграфом
    '4': Result := '4'; // срочно
  else
    Result := '0';
  end
end;


function GetTypeKBK(Line: Variant; BudgetId: String; aPrefix: String = ''): String;
var
  xClassDoc: string;
begin

    try
    case VarToStr( Line.getAttribute(aPrefix + 'ANAL_KIND')) of
      '0': Result := '10';  //расходы
      '1': Result := '20';   //доходы
      '2': begin    //источники

             if Copy(KiCodeFormat(Line.getAttribute(aPrefix + 'KI_CODE'), BudgetId), 1, 2) = '01'
               then Result := '31'
               else Result := '32';
           end;
      '3': Result := '40';       // АУ/БУ.
    else begin
            // пробуем найти класс документа

            xClassDoc := VarToStr( Line.getAttribute('DOCUMENTCLASS_ID'));

            case xClassDoc of
              '195': Result := '40';   //

              else Result := '';
              {
              raise( FORMAT( 'Не определен тип КБК для класса "%s" (атрибут DOCUMENTCLASS_ID).',
                                   [ xClassDoc]));
                                   }
            end;//case//
          end;
    end;//case//
      except
        ExceptionProc( 'GetTypeKBK');
    end;

end;

function GetTypeKbkByKes(Code, BudgetId: String): Integer;
var
  KesAnal_Kind: String;
begin
  KesAnal_Kind := QueryField('Select Anal_Kind From Kes Where Budget_Id = ?' +
    ' and Code = ?', [BudgetId, Code], 'ANAL_KIND');
  case KesAnal_Kind of
    '0': Result := 20;
    '1': Result := 20;
    '2': Result := 10;
    '3': Result := 31
  else
    Result := 10;
  end;
end;

//Возвращает тип КБК идентификатора платежа согласно формату.
function GetTypeKBKIdentificator(Line: Variant): String;
begin
  case Line.getAttribute('PI_ANAL_KIND') of
    //расходы
    2: Result := '10';
    //доходы
    1: Result := '20';
    //источники
    3: Result := '31';
  end;
end;

//Возвращает киф по след правилу: Если Киф = 2, то возвращаем 2,
//Если Киф = 0, то возвращаем 0.
//в остальных случаях возвращаем 1
function GetRuleKif(Line: Variant; prefix: String = ''): String;
begin
  Result := '1';
  if (Line.getAttribute(prefix + 'ANAL_KIND') = 0)
    and (Line.getAttribute(prefix + 'FSR_ID') = 2) then Result := '2';
  if (Line.getAttribute(prefix + 'ANAL_KIND') = 1)
    and (Line.getAttribute(prefix + 'FSD_ID') = 2) then Result := '2';
  if (Line.getAttribute(prefix + 'ANAL_KIND') = 2)
    and (Line.getAttribute(prefix + 'FSI_ID') = 2) then Result := '2';
  if (Line.getAttribute(prefix + 'ANAL_KIND') = 0)
    and (Line.getAttribute(prefix + 'FSR_ID') = 0) then Result := '0';
  if (Line.getAttribute(prefix + 'ANAL_KIND') = 1)
    and (Line.getAttribute(prefix + 'FSD_ID') = 0) then Result := '0';
  if (Line.getAttribute(prefix + 'ANAL_KIND') = 2)
    and (Line.getAttribute(prefix + 'FSI_ID') = 0) then Result := '0';
end;

function GetName_PP(Kod_Doc: String): String;
begin
  case Kod_Doc of
    'PP': Result := 'Платежное поручение';
    'ZR': Result := 'Заявка на кассовый расход';
    'ZS': Result := 'Заявка на получение наличных денег';
    'UF': Result := 'Уведомление об уточнении вида и принадлежности платежа';
//    'SF': Result := 'Справка органа Федерального казначейства';
    else
      Result := '';
  end;
end;

//Возвращает код спец указаний.
function GetNoteCode(Note_Code: String): String;
var
  i: Integer;
begin
  Result := '';
  if Note_Code <> '' then
    Result := '0' + StringReplace(Note_Code, ',', ',0');
end;
{==============================================================================}

procedure SetExchangeStatus( aBudgetID, aID, aClassID, aDocument, aStatus: string);
begin

    try
      WriteLog('Изменение внешнего статуса выгрузки ЭД...', FALSE);
      try

        ExecProc( 'DOCUMENT',
                  [ 'action', 'update_extstatus',
                    'class', aClassID,
                    'ID', aID,
                    'EXTSTATUS_ID', aStatus],
                  aBudgetID);

        except
          WriteInfo( FORMAT( 'Сбой изменения статуса выгрузки ЭД "%s".', [ aDocument]));
          ExceptionLog( 'Сбой выполнения изменение статуса ЭД.');
      end;
      except
        ExceptionLog( 'Сбой Un_Export.SetExchangeStatus');
    end;

end;
{==============================================================================}

procedure SetExchangeStatusDocument( aBudgetID: string;
                                     aDocXml: Variant;
                                     aStatus: string);
var
  xClass: string;
begin

    try

      if VarIsNull( aDocXml) then EXIT;
      xClass := aDocXml.getAttribute('DOCUMENTCLASS_ID');
      SetExchangeStatus( aBudgetID,
                         aDocXml.getAttribute('ID'),
                         xClass,
                         GetDocumentNameByClass( xClass),
                         aStatus);
      except
        ExceptionLog( 'Сбой Un_Export.SetExchangeStatusDocument');
    end;

end;
{==============================================================================}

procedure SetExchangeStatusDocuments( aBudgetID: string;
                                      aDocXml: Variant;
                                      aStatus: string;
                                      aDocsGroups: Variant);
var
  xCount, i: integer;
begin

    try
      if VarIsNull( aDocXml) then EXIT;
      xCount := aDocXml.childNodes.Length;
      if (xCount <= 0) then EXIT;
      // определяем бюджет по любому документу.
      // считается что все документы описываются одним бюджетом.

      if (LENGTH( TRIM( aBudgetID)) <= 0)
        then aBudgetID := aDocXml.childNodes.Items[0].getAttribute('BUDGET_ID');

      WriteLog( 'Изменение статусов выгрузки ЭД...', TRUE);
      SetProgress( 0, xCount);

      // проверяем параметр aDocsGroups на NULL.
      // в зависимости от этого выполняем обработку в другом цикле.
      // это дает выигрыш в проверке значения на каждую итерацию!
      if VarIsNull( aDocsGroups) then begin
        for i := 0 to xCount - 1 do begin
          ShowProgress( i);
          SetExchangeStatusDocument( aBudgetID,
                                     aDocXml.childNodes.Items[ i],
                                     aStatus);
        end;//for//
      end else begin
        for i := 0 to xCount - 1 do begin
          ShowProgress( i);
          if (aDocsGroups[i] <> -1)
            then SetExchangeStatusDocument( aBudgetID,
                                            aDocXml.childNodes.Items[ i],
                                            aStatus);

        end;//for//
      end;
      except
        ExceptionLog( 'Сбой Un_Export.SetExchangeStatusDocuments');
    end;

end;


procedure Export_FinalizeGroups( var aDocsGroups: Variant;
                                 var aGroups: TStringList);
begin

    try
      // чистим и разрушаем массив индексов групп
      if NOT VarIsNull( aDocsGroups) then begin
        SetLength( aDocsGroups, 0);
        aDocsGroups := NULL;
      end;
      // разрушаем список групп
      if ASSIGNED( aGroups) then begin
        aGroups.Free;
        aGroups := NIL;
      end;
      except
        ExceptionLog( 'Сбой Un_Export.Export_FinalizeGroups');
    end;

end;

function Export_InitializeGroups( var aSourceXml: Variant;
                                  var aDocsGroups: Variant;
                                  var aGroups: TStringList): boolean;
var
  i, xCount, xInt: integer;
begin

    try
      Result      := FALSE;
      aDocsGroups := NULL;
      aGroups     := NIL;
      // создаем массив, соответствующий числу экспортируемых документов,
      // в который будем заносить индекс группы документов из списка строк
      // групп aGroups.
      // первоначально список строковых групп пустой, поэтому после создания
      // массива заносим во все элементы значение -1.
      xCount := aSourceXml.childNodes.Length;
      if (xCount <= 0) then begin
        WriteInfo( 'Не указано ни одного документа для выгрузки.');
        EXIT;
      end;

      // формируем массив на 1 элемент больше. это связано со спецификой
      // указания размерности массива.
      aDocsGroups := VarArrayCreate([0, xCount + 1], varVariant);

      xInt := -1;
      for i := 0 to xCount - 1 do aDocsGroups[i] := xInt;

      aGroups := TStringList.Create;

      Result  := TRUE;
      except
        ExceptionLog( 'Сбой Un_Export.Export_InitializeGroups');
    end;

end;



function Export_DocumentGroup( aDocIndex: integer;
                               var aDocsGroups: Variant;
                               var aGroups: TStringList;
//                               var aSourceXml: Variant;
                               aDocInfo: string;
                               aResultCode: integer;
                               aDocTypeHash: integer;
                               aFromBudgLevel: string;
                               aFromKodUbp: string;
                               aFromNameUbp: string;
                               aToKodTofk: string;
                               aToNameTofk: string;
                               aOrgCode: string): boolean;
var
  s: string;
  xIndex: integer;
  xDocHash: integer;
begin

    try
      Result := FALSE;

      // если документ не удается однозначно описать - игнорируем такой
      // документ.
      if (aResultCode <> 0) then begin
        WriteInfo( 'Невозможен экспорт ЭД' + aDocInfo);
        EXIT;
      end;
      // описываем строку группы документа
      // порядок полей строго такой, какой указан. обратный разбор выполняется
      // в подпрограмме Export_StartGroup.
      s :=           aOrgCode
           +#13#10 + aFromBudgLevel
           +#13#10 + aFromKodUbp
           +#13#10 + aFromNameUbp
           +#13#10 + aToKodTofk
           +#13#10 + aToNameTofk;

      // пробуем найти группу в списке групп
      xIndex := aGroups.IndexOf( s);

      // если такой группы нет - создаем новую и определяем индекс новой
      // группы в списке
      if (xIndex = -1) then begin
        xIndex := aGroups.Count;
        aGroups.Add( s);
      end;
      // сохраняем в массиве индекс группы (в младших шести разрядах)
      // и тип документа (в старших разрядах)
      // предполагается что число разных групп (конечных описателей адреса)
      // всех экспортируемых документов мало: (маска $FFFFFF)
      xDocHash := aDocTypeHash + (xIndex AND 16777215);

      aDocsGroups[ aDocIndex] := xDocHash;
      Result := TRUE;
      except
        ExceptionLog( 'Сбой Un_Export.Export_DocumentGroup');
    end;

end;


{~DoExportPrepareDocs
  инициализация параметров документов.
  в результате возвращается первый ЭД из списка ЭД aSourceXml.
  помимо этого для этого документа возвращается: бюджет (aBudgetID) и
  класс (aClassID).
  НЕ ДОКУСКАЕТСЯ ПЕРЕДАВАТЬ ПУСТОЙ НАБОР ВЫГРУЖАЕМЫХ ЭД!
  прочие параметры инициализируются пустыми строками.
  параметры:
    aSourceXml (вх.обяз) - входной XML задания (как есть);
    aBudgetID (вых.строка) - возвращается ид.бюджета первого ЭД;
    aFromBudgLevel (вых,строка) - возвращается пустая строка;
    aFromKodUbp (вых,строка) - возвращается пустая строка;
    aFromNameUbp (вых,строка) - возвращается пустая строка;
    aToKodTofk (вых,строка) - возвращается пустая строка;
    aToNameTofk (вых,строка) - возвращается пустая строка;
    aOrgCode (вых,строка) - возвращается пустая строка;
    aClassID (вых,строка) - возвращается класс первого ЭД.}
function DoExportPrepareDocs( var aSourceXml: Variant;
                           var aBudgetID: string;
                           var aFromBudgLevel: string;
                           var aFromKodUbp: string;
                           var aFromNameUbp: string;
                           var aToKodTofk: string;
                           var aToNameTofk: string;
                           var aOrgCode: string;
                           var aClassID: string): Variant;
begin

    try
      Result := aSourceXml.documentElement.childNodes.Items[ 0];

      // определяем бюджет и класс по первому входящему для экспорта документу.
      // считается что все экспортируемые документы описываются одним бюджетом
      // или специально собраны все в одной куче сознательно.
      aBudgetID := Result.getAttribute('BUDGET_ID');
      aClassID  := Result.getAttribute('DOCUMENTCLASS_ID');

      // чистим параметры разделов FROM/TO
      aFromBudgLevel  := '';
      aFromKodUbp     := '';
      aFromNameUbp    := '';
      aToKodTofk      := '';
      aToNameTofk     := '';
      aOrgCode        := '';
      except
        ExceptionLog( 'Сбой Un_Export.DoExportPrepareDocs');
    end;

end;

{~Export_GetDocumentTypeAndGroup
  ращепляет описатель документа aDocHash на составляющие: тип документа
  aDocType и группу документа aDocGroup.
  результат
    =TRUE - документ допускается экспортировать. при этом результат в параметрах
            aDocType и aDocGroup имеют действительные значения.
    =FALSE - документ не выгружается. при этом значения в aDocType и
            aDocGroup не инициализированы и им доверия нет.}
function Export_GetDocumentTypeAndGroup( aDocHash: integer;
                                           var aDocType: integer;
                                           var aDocGroup: integer): boolean;
begin

    try
      if (aDocHash < 0)
        then Result := FALSE
        else begin
          Result := TRUE;
          // флаг $1000000 определяет тип документа 11 или 75 по новой схеме
          // выгрузки. прочие типы - по старой схеме.
          if ((aDocHash AND 16777216) <> 0)
            then aDocType := 1
            else aDocType := 0;
          // индекс элемента в младших разрядах (маска $0FFFFFF)
          aDocGroup := (aDocHash AND 16777215);

        end;
      except
        ExceptionLog( 'Сбой Un_Export.Export_GetDocumentTypeAndGroup');
    end;

end;


{~Export_StartGroup
  описание группы с индексом aGroupIndex.
  параметры
    aGroupIndex - (вх,обяз) индекс группы, которую требуется описать;
    aGroups - (вх,обяз) список групп;
    aSourceXml -(вх,обяз) узел корневого элемента входного задания XML;
    aSchema - (вх.обяз) схема, по которой экспортируются ЭД;
    aDocID - (вх,обяз) идентификатор документа (например 'ZR','ZV','RN' и др)
    aFileName - (вых,обяз) файл схемы для этой группы;
    aNewDocument - (вых,обяз) новый XML документ с разделами FROM и TO.
                    возвращается ссылка на объект XML документа, а не корневой
                    раздел!
    aPackedNumber - номер пакета. инкрементируется каждый раз при выполнении
                этой операции.это нужно для формирования уникального имени
                файла}
procedure Export_StartGroup( aGroupIndex: integer;
                               var aGroups: TStringList;
                               var aSourceXML: Variant;
                               var aSchema: Variant;
                               aDocID: string;
                               var aFileName: string;
                               var aNewDocument: Variant;
                               var aPackedNumber: integer);
var
  SL: TStringList;
  xDocXml: Variant;
  xDataOutXmlSection: Variant;
begin

    try
      SL:= TStringList.Create;
      try
        SL.Text := aGroups.Strings[ aGroupIndex];

        { имя файла уникально для каждой организации по номеру пакета.
          при формировании имени файла, чтобы указать номер пакета
          явно, прибавляем к числу номера пакета тысячу.}
        INC( aPackedNumber);
        aFileName := GetFileNameEx( SL.Strings[0],
                                      aDocID,
                                      aSourceXml,
                                      aPackedNumber,
                                      TRUE);

        // формируем документ XML для выгрузки

        aNewDocument := CreateXmlForExport( xDocXml, aSchema);
        // создаем разделы FROM и TO в экспортируемых данных и
        // заполняем их данными из строки описания группы
        // FROM

        xDataOutXmlSection :=
                    xDocXml.AppendChild(
                          FillElementBySchemaEx( aSchema, 'FROM', NULL));
        xDataOutXmlSection.setAttribute( 'BUDG_LEVEL', SL.Strings[1]);
        xDataOutXmlSection.setAttribute( 'KOD_UBP', SL.Strings[2]);
        xDataOutXmlSection.setAttribute( 'NAME_UBP', SL.Strings[3]);
        // TO

        xDataOutXmlSection := xDocXml.AppendChild(FillElementBySchemaEx( aSchema, 'TO', NULL));
        xDataOutXmlSection.setAttribute( 'KOD_TOFK', SL.Strings[4]);
        xDataOutXmlSection.setAttribute( 'NAME_TOFK', SL.Strings[5]);
        finally
          SL.Free;
      end;
      except
        ExceptionLog( 'Сбой Un_Export.Export_StartGroup');
    end;

end;


{~Export_EndFiles
  копируем сформированные файлы в каталог результата.
  поскольку при выгрузке файла, внешняя система подхватывает файл по таймеру
  и затем удаляет этот файл из выодного каталога, то в начале выполняется
  архивация, затем копирование файлов в архив (если указано) и только потом
  копируется в рабочий каталог.
    Если в архив не удалось скопировать файлы, это не является критической
  ошибкой и экспорт продолжается.
  параметры
    aSourceXml - (вх,обяз) - указатель на объект входного задания (XML);
    aChangeExtStatusTo - (вх,обяз) - конечный статус сэкспортированных ЭД.
                          например: cnExtStatusID_UnLoaded.
                          константы определены в модуле Un_Const.
                          если указать пустую строку, статус документов
                          не будет изменен.
  результат:
    =true - операция выполнена полностью успешно.
    =false - выполнена ошибка при копировании файлов или архивации ЭД.}
function Export_EndFiles( var aSourceXml: Variant;
                           aFileNames: TStringList;
                           aDirTmp: string;
                           aDirOut: string;
                           aDirArh: string;
                           aChangeExtStatusTo: string;
                           aDocsGroups: Variant): boolean;
begin

    try
      Result := TRUE;

      if (aFileNames.Count > 0) then begin

        WriteLog('Перенос документов в архив', True);


        Move_To_ArhivEx( aSourceXml);

        // меняем статусы выгрузки экспортируемых ЭД на "Выгружен"
        // эту операцию нужно делать после выгрузки в архив, поскольку
        // если это делать до архивации, то при архивации будет сбой:
        // "документ удален или изменен".
        if ( LENGTH( aChangeExtStatusTo) > 0)
          then SetExchangeStatusDocuments( '',
                                           aSourceXml.documentElement,
                                           aChangeExtStatusTo,
                                           aDocsGroups);
//                                      cnExtStatusID_UnLoaded);


        if ( LENGTH( Trim( aDirArh)) > 0) then begin
          WriteLog('Копирование файла в каталог архива, согласно настройке...');
          if (CopyFiles( aFileNames, aDirTmp, aDirArh) <> aFileNames.Count)
            then WriteInfo( 'Не удалось полностью скопировать файлы в архив.');
        end;

        { переносим файлы в каталог результата, если операция
          изменения статусов выполнена успешно.}
//        WriteLog('Перенос документов в каталог результата...', True);
//        if (CopyFiles( aFileNames, aDirTmp, aDirOut) <> aFileNames.Count)
        // exchange #2968 - формируем конечный файл с учетом создания zip архива
        if (CopyExportResultFiles( aFileNames, aDirTmp, aDirOut) <> aFileNames.Count)
          then begin
            WriteInfo( 'Не удалось полностью скопировать файлы в выходной каталог. Выгрузка не выполнена.');
            Result := FALSE;
            EXIT;
          end;





        WriteLog( 'Экспорт выполнен.', TRUE);
      end;
      except
        ExceptionLog( 'Сбой Un_Export.Export_EndFiles');
    end;

end;



function Export_ValidateDocument( aFileValidate: string;
                                  var aDataXml: Variant;
                                  var aSchema: Variant;
                                  var aRegExp: Variant;
                                  aParamCtlValidOn: boolean;
                                  aParamStopAllUnloadDocNotValid: boolean;
                                  aDocInfo: string = ''): boolean;
begin

    try
      Result := FALSE;
      if NOT aParamCtlValidOn
        then WriteLog( 'Контроль документа не выполняется (по опции конфигурации).')
        else begin
          //валидация схем.
          Data          := aDataXml;
          Schema        := aSchema;
          RegExp        := aRegExp;
          FileValidate  := aFileValidate;
          if NOT ValidateFormat
  {
          if NOT ValidateFormatXml( aDataXml, aSchema, aRegExp, aFileValidate)
  }
            then begin
              // если общая выгрузка с ошибкой - копируем журнал валидации
              // в журнал info
              if (LENGTH( aDocInfo) > 0)
                then LogInfoFileValidate( aFileValidate,
                                          FORMAT( 'Ошибка валидации ЭД %s:',
                                                  [ aDocInfo]))
                else LogInfoFileValidate( aFileValidate, 'Ошибка валидации ЭД:');

              if aParamStopAllUnloadDocNotValid then
                if NOT ShowMessageValid(
                            aFileValidate,
                            'Не пройден контроль валидности отдельными документами',
                            mvDialogYN + mvNotepad,
                            'Не пройден контроль валидности отдельными документами.'
                            +#13#10'Продолжать выгрузку?')
                  then begin
                    WriteInfo('Выгрузка прервана пользователем');
                    Exit;
                  end;
            end;
        end;
      Result := TRUE;
      except
        ExceptionLog( 'Сбой Un_Export.Export_ValidateDocument');
    end;

end;


{~Export_End
  окончание экспорта ЭД aSourceXml в файл aFileName по схеме aSchema.
  тут выполняется проверка полученного документа aDataXml по схеме
  с учетом параметров проверки aParamCtlValidOn и aParamStopAllUnloadDocNotValid.
  если результат проверки успешный, файл переносится в архив.
  при необходимости (параметр aChangeExtStatusTo) меняется стутус выгруженных
  ЭД на указанный.
  параметры
  результат
    =TRUE - экспорт файла выполнен, файл перенесен в архив.
    =FALSE - экспорт не выполнен.}
function Export_End( var aSourceXml: Variant;
                     aFileName: string;
                     aFileValidate: string;
                     var aDataXml: Variant;
                     var aSchema: Variant;
                     var aRegExp: Variant;
                     aDirTmp: string;
                     aDirOut: string;
                     aDirArh: string;
                     aParamCtlValidOn: boolean;
                     aParamStopAllUnloadDocNotValid: boolean;
                     aChangeExtStatusTo: string;
                     aDocsGroups: Variant): boolean;
var
  xFileNames: TStringList;
begin

    try
      Result := FALSE;
      if NOT Export_ValidateDocument( aFileValidate,
                                       aDataXml,
                                       aSchema,
                                       aRegExp,
                                       aParamCtlValidOn,
                                       aParamStopAllUnloadDocNotValid)
        then EXIT;
      // сохраняем документ в файле
      SaveXmlToFormatTextFile( aDataXml, DirTmp + aFileName);
      // выгружаем ЭД в файл и завершаем экспорт.
      xFileNames:= TStringList.Create;
      try
        xFileNames.Add( aFileName);

        Export_EndFiles( aSourceXml,
                         xFileNames,
                         aDirTmp,
                         aDirOut,
                         aDirArh,
                         aChangeExtStatusTo,
                         aDocsGroups);
        finally
          xFileNames.Free;
      end;
      Result := TRUE;
      except
        ExceptionLog( 'Сбой Un_Export.Export_End');
    end;

end;


{~Export_GetFullFileNameSendDat
  возвращает полное имя файла параметров экспорта "Send.dat".
  функция проверяет последний символ "\" в строке параметра каталога.
  параметры
    aDirIni - корневой каталог скриптов, в котором находится файл Schems\Send.dat.}
function Export_GetFullFileNameSendDat( aDirIni: string): string;
begin

  try
    Result := ValidateDirectoryString( aDirIni) + 'Schems\Send.dat';

    except
      ExceptionLog( 'Сбой Un_Export.Export_GetFullFileNameSendDat');
  end;

end;


{~Export_GetParamsExportSection
  функция возвращает название секции параметов экспорта в файле Send.dat.
  параметры
    aMarker - идентификатор секции (ZR, ZR, RN и др).
              фактически это идентификация файла выгрузки.}
function Export_GetParamsExportSection( aMarker: string): string;
begin
  Result := 'ЭКСПОРТ_' + aMarker;

end;

{~Export_GetPackedNumberOfDateExp
  возвращает номер пакета и дату выгрузки для текущей операции экспорта.
  номер пакета и дата последней выгрузки загружается из файла Send.Dat.
  если дата последней выгрузки соответствует дате текущей операции (из даты
  во входном задании aSourceXml), но нумерация пакетов начинается с начала.
  параметры
    aSourceXml -(вх,обяз) узел корневого элемента входного задания XML;
    aDirIni - (вх,обяз) каталог, где находится Schema\Send.dat.
              (концевой символ "\" необязателен);
    aSection - (вх,обяз) маркер экспорта (ZR,ZN,RN, ...);
    aPackedNumber - (вых) номер последнего выгруженного пакета (в пред.операции
                    экспорта) или =0;
    aExportDate - дата текущей операции (из входного задания aSourceXml).}
procedure Export_GetPackedNumberOfDateExp( var aSourceXml: Variant;
                                           aDirIni: string;
                                           aSection: string;
                                           var aPackedNumber: integer;
                                           var aExportDate: string);
var
  xSection: string;
  xIniLastData: string;
  xFileNameIni: string;
begin

    try
      xFileNameIni := Export_GetFullFileNameSendDat( aDirIni);
      xSection     := Export_GetParamsExportSection( aSection);

      // загружаем описание последней выгрузки по дате выгрузке
      xIniLastData := LoadFromIni( xFileNameIni,
                                   xSection,
                                   cnExportIniLastData);


      // получаем номер пакета.
      // особенность в том, что в случае сбоя, начинаем нумерацию пакета
      // с начала, при этом сбой не транслируем дальше, а продолжаем
      // выполнение скрипта. при чтении это не столь актуально как при записи
      // номера пакета в файл.
      try
        aPackedNumber:= STRTOINT(
                          LoadFromIni( xFileNameIni,
                                       xSection,
                                       cnExportIniPackedNumber,
                                       '0'));

        except

          aPackedNumber:= 0;
      end;

      // проверяем, если дата последней выгрузки не совпадает с текущей
      // датой выгрузки, то сбрасываем номер пакета с нуля (начинаем нумерацию
      // с начала)
      aExportDate := GetExchDateFromSourceXml( aSourceXml);

      if (xIniLastData <> aExportDate)
        then aPackedNumber:= 0;
      except
        ExceptionLog( 'Сбой Un_Export.Export_GetPackedNumberOfDateExp');
    end;

end;

{~Export_SetPackedNumberOfDateExp
  сохраняет номер пакета и дату экспорта в файле Send.dat.
  эту операцию нужно делать в самом конце выгрузки, когда все файлы уже
  созданы и операция выгрузки выполнена успешно.
  параметры
    aDirIni - (вх,обяз) каталог, где находится Schema\Send.dat.
              (концевой символ "\" необязателен);
    aSection - (вх,обяз) маркер экспорта (ZR,ZN,RN, ...);
    aPackedNumber - (вых) номер последнего выгруженного пакета (в пред.операции
                    экспорта) или =0;
    aExportDate - дата текущей операции (из входного задания aSourceXml).}
procedure Export_SetPackedNumberOfDateExp( aDirIni: string;
                                           aSection: string;
                                           aPackedNumber: integer;
                                           aExportDate: string);
var
  xSection: string;
  xFileNameIni: string;
begin

    try

      xFileNameIni := Export_GetFullFileNameSendDat( aDirIni);
      xSection     := Export_GetParamsExportSection( aSection);

      SaveToIni( xFileNameIni,
                 xSection,
                 cnExportIniLastData,
                 aExportDate);

      SaveToIni( xFileNameIni,
                 xSection,
                 cnExportIniPackedNumber,
                 INTTOSTR( aPackedNumber));
      except
        ExceptionLog( 'Сбой Un_Export.Export_SetPackedNumberOfDateExp');
    end;

end;


{~DoExportFinalize
  последняя операция экспорта.
  учитывается:
    глобальная переменная IsCriticalError из модуля Un_Log;
    глобальная переменная IsOpenedDialogNextOrBreak из модуля Un_MessageValidForm.

    если экспорт выполнен (aResult=TRUE), то:
      1) проверяется наличие файла FileInfo - журнал замечаний.
         если он есть, то:
        1.1) если есть файл критических замечаний и сброшен флаг открытия
           диалога выбора решения продолжить/прервать операцию, то:
           1.1.а) если файл aJournalTmp существует - отображается этот файл в
                  немодальном и новом окне.
           1.1.б) если файла aJournalTmp не будет, то ничего отображаться не
                  будет.
      в результате функция вернет =TRUE.

    если экспорт не выполнен (aResult=FALSE) то:
      2) если IsCriticalError =true, то:
         2.а) если файл aJournalTmp существует - отображается этот файл в
              модальном диалоге выделенный цветом, а в заголовке будет
              отображаться сообщение об ошибке.
         2.б) если файла aJournalTmp не будет (что будет означать об ошибках
              в скриптах), то будет модальный диалог с текстом "ЭД не выгружены".
      3) если IsCriticalError =false, то:
         3.а) если хоть раз открывался диалог с предложением продолжить или
              прервать экспорт (в случае критических вариантов с выбором),
              то никаих окон не отображается.
         3.б) если ни разу диалогов с выбором прервать/продолжить не
              открывалось, то:
               3.б.I) если файл aJournalTmp существует - отображается этот файл
                      в немодальном и новом окне.
               3.б.II) если файла aJournalTmp не будет, то никаких окон не
                      будет отображено.
      для пп.2 или пп.3 функция вернет =FALSE.

    exchange #3056
      в случае наличия журнала info или критических замечаний
      файл выгрузки не формируем, но сообщений тоже не отображаем.
      результат при этом будет =false.

    результат:
      =true - можно выполнить архивацию выгружаемых ЭД;
      =false - архивация не допустима.}
function DoExportFinalize( aResult: boolean; aJournalTmp{, aJournal}: string): boolean;
begin

    try
      if NOT aResult then begin
(*
        if IsCriticalError then begin
          // отображаем ошибки с блокировкой отмены операции
          if FileExists( aJournalTmp)
            then ShowMessageValid( aJournalTmp,
                                    'Журнал экспорта данных (ЭД НЕ ВЫГРУЖЕНЫ)',
                                    (mvBreakDisabled + mvModal + mvError + mvStayOnTop + {mvDialogYN + }mvNotepad),
                                    'Ошибка экспорта ЭД.'#13#10'Продолжать выгрузку?')
            else ShowMessage( 'ЭД не выгружены.');
        end else begin
          if NOT IsOpenedMessageDialogNextOrBreak then
            // отображаем ошибки с блокировкой отмены операции
            if FileExists( aJournalTmp)
              then //ShellExecute( 'NotePad', aJournalTmp, False)
                   ShowMessageValid( aJournalTmp,
                                      'Журнал экспорта данных (ЭД НЕ ВЫГРУЖЕНЫ)',
                                      (mvBreakDisabled + mvModal + mvError + mvStayOnTop + {mvDialogYN + }mvNotepad),
                                      'Ошибка экспорта ЭД.'#13#10'Продолжать выгрузку?');
        end;
*)
        Result := FALSE;
        EXIT;
      end;


      // exchange #3056
      // в случае наличия только критических замечаний
      // файл выгрузки не формируем, но сообщений тоже не отображаем.
      // здесь отменяем то, что журнал info является критической ошибкой,
      // поскольку ошибки валидации так же записываются в журнал info,
      // но потом могут отменить это замечание и продолжить выгрузку.
      // в этом случае нужно сформировать файлы и помещать эд в архив.
      // но в случае критических ошибок перенос эд в архив выполняться
      // не должен!
      if ( {FileExists( FileInfo) OR }IsCriticalError {OR NOT(IsOpenedMessageDialogNextOrBreak)})
        then begin
          Result := FALSE;
          {
          // открываем сообщение в отдельном не модальном окне с блокировкой
          // отмены операции
          if FileExists( aJournalTmp)
            then ShowMessageValid( aJournalTmp,
                            'Журнал экспорта данных (ЭД ВЫГРУЖЕНЫ)',
                            (mvControlDisabled + mvNew + mvStayOnTop + mvNotepad))
            else
          if FileExists( FileInfo)
            then ShowMessageValid( FileInfo,
                            'Журнал экспорта данных (ЭД ВЫГРУЖЕНЫ)',
                            (mvControlDisabled + mvNew + mvStayOnTop + mvNotepad));
          Result := TRUE;
          }
          EXIT;
        end;

      Result := TRUE;
      except
        ExceptionLog( 'Сбой Un_Export.DoExportFinalize');
    end;

end;

procedure InitializeExportCfgZip( aCfg: TStringList);
begin

    try
      vCfg_Zip := ( LOWERCASE( aCfg.Values[ 'Выгружать в ZIP-архив']) = 'да');

      except
        ExceptionProc( 'InitializeExportCfgZip');
    end;

end;


{~CopyExportResultFile
  копирование выгруженного файла aResultFileName в каталог.
  здесь учитывается настройка создания zip архива.}
function CopyExportResultFile( aResultFileName, aDirTo: string;
                                aShowMsg: boolean = TRUE;
                                aRemove: boolean = TRUE): boolean;

function getPosLastDot(text: String): Integer;
var
  n: Integer;
begin
  n := Length(text);
  while n > 0 do
  begin
    if text[n] = '.' then Break;
    n := n - 1;
  end;
  Result := n;
end;

var
  xResultFileName, sTmp: string;
  xOutFileName: string;
  sFormatIdentifire: String;
begin

    try
      Result := FALSE;

      if aShowMsg
        then WriteLog(
                  FORMAT(
                    'Перенос выгруженного файла в исходящий каталог %s ...',
                    [ DirOut]),
                  True);

      // перед тем как копировать выгруженный файл, проверяем, если
      // нужно создать ZIP то формируем zip в том же каталоге,
      // где лежит созданный файл.
      if vCfg_Zip then begin
        sFormatIdentifire := Copy(aResultFileName, getPosLastDot(aResultFileName) + 1, 2);
        sTmp := ChangeFileExt( aResultFileName, '_' + sFormatIdentifire);
        xResultFileName := ChangeFileExt( sTmp, '.zip');
        if NOT MakeZIP_File( xResultFileName, aResultFileName)
          then EXIT;
      end else begin
        xResultFileName := aResultFileName;
      end;

      xOutFileName := aDirTo + ExtractFileName( xResultFileName);

      CopyFile( xResultFileName, xOutFileName, False);
      Result := FileExists( xOutFileName);
      if NOT Result then begin
        MessageDlg(
            FORMAT(
               'Ошибка копирования в исходящий каталог.'#13#10'Файл находится: %s',
               [ xResultFileName]),
            mtError, mbOk, 0);
        EXIT;
      end;
      if aShowMsg
        then WriteLog( 'Выгруженный файл скопирован в каталог: ' + xOutFileName);

      // если результат получен, удаляем исходный zip архив и исходный файл

      if vCfg_Zip then DeleteFile( xResultFileName);
      if aRemove
        then DeleteFile( aResultFileName);
      except
        ExceptionProc( 'CopyExportResultFile');
    end;

end;


function CopyExportResultFiles( aFiles: TStrings;
                                aDirFrom, aDirTo: string;
                                aMoveTo: boolean = FALSE): integer;
var
  i: integer;
  xFileName: string;
begin
  Result := 0;

    try
      Result := 0;
      if (aFiles = NIL) then EXIT;
      WriteLog( FORMAT( 'Копирование документов в каталог %s...', [ aDirTo]), True);
      // копируем созданные файлы
      SetProgress( 0, aFiles.Count);
      for i := 0 to aFiles.Count - 1 do begin
        xFileName := aFiles.Strings[i];
        ShowProgress( i);
//        if NOT CopyFileEx( aDirFrom + xFileName, aDirTo + xFileName, aMoveTo)
        if NOT CopyExportResultFile( aDirFrom + xFileName, aDirTo, FALSE, aMoveTo)
          then BREAK;
        INC( Result);
      end;//for//

      except
        ExceptionProc( 'CopyExportResultFiles');
    end;

end;

procedure setTOFKProps(aCfg_param_UFK_TOFK: String; aDataSectionXml: Variant; aAccId, aDstAttrNameKod, aDstAttrNameName: String);
var
  tmpStr: String;
begin
  // Заполняем KOD_TOFK_PAY и NAME_TOFK_PAY из ТОФК или УФК в зависимости от значения параметра
  tmpStr := '';
  // Если по настройке заполняем из УФК - берем соотв. запрос.
  if (aCfg_param_UFK_TOFK = 'УФК') then
    tmpStr := sqlUfkAcc
  // Если по настройке заполняем из ТОФК - берем соотв. запрос.
  else if (aCfg_param_UFK_TOFK = 'ТОФК') then
    tmpStr := sqlTofkAcc;
  // Если определили какой запрос выполнять - заполняем
  if (tmpStr <> '') then
  begin
    aDataSectionXml.setAttribute(aDstAttrNameKod, QueryField( tmpStr, [aAccId], 'NAME'));
    aDataSectionXml.setAttribute(aDstAttrNameName, QueryField( tmpStr, [aAccId], 'DESCRIPTION'));
  end;
end;

begin
end.
