uses '..\Tools\Un_Query', '..\Version\CheckVersion';

var
  Form: TFormCustom;
  ProgressBar: TProgressBar;
  edFile: TEdit;
  btnExecute: TButton;
  odFile: TOpenDialog;
  chkPlanImport: TCheckBox;
  FileLog, FileInfo, FSourceDocClass: String;
  ErrorList: TStrings;
  FDebuger: Boolean;
  FAzkIsLogin: Boolean;
  XmlSysParams: Variant;

const
  FFileVer = '1.0';
  FFileGuid = '{3E93C57C-3D37-490B-8A65-27F87FD1CFCE}';
  // exchange #2754
  // при импорте ценных бумаг гуид не совпадает с договорами и пр.
  // планеры менять не хотят, поэтому подстраиваемся под планеров.
  FFileGuidEx = '{72D46F86-F250-41BC-92BF-BC96D9C05658}';

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

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

procedure Main(Xml: Variant);
begin
  CheckWorkAppVersion;
  with Xml.documentElement do
  if getAttribute('TESTED') = 'True' then
  begin
    setAttribute('TESTED', 'False');
    Xml.save('C:\Temp\LoanDocImport.Xml');
    ShowMessage('Тестовый пример приготовлен: C:\Temp\LoanDocImport.Xml');
    Exit;
  end;
  FAzkIsLogin := AzkIsLogin;
  if not AzkIsLogin then
    if not AzkLogin then
      Exit;
  try
    try
      initialization(Xml);
      if FDebuger then
      begin
        Form.Show;
        repeat
          Application.handleMessage;
        until(not Form.Visible);
      end
      else
        Form.ShowModal;
    except
      WriteLog('Сбой Main: ' + LastException.Message);
      raise( #13#10'Сбой Main: ' + LastException.Message);
    end;
  finally
    finalization;
    if not FAzkIsLogin then
      AzkLogout;
  end;
end; {End Main}

procedure initialization(Xml: Variant);
var
  i: Integer;
  IniPath: String;
begin
  ErrorList := TStringList.Create;
  IniPath := ExtractFilePath(Xml.documentElement.getAttribute('INI_FILE'));
  FileLog := IniPath + 'LoanDocImport.Log';
  FileInfo := IniPath + 'LoanDocImport.Inf';
  Form := TFormCustom.Create(Application);
  Form.LoadDfm(IniPath + 'Fm_LoanDocImport.dfm');
  Form.Name := 'FmLoanDocImport';
  WriteLog(' ====== ИНИЦИАЛИАЗЦИЯ ИМПОРТА ======');
  TLabel(Form.FindComponent('lblVersion')).Caption := 'Версия формата: ' + FFileVer;
  WriteLog(TLabel(Form.FindComponent('lblVersion')).Caption);
  ProgressBar := TProgressBar(Form.FindComponent('ProgressBar'));
  edFile := TEdit(Form.FindComponent('edFile'));
  odFile := TOpenDialog(Form.FindComponent('odFile'));
  btnExecute := TButton(Form.FindComponent('btnExecute'));
  TSpeedButton(Form.FindComponent('btnFile')).OnClick := @btnFileOnClick;
  chkPlanImport := TCheckBox(Form.FindComponent('chkPlanImport'));
  Form.actExecute.OnExecute := @actExecuteExecute;
  Form.SimpleText := '';
  QueryInitialization;
end; {End initialization}

procedure finalization;
begin
  QueryFinalization;
  WriteLog(' ======= ФИНАЛИЗАЦИЯ ИМПОРТА =======');
  Form.Free;
  ErrorList.Free;
end; {End finalization}

procedure WriteLog(Message: String; SimpleText: Boolean = True);
begin
  if SimpleText then
    Form.SimpleText := Message;
  if FileLog <> '' then
    WriteLogFile(FileLog, Message);
end; {End WriteLog}

procedure WriteInfo(Message: String; aParam: boolean = FALSE);
var
  str: String;
begin
  str := MD5String(Message);
  if ErrorList.indexOf(str) < 0 then
  begin
    ErrorList.Add(str);
    WriteLogFile(FileInfo, Message);
    WriteLogFile(FileLog, Message);
  end;
end; {End WriteInfo}


function DocInfoEx(Doc: Variant):String;
begin
  Result := FORMAT( ' номер %s  дата %s',
                    [ Trim(Doc.getAttribute('DOC_NUMBER')),
                      FormatDateTime( 'dd.mm.yyyy',
                                      XmlToDateTime(
                                            Doc.getAttribute('DOC_DATE')))]);
end; {End DocInfo}


procedure btnFileOnClick(Sender: TObject);
begin
  if odFile.Execute then
    edFile.Text := odFile.FileName;
end; {End btnFileOnClick}

procedure actExecuteExecute(Sender: TObject);
//var
//  Msg: String;
begin
  try
    if FileExists(FileInfo) then DeleteFile(FileInfo);
    ErrorList.Clear;

    WriteLog('    ====== НАЧАЛО ИМПОРТА ======');
    SetAppDisable;

    btnExecute.Action := Form.actCancel;
    Form.actCancel.Checked := False;
    try
      if Trim(edFile.Text) = '' then
        Raise('Не указана файл импорта');
      if not FileExists(edFile.Text) then
        Raise('Не найден файл импорта: ' + edFile.Text);
      WriteLog('     === ПАРАМЕТРЫ ИМПОРТА ===');
      WriteLog('Файл импорта: ' + edFile.Text);
      if chkPlanImport.Checked then WriteLog('Планы по договорам будут загружаться')
      else WriteLog('Планы по договорам загружаться не будут');
      ExecuteProcess;
    finally
      ProgressBar.Position := 0;
      btnExecute.Action := Form.actExecute;
      SetAppEnable;
//      WriteLog(Msg);
      WriteLog('    ==== ЗАВЕРШЕНИЕ ИМПОРТА ====');
      Form.SimpleText := '';
      if FileExists(FileInfo) then ShellExecute('NotePad', FileInfo, false);
    end;
    except
      WriteInfo(' Сбой actExecuteExecute: ' + LastException.Message);
      raise(#13#10' Сбой actExecuteExecute: ' + LastException.Message);
  end;
end; {End actExecuteExecute}

function ExecuteProcess: Boolean;
var
  Xml, DocList: Variant;
begin
  try
    Xml := CreateOleObject('Microsoft.XmlDom');
    WriteLog('Загрузка файла импорта: '  + edFile.Text);
    if not Xml.load(edFile.Text) then
      raise('Ошибка загрузки файла импорта: ' + edFile.Text);
    Xml := Xml.documentElement;
    WriteLog('Проверка заголовочной части ...');
    if VarIsNull(Xml.getAttribute('FILEGUID')) then
      raise('Отсутствует обязательный параметр: <FILEGUID>');
    if Xml.getAttribute('FILEGUID') <> FFileGuid then
      if Xml.getAttribute('FILEGUID') <> FFileGuidEx
        then raise( FORMAT( 'Не совпадает параметр <FILEGUID>, требуется: %s или %s.',
                            [ FFileGuid,
                              FFileGuidEx]));
    if VarIsNull(Xml.getAttribute('FILEVER')) then
      raise('Отсутствует обязательный параметр: <FILEVER>');
    if Xml.getAttribute('FILEVER') <> FFileVer then
      raise('Не совпадает параметр <FILEVER>, требуется: ' + FFileVer);
    if VarIsNull(Xml.getAttribute('FINYEAR')) then
      raise('Отсутствует обязательный параметр: <FINYEAR>');
    if Xml.getAttribute('FINYEAR') <> FormatDateTime('yyyy', Work_Date) then
      raise('Не совпадает параметр <FINYEAR>, требуется: ' + FormatDateTime('yyyy', Work_Date));
    if VarIsNull(Xml.getAttribute('DOCUMENTCLASS')) then
      raise('Отсутствует обязательный параметр: <DOCUMENTCLASS>');
    // exchange #2754
    // импорт договора гарантии - класс 57
    if not (Xml.getAttribute('DOCUMENTCLASS') in ['165', '166', '227', '234']) then
      raise('Не совпадает параметр <DOCUMENTCLASS>, требуется: 165 или 166 или 227 или 234');
    FSourceDocClass := VarToStr(Xml.getAttribute('DOCUMENTCLASS'));
    WriteLog('Класс документов: ' + Xml.getAttribute('DOCUMENTCLASS'));
    DocList := Xml.childNodes;
    WriteLog('Документов: ' + IntToStr(DocList.length));
    ImportXml(Xml, DocList);
    except
      WriteInfo(' Сбой ExecuteProcess: ' + LastException.Message);
      raise(#13#10' Сбой ExecuteProcess: ' + LastException.Message);
  end;
end; {End ExecuteProcess}

function GetDocumentClass: String;
begin
  // exchange #2756
  // импорт договора гарантии - класс 57 в АЦК-Ф, а в планировании 227.
  // exchange #2754
  // импорт ценных бумаг - класс 152 в АЦК-Ф, а в планировании 234.
  case FSourceDocClass of
    '165': Result := '44';
    '166': Result := '45';
    '227': Result := '57';
    '234': Result := '152';
  end;//case//
end;

function GetPlanClass(SourceClass: String): String;
begin
  case GetDocumentClass of
    '44': begin
            if SourceClass = '167' then
              Result := '49';
          end;

    '45': begin
            if SourceClass = '170' then
              Result := '55';
          end;

    // exchange #2756
    // импорт договора гарантии - класс 57
    // вложенные классы на закладке операции (LINE): 115 в АЦК-Ф,
    // а в планировании 228.
    '57': if SourceClass = '228'
            then Result := '115';

    // exchange #2754
    // импорт ценных бумаг - класс 152
    // вложенные классы на закладке операции (LINE): 153 в АЦК-Ф,
    // а в планировании 235.
    '152': if SourceClass = '235'
            then Result := '153';
  end;//case//
end;

function IsAgree(DocClass: Integer): Boolean;
begin
  // exchange #2756
  // при загрузке 57го класса в разделах LINE при галочке на форме
  // "Загружать планы по договорам" фильтруем загрузку только 115го класса
  // exchange #2754
  // при загрузке 152го класса в разделах LINE при галочке на форме
  // "Загружать планы по ценным бумагам" фильтруем загрузку только 153го класса
  if (chkPlanImport.Checked and (DocClass in [49, 55, 115, 153])) then
    Result := True
  else
    Result := False;
end;

function ImportXml(Xml, DocList: Variant): Boolean;
var
  i, j: Integer;
  Amount: Currency;
  CurSection, NewRec, SaveDoc: Variant;
  SaveDocID: String;
  xDocId: string;
begin
  try
    Result := False;
    WriteLog('Начало импорта документов ...');
    ProgressBar.Max := DocList.length;
    for i := 0 to DocList.length - 1 do
    begin
      ProgressBar.Position := ProgressBar.Position + 1;
      Form.SimpleText := Format('Импорт данных ... %d из %d',
        [ProgressBar.Position, DocList.length]);

      if Form.actCancel.Checked then
      begin
        Form.actCancel.Checked := False;
        if MessageDlg('Хотите прервать исполнение ?' + #10 + 'На этапе импорта это не желательно.',
          mtConfirmation  , mbYes + mbNo , 0) = mrYes then
          Exit
      end;
      CurSection := DocList.items[i];

      // проверка полей импортируемого документа на существование в базе
      if Not CorrectAttributes(CurSection) then
        continue;

      // проверка существования импортируемого документа в базе по FOREIGN_KEY
      SaveDocID := ExistDocument(CurSection, 'LOANDOC', GetDocumentClass);

      if SaveDocID = '-1' then
      begin
        // создание документа
        NewRec := MakeDoc(Xml, CurSection);

        // сохранение записи
        SaveDoc := SaveDocument(NewRec);



        if Not VarIsNull(SaveDoc) then
          case SaveDoc.GetAttribute('DOCUMENTCLASS_ID') of
            // exchange #2756
            // при создании договора гарантии его нужно перевести на 10й статус.
            // в начале переводим на "зарегистрировать".
            // на этом статусе можно добавлять 115й класс (план договоров).
            '57':
              try
                xDocId := SaveDoc.getAttribute('ID');
                NewRec.setAttribute('ID', xDocId);
                NewRec.setAttribute('action', 'commit');
                NewRec.setAttribute('FROM', 'AZK_Exchange');
                ExecXML( NewRec.xml);
                WriteLog( FORMAT( 'ЭД "Договор гарантии" %s переведен на статус "Зарегистрирован".',
                                  [ DocInfoEx( NewRec)]));
                except
                  WriteInfo( FORMAT( 'Ошибка перевода ЭД "Договор гарантии" %s на статус "Зарегистрирован": %s',
                                    [ DocInfoEx( NewRec),
                                      LastException.Message]));
              end;

            // exchange #2754
            // при создании ЭД "Выпуск ценных бумаг" его нужно перевести на 10й статус.
            // в начале переводим на "зарегистрировать".
            // на этом статусе можно добавлять план (153й класс) класс.
            '152':
              try
                xDocId := SaveDoc.getAttribute('ID');
                NewRec.setAttribute('ID', xDocId);
                NewRec.setAttribute('action', 'commit');
                NewRec.setAttribute('FROM', 'AZK_Exchange');
                ExecXML( NewRec.xml);
                WriteLog( FORMAT( 'ЭД "Выпуск ценных бумаг" %s переведен на статус "Зарегистрирован".',
                                  [ DocInfoEx( NewRec)]));
                except
                  WriteInfo( FORMAT( 'Ошибка перевода ЭД "Выпуск ценных бумаг" %s на статус "Зарегистрирован": %s',
                                    [ DocInfoEx( NewRec),
                                      LastException.Message]));
              end;
          end;//case//

        if Not VarIsNull(SaveDoc) then
          SaveDocID := VarToStr(SaveDoc.getAttribute('ID'));
      end else begin
        // exchange #2753
        // если ЭД уже есть в БД, то статус не переводим
        NewRec := NULL;
      end;

      // создание плана
      if (SaveDocID <> '-1') and chkPlanImport.Checked then begin
        MakePlan(Xml, CurSection, SaveDocID);

        if NOT VarIsNull( NewRec) then
          case SaveDoc.GetAttribute('DOCUMENTCLASS_ID') of
            // exchange #2756
            // при создании договора гарантии его нужно перевести на 10й статус.
            // здесь проверяем, если ЭД уже есть в БД, то статус не переводим.
            // теперь из состояния "зарегистрирован" переводим на "завершить
            // обработку"
           '57':
              try
                NewRec.setAttribute('action', 'complete');
                NewRec.setAttribute('FROM', 'AZK_Exchange');
                ExecXML(NewRec.xml);
                WriteLog( FORMAT( 'ЭД "Договор гарантии" %s переведен на статус "Обработка завершена".',
                                  [ DocInfoEx( NewRec)]));
                except
                  WriteInfo( FORMAT( 'Ошибка перевода ЭД "Договор гарантии" %s на статус "Обработка завершена": %s',
                                    [ DocInfoEx( NewRec),
                                      LastException.Message]));
              end;

            // exchange #2754
            // при создании ЭД "Выпуск ценных бумаг" его нужно перевести на 10й статус.
            // здесь проверяем, если ЭД уже есть в БД, то статус не переводим.
            // теперь из состояния "зарегистрирован" переводим на "завершить
            // обработку"
           '152':
              try
                NewRec.setAttribute('action', 'complete');
                NewRec.setAttribute('FROM', 'AZK_Exchange');
                ExecXML(NewRec.xml);
                WriteLog( FORMAT( 'ЭД "Выпуск ценных бумаг" %s переведен на статус "Обработка завершена".',
                                  [ DocInfoEx( NewRec)]));
                except
                  WriteInfo( FORMAT( 'Ошибка перевода ЭД "Выпуск ценных бумаг" %s на статус "Обработка завершена": %s',
                                    [ DocInfoEx( NewRec),
                                      LastException.Message]));
              end;
          end;//case//
      end;
    end;
    ProgressBar.Position := 0;
    WriteLog('Импорт данных завершен ...');
    Result := True;
    except
      WriteInfo(' Сбой ImportXml: ' + LastException.Message);
      raise(#13#10' Сбой ImportXml: ' + LastException.Message);
  end;
end; {End ImportXml}

function SaveDocument(Doc: Variant): Variant;
var
  ServDoc: Variant;
begin
  Result := null;

  {отладка}
  WriteLog( FORMAT( 'Создается ЭД: ', [ Doc.xml]));

  try
    ServDoc := CreateOleObject('Microsoft.XmlDom');
    ServDoc.loadXML(ExecXML(Doc.xml));

    Result := ServDoc.documentElement;

  except
    if not ServDoc.loadXml(LastException.Message) or
      ServDoc.documentElement.getElementsByTagName('MESSAGE').length = 0 then
        WriteInfo(DocInfo(Doc) + 'Ошибка: ' + LastException.Message)
    else
    begin
      ServDoc := ServDoc.documentElement.getElementsByTagName('MESSAGE');
      WriteInfo(DocInfo(Doc) + 'Ошибка: ' + ServDoc.items[0].text);
    end;
  end;
end;

function ExistDocument(Section: Variant; TableName: String; DocumentClassID: String): String;
var
  Xml: Variant;
  msg: String;
  searchField, searchValue: String;
begin
  Result := '-1';

  searchField := 'ID';
  searchValue := VarToStr(Section.getAttribute('FOREIGN_KEY'));
  if searchValue = '' then
  begin
    searchField := 'FOREIGN_KEY';
    searchValue := VarToStr(Section.getAttribute('ID'));
  end;

  Xml := CreateOleObject('Microsoft.XmlDom');
  Query.AddLong(DocumentClassID);
  Query.AddLong(searchValue);
  Xml.LoadXml(Query.Run('Select ID From ' + TableName + ' D ' +
    ' Where D.DocumentClass_Id = ? And D.DispStatus_Id <> -1' +
    ' And D.' + searchField + ' = ?'));
  if Xml.documentElement.childNodes.length <> 0 then
  begin
    msg := 'Документ с ' + searchField + '=' + searchValue +
      ', DOCUMENTCLASS_ID=' + DocumentClassID + ' в таблицу ' + TableName +
      ' был ранее вставлен';
    WriteInfo(DocInfo(Section) + msg);
    Result := VarToStr(Xml.DocumentElement.firstChild.getAttribute('ID'));
  end;
end;

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
      // exchange #2624
      // название кода приводим к верхнему регистру.
      // это потому то в справочнике масок, название кода указывается всегда
      // в верхнем регистре.
      GetFormatKbkLengthAndMask( UPPERCASE( aCodeName),
                                 aBudget_Id,
                                 xCodeLength,
                                 xCodeMask,
                                 xCodeNull);

      // если код указан нулевым, т.е. требуется вернуть форматированный
      // нулевой код, тогда возвращаем нулевой код.
      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
        raise( 'Сбой FormatKbk: ' + LastException.Message);
    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;
  xCodeLengthStr: string;
  xXmlAplabet: Variant;
  xMaskAplabet: string;
begin
    try
      // нулевой код пока не определен но здесь ВАЖНО инициализировать строку.
      aNullCode := '';

      // загружаем длину и маску из бд
      aMask := VarToStr(
                   QueryField( 'Select Tree_Mask From CodeType Where Name = ? '
                              +'and Budget_Id = ?',
                              [ aCodeName,
                                aBudget_Id],
                              'TREE_MASK'));
      xCodeLengthStr := VarToStr(
                            QueryField( 'Select TREE_MASK_LENGTH From CodeType '
                                       +'Where Name = ? and Budget_Id = ?',
                                        [ aCodeName,
                                          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.',
                            [ aCodeName,
                              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
        raise( 'Сбой GetFormatKbkLengthAndMask: ' + LastException.Message);
    end;
end;


function SearchTagLineForED153( aSection: Variant): Variant;
var
  i: integer;
begin
  try
    for i := 0 to aSection.ChildNodes.length - 1 do
      if (aSection.ChildNodes.Item[i].NodeName = 'LINE') then begin
        Result := aSection.ChildNodes.Item[i];
        EXIT;
      end;
    Result := NULL;
    except
      raise( 'Сбой SearchTagLineForED153: ' + LastException.Message);
  end;
end;

function CorrectAttributes(Section: Variant): Boolean;

  procedure CheckField(RefName, ID, RefTitle, Name: String);
  var S: String;
  begin
    try
      if StrToFloatDef(ID, 0) = 0 then
        Exit;
      S := VarToStr(QueryField('Select ID From ' + RefName + ' Where ID = ?', [ID], 'ID'));
      if StrToFloatDef(S, -1) < 0 then
      begin
        WriteInfo('Не найдена запись в справочнике '+RefTitle+' "'+Name+'"');
        Result := False;
      end;

      except
        raise( 'Сбой CorrectAttributes.CheckField: '+LastException.Message);
    end;
  end;

  procedure CheckKBK(Doc: Variant; CodeName: String);
  var tableName, fieldName, params: String;
    xCodeValue: string;
  begin
    params := ' and Budget_ID=' + Budget_Id;
    fieldName := 'CODE';

    // получаем значение кода из планирования
    xCodeValue := VarToStr(Doc.getAttribute(CodeName + '_' + fieldName));

    case CodeName of
      'KFSR': tableName := 'Kfsr';
      'KCSR': tableName := 'Kcsr';
      'KVR': tableName := 'Kvr';
      'KESR', 'KESD', 'KESI':
        begin
          tablename := 'Kes';

          // exchange #2624
          // для проверки кода КОСГУ =0, проверяем код с учетом маски.
          // заранее не знаем сколько нулей содержит 0-й код.
          params := params + ' and anal_kind = ';
          if (xCodeValue = FormatKbk( tablename, '0', Budget_Id))
            then params := params + '0'
            else
              case CodeName of
               'KESD' : params := params + '1';
               'KESR' : params := params + '2';
               'KESI' : params := params + '3';
              end;
        end;
      'KADMR', 'KADMD', 'KADMI': tablename := 'Kadm';
      'KDF': tablename := 'Kdf';
      'KDE': tablename := 'Kde';
      'KDR': tablename := 'Kdr';
      'FSR', 'FSD', 'FSI': begin
            tablename := 'FinSource'; fieldName := 'ID'; params := '';
            // exchange #2624
            // для этих полей суффикс не _CODE, а _ID
            xCodeValue := VarToStr(Doc.getAttribute(CodeName + '_ID'));
          end;
      'KD': tablename := 'Kd';
      'KDD': tablename := 'Kdd';
      'KI': tablename := 'Ki';
      'KDI': tablename := 'Kdi';
      'KDT': tablename := 'Kdt';
    end;
    sql := 'Select ' + fieldName + ' From ' + tableName + ' Where ' + fieldName + '= ?' + params;

    if QueryField(sql, [ xCodeValue], fieldName) = null then
    begin
        WriteInfo( 'Не найден в АЦК ' + KBKCaptionByCodeName(CodeName) + ': '
                    + xCodeValue);
        Result := False;
    end;
  end; {End CheckKBK}

  function KBKCaptionByCodeName(CodeName: String): String;
  begin
    case CodeName of
      'KFSR': Result := 'функциональный классификатор расходов';
      'KCSR': Result := 'классификатор целевой статьи расходов';
      'KVR': Result := 'классификатор вида расходов';
      'KESR': Result := 'классификатор операций сектора государственного управления расходов';
      'KADMR': Result := 'ведоственный классификатор расходов';
      'KDF': Result := 'дополнительный функциональный код';
      'KDE': Result := 'дополнительный экономический код';
      'KDR': Result := 'дополнительный код расхода';
      'FSR', 'FSD', 'FSI': Result := 'источники финансирования';

      'KADMD': Result := 'ведоственный классификатор доходов';
      'KD': Result := 'классификатор видов доходов';
      'KDD': Result := 'дополнительный доходный код';
      'KESD': Result := 'классификатор операций сектора государственного управления доходов';
      'KDT': Result := 'типы доходов';
      
      'KI': Result := 'классификатор видов источников';
      'KDI': Result := 'дополнительный код источника';
      'KADMI': Result := 'ведоственный классификатор источников';
      'KESI': Result := 'классификатор операций сектора государственного управления источников';
    end;
  end; {End KBKCaptionByName}

  procedure CheckKBKOnRow(Row: Variant);
  begin
    // расходы КБК
    CheckKBK(Row, 'KFSR');
    CheckKBK(Row, 'KCSR');
    CheckKBK(Row, 'KVR');
    CheckKBK(Row, 'KESR');
    CheckKBK(Row, 'KADMR');
    CheckKBK(Row, 'KDF');
    CheckKBK(Row, 'KDE');
    CheckKBK(Row, 'KDR');
    CheckKBK(Row, 'FSR');
    // доходы КБК
    CheckKBK(Row, 'KADMD');
    CheckKBK(Row, 'KD');
    CheckKBK(Row, 'KDD');
    CheckKBK(Row, 'KESD');
    CheckKBK(Row, 'KDT');
    CheckKBK(Row, 'FSD');
    // источники КБК
    CheckKBK(Row, 'KI');
    CheckKBK(Row, 'KDI');
    CheckKBK(Row, 'KADMI');
    CheckKBK(Row, 'KESI');
    CheckKBK(Row, 'FSI');

    CheckField('ESTIMATE', VarToStr(Row.getAttribute('ESTIMATE_ID')), 'Сметы',
      VarToStr(Row.getAttribute('ESTIMATE_NAME')));
    CheckField('ORG', VarToStr(Row.getAttribute('RECIPIENT_ID')), 'Организации',
      VarToStr(Row.getAttribute('RECIPIENT_NAME')));
    CheckField('ORG', VarToStr(Row.getAttribute('COUNTERAGENT_ID')), 'Организации',
      VarToStr(Row.getAttribute('COUNTERAGENT_NAME')));
    CheckField('ORG', VarToStr(Row.getAttribute('PAYER_ID')), 'Организации',
      VarToStr(Row.getAttribute('PAYER_NAME')));
    CheckField('TERRITORY', VarToStr(Row.getAttribute('TERRITORY_ID')), 'Территории',
      VarToStr(Row.getAttribute('TERRITORY_NAME')));

    // exchange #2650
    // поиск получателя должен быть не в таблице ORG а в таблице RECEIVER
    CheckField('RECEIVER', VarToStr(Row.getAttribute('RECEIVER_ID')), 'Организации',
      VarToStr(Row.getAttribute('RECEIVER_NAME')));
  end;

  procedure CheckOperType(Row: Variant; DocumentClass, ID, Name: String);
  var S: String;
  begin
    if StrToFloatDef(ID, 0) = 0 then
      Exit;
    S := VarToStr(QueryField('Select O.Id From OperType O ' +
        ' Left Join ClassOper C On (C.OperType_Id = O.Id)' +
        ' Where (C.DocumentClass_Id = ? Or O.Id = 0) And O.Caption = ?',
        [DocumentClass, Name], 'ID'));
    if StrToFloatDef(S, -1) < 0 then
      Row.setAttribute('OPERTYPE_ID', '0');
  end;

var Xml, XmlList, XmlRow: Variant;
    I: Integer;
    SourceClass: String;
begin
  Result := True;

  CheckField('DOCGROUP', VarToStr(Section.getAttribute('DOCGROUP_ID')), 'Группы договоров',
    VarToStr(Section.getAttribute('DOCGROUP_NAME')));
  CheckField('ORG', VarToStr(Section.getAttribute('ORG_ID')), 'Кредиторы',
    VarToStr(Section.getAttribute('ORG_NAME')));
  CheckField('ORGACCOUNT', VarToStr(Section.getAttribute('ORGACCOUNT_ID')), 'Счета организации',
    VarToStr(Section.getAttribute('ORGACCOUNT_NAME')));
  CheckField('LN_GUARANTEE', VarToStr(Section.getAttribute('GUARANTEE_ID')), 'Способы обеспечения обязательств',
    VarToStr(Section.getAttribute('GUARANTEE_NAME')));
  CheckField('LN_CHARACTER', VarToStr(Section.getAttribute('CHARACTER_ID')), 'Признаки договоров',
    VarToStr(Section.getAttribute('CHARACTER_NAME')));
  CheckField('LN_PURPOSE', VarToStr(Section.getAttribute('PURPOSE_ID')), 'Целевые назначения',
    VarToStr(Section.getAttribute('PURPOSE_NAME')));

  // exchange #2756
  // при загрузке эд ценных бумаг нужно указывать код валюты в шапке ЭД
  if (GetDocumentClass = '152') then begin
    Section.SetAttribute(
          'CURRENCY_CODE',
          VarToStr( QueryField(  ' select c.iso_code code from currency c'
                                +' where c.asset_id=?',
                                 [ VarToStr( Section.GetAttribute( 'CURRENCY_ID'))],
                                 'CODE')));
    // из планирования приходит атрибут "DOCUMENT_ID", но при создании ЭД
    // в АЦК-Ф его добавлять нельзя, иначе будет ошибка 009.
    if (LENGTH( VarToStr( Section.GetAttribute( 'DOCUMENT_ID'))) > 0)
      then Section.RemoveAttribute('DOCUMENT_ID');
  end;

  Xml := Section.getElementsByTagName('LN_INTEREST').item[0];
  if not VarIsClear(Xml) then
  begin
    XmlList := Xml.selectNodes('*');
    for I := 0 to XmlList.length - 1 do
    begin
      XmlRow := XmlList.item[I];

      CheckField('LN_PAYTYPE', VarToStr(XmlRow.getAttribute('PAYTYPE_ID')), 'Виды выплат',
        VarToStr(XmlRow.getAttribute('PAYTYPE_NAME')));
      CheckField('LN_CALCMETHOD', VarToStr(XmlRow.getAttribute('CALCMETHOD_ID')), 'Схемы авторасчета выплат',
        VarToStr(XmlRow.getAttribute('CALCMETHOD_NAME')));
      CheckKBKOnRow(XmlRow);
    end;
  end;

  if chkPlanImport.Checked then
  begin
    // Теперь пытаемся вставить документы план/факта
    // exchange #2754
    // при импорте ценных бумаг план описан в подэдлементе LINE.
    // но помимо этого есть другие теги, где есть вложенный тег LINE.
    // поэтому алгоритм поиска нужного тега будет другим.
    if (GetDocumentClass = '152')
      then Xml := SearchTagLineForED153( Section)
      else Xml := Section.getElementsByTagName('LINE').item[0];

    if not VarIsClear(Xml) then
    begin
      XmlList := Xml.selectNodes('*');
      for I := 0 to XmlList.length - 1 do
      begin
        XmlRow := XmlList.item[I];

        SourceClass := VarToStr(XmlRow.getAttribute('DOCUMENTCLASS'));
        // exchange #2754
        // из планирования для плана ценных бумаг ид.класса приходит в поле
        // DOCUMENTCLASS_ID, а не в DOCUMENTCLASS.
        if (LENGTH( SourceClass) <= 0)
          then SourceClass := VarToStr(XmlRow.getAttribute('DOCUMENTCLASS_ID'));

        if Not IsAgree(StrToInt(GetPlanClass(SourceClass))) then
          continue;

        CheckOperType(XmlRow, GetPlanClass(SourceClass), VarToStr(XmlRow.getAttribute('OPERTYPE_ID')),
          VarToStr(XmlRow.getAttribute('OPERTYPE_NAME')));
        CheckField('LN_PAYTYPE', VarToStr(XmlRow.getAttribute('PAYTYPE_ID')), 'Виды выплат',
          VarToStr(XmlRow.getAttribute('PAYTYPE_NAME')));
        CheckKBKOnRow(XmlRow);
      end;
    end;
  end;
  
  if Not Result then
    WriteInfo(DocInfo(Section) + 'В результате найденных ошибок документ будет пропущен');
end;

function MakeDoc(Owner, Section: Variant): Variant;
var DetailRow, iDetailList,
    NewRecDetailSection, NewRecDetailRow: Variant;
    I: Integer;
begin
  // Формируем XML с добавляемой записью (NewRec)
  Result := Owner.ownerDocument.createElement('DOCUMENT');
  Result.setAttribute('action', 'insert');
  Result.setAttribute('BUDGET_ID', Budget_ID);
  Result.setAttribute('class', GetDocumentClass);
  CopyElementAttributes(Section, Result);
  Result.setAttribute('FOREIGN_KEY', VarToStr(Result.getAttribute('ID')));
  Result.removeAttribute('ID');

  // Теперь проверяем наличие видов выплат
  DetailRow := Section.getElementsByTagName('LN_INTEREST').item[0];
  if not VarIsClear(DetailRow) then
  begin
    // Добавляем в NewRec секцию с детальными строками (NewRecDetail)
    NewRecDetailSection := Result.appendChild(Result.ownerDocument.createElement(DetailRow.tagName));
    // Берем все строки детальной секции
    iDetailList := DetailRow.selectNodes('*');
    for I := 0 to iDetailList.length - 1 do
    begin
      DetailRow := iDetailList.item[I];
      // Добавляем детальную строку
      NewRecDetailRow := NewRecDetailSection.appendChild(Result.ownerDocument.createElement(DetailRow.tagName));
      CopyElementAttributes(DetailRow, NewRecDetailRow);
      NewRecDetailRow.setAttribute('BUDGET_ID', Budget_ID);
    end;
  end;

  // exchange #2754
  // при импорте ЭД Ценные бумаги необходимо копировать секцию SC_DISTRIBUTION
  DetailRow := Section.getElementsByTagName('SC_DISTRIBUTION').item[0];
  if not VarIsClear(DetailRow) then begin
    // Добавляем в NewRec секцию с детальными строками (NewRecDetail)
    NewRecDetailSection := Result.appendChild(Result.ownerDocument.createElement(DetailRow.tagName));
    // Берем все строки детальной секции
    iDetailList := DetailRow.selectNodes('*');
    for I := 0 to iDetailList.length - 1 do begin
      DetailRow := iDetailList.item[I];
      // Добавляем детальную строку
      NewRecDetailRow := NewRecDetailSection.appendChild(Result.ownerDocument.createElement( 'LINE'));
      CopyElementAttributes(DetailRow, NewRecDetailRow);
    end;//for//
  end;
end;

procedure MakePlan(Owner, Section: Variant; SaveDocID: String);
var LineList, iLineList, NewRec, LineRow: Variant;
    I: Integer;
    SourceClass, PlanClass: String;
    xNewPlanDoc: Variant;
    xDocId: string;
begin
  try
    {отладка}
    //writeLog( 'Выполняется MakePlan');
    //writeLog( FORMAT( 'Section = "%s".', [ Section.xml]));

    // Теперь пытаемся вставить документы план/факта
    // exchange #2753
    // при импорте ценных бумаг план описан в подэдлементе LINE.
    // но помимо этого есть другие теги, где есть вложенный тег LINE.
    // поэтому алгоритм поиска нужного тега будет другим.
    if (GetDocumentClass = '152')
      then LineList := SearchTagLineForED153( Section)
      else LineList := Section.getElementsByTagName('LINE').item[0];

    {отладка}
    //if not VarIsClear(LineList)
    //  then writeLog( FORMAT( 'LineList = "%s".', [ LineList.xml]));

    if not VarIsClear(LineList) then
    begin
      iLineList := LineList.selectNodes('*');
      for I := 0 to iLineList.length - 1 do
      begin
        LineRow := iLineList.item[I];

        {отладка}
        //writeLog( FORMAT( 'Переменная LineRow = "%s".', [ LineRow.xml]));

        // exchange #2753
        // из планирования приходит DOCUMENTCLASS_ID вместо DOCUMENTCLASS,
        // поэтому если DOCUMENTCLASS отсутствует, ищем DOCUMENTCLASS_ID
        SourceClass := VarToStr(LineRow.getAttribute('DOCUMENTCLASS'));
        if ( LENGTH( SourceClass) <= 0)
          then SourceClass := VarToStr(LineRow.getAttribute('DOCUMENTCLASS_ID'));
        PlanClass := GetPlanClass(SourceClass);

        {отладка}
        //writeLog( FORMAT( 'Переменная SourceClass = "%s".', [ SourceClass]));
        //writeLog( FORMAT( 'Переменная PlanClass = "%s".', [ PlanClass]));

        if Not IsAgree(StrToInt(PlanClass)) then
          continue;

        // проверка существования импортируемого документа в базе по FOREIGN_KEY
        if ExistDocument(LineRow, 'LN_PAYDOC', PlanClass) <> '-1' then
          Continue;

        // Формируем XML с добавляемой записью (NewRec)
        NewRec := Owner.ownerDocument.createElement('DOCUMENT');
        NewRec.setAttribute('action', 'insert');
        NewRec.setAttribute('BUDGET_ID', Budget_ID);
        CopyElementAttributes(LineRow, NewRec);
        NewRec.setAttribute('class', PlanClass);
        NewRec.setAttribute('FOREIGN_KEY', VarToStr(NewRec.getAttribute('ID')));
        NewRec.removeAttribute('ID');
        NewRec.setAttribute('LOANDOC_ID', SaveDocID);

        // exchange #2753
        // удаляем тег DOCUMENT_ID если он приходит из планирования
        if (PlanClass = '153') then begin
          if (LENGTH( VarToStr( NewRec.GetAttribute( 'DOCUMENT_ID'))) > 0)
            then NewRec.removeAttribute( 'DOCUMENT_ID');
        end;

        xNewPlanDoc := SaveDocument(NewRec);

        // exchange #2753
        // при импорте плана по ценным бумагам доводим его до 10го статуса
        // иначе эд ценные бумаги не будет доведен до 10го статуса
        if (PlanClass = '153') then
          try
            xDocId := xNewPlanDoc.getAttribute('ID');
            NewRec.setAttribute('ID', xDocId);
            NewRec.setAttribute('action', 'process');
            NewRec.setAttribute('FROM', 'AZK_Exchange');
            ExecXML( NewRec.xml);
            WriteLog( 'ЭД "План по выполнению обязательств по ценным бумагам" переведен на статус "Обработка завершена".');
            except
              WriteInfo( FORMAT( 'Ошибка перевода ЭД "План по выполнению обязательств по ценным бумагам" на статус "Обработка завершена": %s',
                                [ LastException.Message]));
          end;
      end
    end;
    except
      raise( 'Сбой MakePlan: ' + LastException.Message);
  end;
end;

procedure CopyElementAttributes(SourceElement, TargetElement: Variant);
var
  I: Integer;
begin
  for I := 0 to SourceElement.attributes.length - 1 do
    TargetElement.setAttribute(SourceElement.attributes[I].nodeName,
      Trim(SourceElement.attributes[I].nodeValue));
end;

function DocInfo(Doc: Variant):String;
begin
  Result := 'Документ  - Дата: ' + FormatDateTime('dd.mm.yyyy',
    XmlToDateTime(Doc.getAttribute('DOC_DATE'))) +
    ' Номер:' + Trim(Doc.getAttribute('DOC_NUMBER')) + #13 + #10;
end; {End DocInfo}

var
  Xml: Variant;

begin
  FAzkIsLogin := AzkIsLogin;
  FDebuger := True;
  Xml := CreateOleObject('Microsoft.XmlDom');
  if not FileExists('C:\Temp\LoanDocImport.Xml') then
  begin
    ShowMessage('Не найден тестовый пример: C:\Temp\LoanDocImport.Xml');
    Exit;
  end;
  if not Xml.Load('C:\Temp\LoanDocImport.Xml') then
  begin
    ShowMessage('Ошибка при загрузке: C:\Temp\LoanDocImport.Xml');
    Exit;
  end;
  if not AzkIsLogin then
    if not AzkLogin then
      Exit;
  try
    Main(Xml);
  finally
    if not FAzkIsLogin then
      AzkLogout;
  end;
end. {End Start}
