uses
  'UfebsMakeFileName',
  'UfebsConst',
  'WorkUfebsVersion.inc',
  'WorkAppVersion.inc',
  'UfebsVersionInc.inc',
  'Un_Debug';
var
  Form: TForm;
  ButtonExecute, ButtonExit: TButton;
  DateED, edtInquiryDate: TDateTimeEh;
  RadioGroupEDType, RadioGroupPeriod: TRadioGroup;
  PropStorageEh: TPropStorageEh;
  InputXml: Variant;

procedure Main(Xml: Variant);
begin
  if CompareVersionEx(AppVersion, WorkAppVersion) < 0 then
    raise('Скрипты работают с AzkEchange.Exe начиная с версии: ' + WorkAppVersion +
      ''#13#10'Текущая версия AzkEchange.Exe: ' + AppVersion);
  InputXml := Xml;
  with Xml.documentElement do
  if getAttribute('TESTED') = 'True' then
  begin
    setAttribute('TESTED', 'False');
    Xml.save('C:\UfebsED220.Xml');
    ShowMessage('Тестовый пример приготовлен: C:\UfebsED220.Xml');
    Exit;
  end;
  try
    Form := TForm.Create(Application);
    LoadForm(ExtractFilePath(Xml.documentElement.getAttribute('INI_FILE')) +
      'Form\Fm_UfebsED220.dfm', Form);
    ButtonExecute := TButton(Form.FindComponent('ButtonExecute'));
    ButtonExecute.OnClick := @OnButtonExecuteClick;
    ButtonExit := TButton(Form.FindComponent('ButtonExit'));
    ButtonExit.OnClick := @OnButtonExitClick;
    DateED := TDateTimeEh(Form.FindComponent('DateED'));
    edtInquiryDate := TDateTimeEh(Form.FindComponent('edtInquiryDate'));
    DateED.Date := Now;
    edtInquiryDate.Date := Now;
    RadioGroupEDType := TRadioGroup(Form.FindComponent('RadioGroupEDType'));
    RadioGroupPeriod := TRadioGroup(Form.FindComponent('RadioGroupPeriod'));
    PropStorageEh := TPropStorageEh(Form.FindComponent('PropStorageEh'));
    PropStorageEh.LoadProperties;
    try
      Form.ShowModal;
    except
      WriteLog(LastException.Message);
      raise(LastException.Message);
    end;
  finally
    Form.Free;
    Ufebs.VCERTUnInitialize;
  end;
end; {End Main}

procedure OnButtonExecuteClick(Sender: TObject);
var
  FEDNo: Integer;
begin
  try
    Initialize(InputXml);

    if ((Ufebs.SignType in [stED, stPacket]) or FSigEnvelope) then
    begin
      WriteLog('Инициализация "СКАД Сигнатура"');
      Ufebs.VCERTInitialize;
    end;

    FEDNo := 300000 + StrToInt(FormatDateTime('hhmmss', Now));
    FEDDate := DateED.Date;
    Ufebs := CreateOleObject('Ufebs.ED220');
    Ufebs.EDNo := FEDNo;
    Ufebs.EDDate := FEDDate;
    Ufebs.EDAuthor := FEDAuthor;
    Ufebs.EDTypeCode := RadioGroupEDType.ItemIndex + 1;
    Ufebs.InquiryPeriodCode := RadioGroupPeriod.ItemIndex + 1;
    if edtInquiryDate.Date <> FEDDate then
      Ufebs.InquiryDate := edtInquiryDate.Date;

    WriteLog('<ЭД/Пакет ЭД> - Формирование');
    Ufebs.makeXML;

    MakeFileName(InputXml);

    Ufebs.formatXML;

    if Ufebs.SignType in [stED, stPacket] then
    begin
      WriteLog('<ЭД/Пакет ЭД> - Установка ЭЦП(ЗК)');
      Ufebs.Sign;
    end;

    if FFormatXML then
    begin
      WriteLog('<ЭД/Пакет ЭД> - Форматирование');
      Ufebs.FormatXML;
    end;

    WriteLog('<ЭД/Пакет ЭД> - Контроль валидности');
    if not Ufebs.Validate then
      with Ufebs.ValidateError do
        raise('<ЭД/Пакет ЭД>  - Не прошёл контроль валидности' + #13#10 +
          'Причина: ' + reason + #13#10 + 'XML: ' + srcText);

    if FSigEnvelope then
    begin
      FileArh := DirArh + FormatDateTime('yyyy-mm-dd', FEDDate) + '\Out\Xml\' +
        ExtractFilename(FileOut) + '.xml';
      ForceDirectories(ExtractFilePath(FileArh));
      if DirectoryExists(ExtractFilePath(FileArh)) then
        Ufebs.SaveToFile(FileArh);

      WriteLog('<Конверт ЭЦП(КА)> - Создание');
      Ufebs := Ufebs.makeSigEnvelope;
      WriteLog('<Конверт ЭЦП(КА)> - Формирование');
      Ufebs.makeXML;
      WriteLog('<Конверт ЭЦП(КА)> - Установка ЭЦП(КА)');
      Ufebs.Sign;
      if FFormatXML then
      begin
        WriteLog('<Конверт ЭЦП(КА)> - Форматирование');
        Ufebs.FormatXML;
      end;
      WriteLog('<Конверт ЭЦП(КА)> - Контроль валидности');
      if not Ufebs.Validate then
        with Ufebs.ValidateError do
          raise('<Конверт ЭЦП(КА)> - Не прошёл контроль валидности' + #13#10 +
            'Причина: ' + reason + #13#10 + 'XML: ' + srcText);
    end;

    if FEnvelope then
    begin
      WriteLog('<Служебный конверт> - Создание');
      Ufebs := Ufebs.makeEnvelope;
      WriteLog('<Служебный конверт> - Формирование');
      Ufebs.MessageInfo.SendTo := FTo;
      Ufebs.MessageInfo.SendFrom := FFrom;
      Ufebs.MessageInfo.MessageType := FMessageType;
      Ufebs.MessageInfo.Priority := FPriority;
      
      //DocInfo
      Ufebs.DocInfo.DocFormat := 1; //Всегда 1 - УФЭБС
      Ufebs.DocInfo.EDRefID.EDNo := FEDNo;
      Ufebs.DocInfo.EDRefID.EDDate := FEDDate;
      Ufebs.DocInfo.EDRefID.EDAuthor := FEDAuthor;
      
      if FTransportFileName then
        Ufebs.MessageInfo.LegacyTransportFileName := ExtractFileName(FileOut);

      if FMessageID then Ufebs.MessageInfo.MessageID := 'guid:' + Ufebs.genGuid;
      if FAppMessageID then Ufebs.MessageInfo.AppMessageID := 'guid:' + Ufebs.genGuid;

      Ufebs.makeXML;
      if FFormatXML then
      begin
        WriteLog('<Служебный конверт> - Форматирование');
        Ufebs.FormatXML;
      end;
      WriteLog('<Служебный конверт> - Контроль валидности');
      if not Ufebs.Validate then
        with Ufebs.ValidateError do
          raise('<Служебный конверт> - Не прошёл контроль валидности' + #13#10 +
            'Причина: ' + reason + #13#10 + 'XML: ' + srcText);
    end;

    try
      WriteLog('Сохранение в исходящем каталоге: ' + FileOut);
      Ufebs.SaveToFile(FileOut);
      if not FileExists(FileOut) then raise('');
    except
      raise('Ошибка сохранения: ' + FileOut);
    end;
    FileArh := DirArh + FormatDateTime('yyyy-mm-dd', FEDDate) + '\Out\' + ExtractFileName(FileOut);;
    ForceDirectories(ExtractFilePath(FileArh));
    WriteLog('Копирование в архивный каталог: ' + FileArh);
    if not DirectoryExists(ExtractFilePath(FileArh)) then
      MessageDlg('Ошибка создания архивного каталога: ' + ExtractFilePath(FileArh), mtWarning , mbCancel , 0)
    else
      CopyFile(FileOut, FileArh, False);
    if not FileExists(FileArh) then
      MessageDlg('Ошибка сохранения: ' + FileArh, mtWarning , mbCancel , 0);
    MessageDlg('Запрос на получение ответного документооборота сформирован: ' + FileOut, mtInformation, mbOk, 0);
    WriteLog('===   ЗАВЕРШЕНИЕ ЗАПРОСА НА ПОЛУЧЕНИЕ ОТВЕТНОГО ДОКУМЕНТООБОРОТА   ===');
  except
      WriteLog(LastException.Message);
      raise(LastException.Message);
  end;
end; {End OnButtonExecuteClick}

procedure OnButtonExitClick(Sender: TObject);
begin
  Form.Close;
end; {End OnButtonExitClick}

procedure Initialize(Xml: Variant);
var
  i: Integer;
  Nodes: Variant;
begin
  try
    Ufebs := CreateOleObject('Ufebs.ED220');
  except
    raise('Ошибка инициализации обьекта из библиотеки УФЭБС.' +
      ''#13#10'Зарегистрируйте библиотеку: regsvr32.exe Ufebs.ocx');
  end;
  if CompareVersionEx(Ufebs.Version, WorkUfebsVersion) < 0 then
    raise('Скрипты работают с Ufebs.ocx начиная с версии: ' +
      WorkUfebsVersion + ''#13#10'Текущая версия Ufebs.ocx: ' + Ufebs.Version);
  with Xml.documentElement, TStringList.Create do
  try
    FileLog := ExtractFilePath(getAttribute('INI_FILE')) + 'UfebsUnLoad.Log';
    FileInfo := ExtractFilePath(getAttribute('INI_FILE')) + 'UfebsInfo.Log';
    WriteLog('===   НАЧАЛО НА ПОЛУЧЕНИЕ ЗАПРОСА ОТВЕТНОГО ДОКУМЕНТООБОРОТА   ===');
    WriteLog('Версия сборки импорта/экспорта формата УФЭБС: ' + UfebsVersion);
    WriteLog('Инициализация параметров конфигурации');

    with CreateOleObject('Microsoft.XmlDom') do
    begin
      if not Load(ExtractFilePath(FileLog) + 'UfebsUnload.cfg') then
        raise('Ошибка при зачитывании файла конфигурации выгрузки');
      Nodes := documentElement.childNodes;
    end;

    for i := 0 to Nodes.length - 1 do
      Add(Nodes.item[i].attributes.getNamedItem('name').nodeValue +
        '=' + Nodes.item[i].attributes.getNamedItem('value').nodeValue);

    FModuleFileName := ExtractFilePath(getAttribute('INI_FILE')) + 'UfebsFileName.pfe';
    FFunctionFileName := Trim(Values['Правило формирование имени файла']);

    DirOut := Trim(Values['Исходящий каталог']);
    if DirOut = '' then DirOut := 'Output';
    DirOut := StringReplace(DirOut + '\', '\\', '\');
    if ExtractFileDrive(DirOut) = '' then
      DirOut := ExtractFilePath(getAttribute('INI_FILE')) + DirOut;
    ForceDirectories(DirOut);
    if not DirectoryExists(DirOut) then
      raise('Ошибка при определении исходящего каталога: ' + DirOut);
    DirArh := Trim(Values['Архивный каталог']);
    if DirArh = '' then DirArh := 'Arhiv';
    DirArh := StringReplace(DirArh + '\', '\\', '\');
    if ExtractFileDrive(DirArh) = '' then
      DirArh := ExtractFilePath(getAttribute('INI_FILE')) + DirArh;
    ForceDirectories(DirArh);
    if not DirectoryExists(DirArh) then
      raise('Ошибка при определении архивного каталога: ' + DirArh);

    Ufebs.FormatVer := Trim(Values['Версия формата']);

    Ufebs.DirSchems := ExtractFilePath(getAttribute('INI_FILE')) +
      'UfebsSchems\' + Ufebs.FormatVer;

    if Trim(Values['Устанавливать ЭЦП(ЗК)']) = 'Не устанавливать' then
      Ufebs.SignType := stNone
    else if Trim(Values['Устанавливать ЭЦП(ЗК)']) = 'На каждый ЭД в пакете' then
      Ufebs.SignType := stED
    else if Trim(Values['Устанавливать ЭЦП(ЗК)']) = 'На весь пакет' then
      Ufebs.SignType := stPacket;

    FSigEnvelope := Trim(Values['Формировать конверт ЭЦП(КА)']) = 'Да';

    FEnvelope := (Trim(Values['Формировать служебный конверт']) = 'Да') And FSigEnvelope;

    Ufebs.EnvelopeCrypted := Trim(Values['Шифровать Object']) = 'Да';
    Ufebs.OIDEncrypt := Trim(Values['OID ключа адресата шифрования']);
    Ufebs.EnvelopeCompessed := Trim(Values['Упаковывать Object']) = 'Да';

    FEDAuthor := Trim(Values['Идентификатор составителя']);
    FTo := Trim(Values['Адрес получателя']);
    FFrom := Trim(Values['Адрес отправителя']);
    FSystemCode := Trim(Values['Признак системы обработки']);
    FMessageType := Trim(Values['Тип сообщения']);
    FPriority := Trim(Values['Приоритет сообщения']);
    FAppMessageID := Trim(Values['Прикладной идентификатор']) = 'Да';
    FMessageID := Trim(Values['Идентификатор сообщения']) = 'Да';
    FTransportFileName := Trim(Values['Передавать имя файла']) = 'Да';

    FFormatXML := Trim(Values['Форматировать XML']) = 'Да';

    Ufebs.NSType[nstEd] := Trim(Values['urn:cbr-ru:ed:v1.1']);
    Ufebs.NSType[nstDsig] := Trim(Values['urn:cbr-ru:dsig:v1.1']);
    Ufebs.NSType[nstDsigEnv] := Trim(Values['urn:cbr-ru:dsig:env:v1.1']);
    Ufebs.NSType[nstSoap] := Trim(Values['http://www.w3.org/2003/05/soap-envelope']);
    Ufebs.NSType[nstMsg] := Trim(Values['urn:cbr-ru:msg:props:v1.1']);

    if ((Ufebs.SignType in [stED, stPacket]) or FSigEnvelope) then
      Ufebs.VCERTLocalPath := Trim(Values['Каталог справочников ЭЦП']);

    // exchange #3032
    // совместима только с версией УФЭБС OCX не ниже 2.2.0.0.0
    // exchange #3041
    // версия шифрования не нужна в 2.38, поэтому из конфига параметр будет
    // удален, а код в скрипте останется только в режиме отладки.
    // exchange #3107
    // требуется реализовать в 2.38 и 2.38.2
    case TRIM(Values['Режим шифрования']) of
      'PKCS7':  Ufebs.EncryptParam := 1;
      else      Ufebs.EncryptParam := 0;
    end;//case//

  finally
    Free;
  end;
end; {Initialize}

procedure WriteLog(Msg: String);
begin
  if FileLog <> '' then
    WriteLogFile(FileLog, Msg);
end; {End WriteLog}

begin
  Xml := CreateOleObject('Microsoft.XmlDom');
  if not FileExists('C:\UfebsED220.Xml') then
  begin
    ShowMessage('Не найден тестовый пример: C:\UfebsED220.Xml');
    Exit;
  end;
  if not Xml.Load('C:\UfebsED220.Xml') then
  begin
    ShowMessage('Ошибка при загрузке: C:\UfebsED220.Xml');
    Exit;
  end;
  Main(Xml);
end.