{не удалять эту строку
uses
  'Un_System',
  'Un_Log',
  'Un_Debug';
{не удалять эту строку}


{~StrIsEmpty
  возвращает =true, если строка aStr пустая и =false в противном случае.}
function StrIsEmpty(aStr: string): boolean;
begin

    try
      Result := (LENGTH( aStr) <= 0);
      except
        ExceptionProc( 'StrIsEmpty');
    end;

end;


{~DDdMMdYYYY_To_YYYYmMMmDD
  преобразование строки даты xStr из "ДД.ММ.ГГГГ" в строку "ГГГГ-ММ-ДД".}
function DDdMMdYYYY_To_YYYYmMMmDD( aDateTimeStr: string): string;
begin

    try
      if (aDateTimeStr = '')
        then Result := ''
        else Result := DateTimeToXml( StrToDate( aDateTimeStr));
      except
        ExceptionProc( 'DDdMMdYYYY_To_YYYYmMMmDD');
    end;

end;

(*
{~DDdMMdYYYY_To_YYYYmMMmDD_Str
  преобразование строки даты xStr из "ДД.ММ.ГГГГ" в строку "ГГГГ-ММ-ДД".
  преобразование выполняется только над строками - перестановка символов
  в строке, без преобразование к дате }
function DDdMMdYYYY_To_YYYYmMMmDD_Str( aDateTimeStr: string): string;
begin

    try
      if (LENGTH( aDateTimeStr) < 10)
        then Result := ''
        else Result := COPY( aDateTimeStr, 7, 4) + '-'
                        + COPY( aDateTimeStr, 4, 2) + '-'
                        + COPY( aDateTimeStr, 1, 2);

      except
        ExceptionLog( 'Сбой Un_Tools.DDdMMdYYYY_To_YYYYmMMmDD_Str');
    end;

end;
*)

{~DateTime_To_DDdMMdYYYY
  формирование указанной даты в строку: "ДД.ММ.ГГГГ" }
function DateTime_To_DDdMMdYYYY( aDateTime: TDateTime): string;
begin
  try
    Result := FormatDateTime('dd.mm.yyyy', aDateTime);
    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.DateTime_To_DDdMMdYYYY.');
  end;
end;

{~DateTimeXmlFromXml
  преобразование даты из поля aDateTimeXml (например, из поля даты документа)
  в формат для заполнения даты для серверной xml.
  если aDateTimeXml пустая строка, то и результат будет пустой строкой.}
function DateTimeXmlFromXml( aDateTimeXml: string): string;
begin

    try
      if (LENGTH( aDateTimeXml) <= 0)
        then Result := ''
        else Result := DateTime_To_DDdMMdYYYY( XmlToDateTime( aDateTimeXml));

      except
        ExceptionLog( 'Сбой Un_Tools.DateTimeXmlFromXml');
    end;

end;


{~Now_To_DDdMMdYYYY
  формирование текущей даты в строку: "ДД.ММ.ГГГГ" }
function Now_To_DDdMMdYYYY: string;
begin
  try
    Result := DateTime_To_DDdMMdYYYY( NOW);
    except
      ExceptionLog( 'Сбой скрипта: "Un_ToolsXml.Now_To_DDdMMdYYYY.');
  end;
end;


{~DateTimeToStr_YYYYMMDD_HHMMSS
  преобразует дату время в строку в формате: yyyy/mm/dd hh:nn:ss}
function DateTimeToStr_YYYYMMDD_HHMMSS( aDate: TDateTime): string;
begin
  Result := FormatDateTime( 'yyyy/mm/dd hh:nn:ss', aDate);
end;


{~YYYYMMDD_to_DDMMYYYY
  преобразует строку YYYY-MM-DD в строку DD.MM.YYYY}
function YYYYmMMmDD_to_DDdMMdYYYY( aStr: string): string;
begin

  try
    Result := COPY( aStr, 9, 2) + '.'
              + COPY( aStr, 6, 2) + '.'
              + COPY( aStr, 1, 4);

    except
      ExceptionLog( 'Сбой Un_Tools.YYYYmMMmDD_to_DDdMMdYYYY');
  end;

end;


{~DeleteLeftNonsignificantZero
  удаление незначащих нулей слева в строке.
  если все нули в строке - остается только один.}
function DeleteLeftNonsignificantZero( aValue: string): string;
begin

    try
      Result := aValue;
      while (LENGTH( Result) > 1) do
        if ( Result[1] = '0')
          then Delete( Result, 1,1)
          else BREAK;

      except
        ExceptionLog( 'Сбой Un_Tools.DeleteLeftNonsignificantZero');
    end;

end;


{~DateTimeFromStr_YYYYMMDD_HHMMSS
  преобразование строки вида: yyyy.mm.dd hh:mm:ss в дату.
  при этом разделители - все равно какие: "." или "/" или ":".
  между подстроками датой и временем должен быть один символ (все равно какой)}
function DateTimeFromStr_YYYYMMDD_HHMMSS( aStr: String): TDateTime;
begin
  
  try
    
    Result := EncodeDateTime(
                  STRTOINT( COPY( aStr, 1, 4)),
                  STRTOINT( COPY( aStr, 6, 2)),
                  STRTOINT( COPY( aStr, 9, 2)),
                  STRTOINT( COPY( aStr,12, 2)),
                  STRTOINT( COPY( aStr,15, 2)),
                  STRTOINT( COPY( aStr,18, 2)),
                  0);

    except
      ExceptionLog( 'Сбой скрипта: "Un_Tools.DateTimeFromStr_YYYYMMDD_HHMMSS.');
  end;
end;

{~SplitStringFIO_ToParts
  делит строку ФИО на фамилию, имя, отчество.
  строка вида:
    фамилия[ имя[ отчество]]
  или
    фамилия[ имя[.отчество[.]]]}
procedure SplitStringFIO_ToParts( aFIO: string; var aF,aN,aO: string);
var
  xPos: integer;
  s: string;
begin
  try
    
    try
      
      s  := aFIO;
      aF := '';
      aN := '';
      aO := '';
      // ищем первй разделитель - пробел
      xPos := POS(' ', s);
      if (xPos <= 0) then begin
        aF := TRIM( s);
        EXIT;
      end;
      // если есть - строка до пробела - фамилия
      aF := TRIM( COPY( s, 1, xPos - 1));
      DELETE(s, 1, xPos);
      s := TRIM( s);
      // ищем разделитель: пробел или точку
      xPos := POS(' ', s);
      if (xPos <= 0) then xPos := POS('.', s);
      if (xPos <= 0) then begin
        // если ничего нет - принимаем оставшуюся строку как имя
        aN := TRIM( s);
        EXIT;
      end;
      // если есть, то слева до разделителя имя
      aN := StringReplace( TRIM( COPY( s, 1, xPos - 1)), '.', '');
      DELETE(s, 1, xPos);
      // оставшаяся строка - отчетсво.
      // удаляем лишние пробелы и удаляем точки.
      aO := TRIM( StringReplace( TRIM( s), '.', ''));
      except
        ExceptionLog( 'Сбой Un_Tools.SplitStringFIO_ToParts');
    end;
    finally
      if NOT vLogException then begin
        
        
        
      end;
      
  end;
end;


{~FormatStrAsNumberP2
  форматирование исходной строки aStrNumber, которая представлена в виде
  числа (с разделителем ".") в виде строки nnn.nn
  это дает то, что исходная строка может быть без дробных чисел, а конечная
  обязательно указывается с копейками.}
function FormatStrAsNumberP2( aStrNumber: string): string;
begin
  try
    
    try
      
      Result := FORMAT( '%0.2f', [ StrToCurr( aStrNumber)]);
      
      except
        ExceptionLog( 'Сбой Un_Tools.FormatStrAsNumberP2');
    end;
    finally
      
  end;
end;


{~AppendStringLeft
  дозаполнение строки aStr до длины aLength слева, подстрокой aSubStr.}
function AppendStringLeft( aStr: string; aLength: integer; aSubStr: string): string;
begin
  try
    
    try
      Result := aStr;
      
      while (LENGTH( Result) < aLength) do Result := aSubStr + Result;
      // отсекаем лишнее слева
      if (LENGTH( Result) > aLength)
        then DELETE( Result, 1, LENGTH( Result) - aLength);
      
      except
        ExceptionLog( 'Сбой Un_Tools.AppendStringLeft');
    end;
    finally
      
  end;
end;


{~BooleanAsString
  макрос возвращает строковое значпредставление булевого значения aValue в
  виде TRUE или FALSE. }
function BooleanAsString( aValue: boolean): string;
begin
  if aValue then Result := 'TRUE' else Result := 'FALSE';
end;


{~StringQuoteS
  макрос, возвращающий строку aValue в одинарных кавычках (по стилю pascal).
  символ ' не проверяется!}
function StringQuoteS( aValue: string): string;
begin
  Result := #39 + aValue + #39;
end;


{~SLValueExists
  макрос, который проверяет наличие параметра aParamName в списке строк aSL.
  результат:
    =true, такой параметр присутствует в списке.}
function SLValueExists( aSL: TStringList; aParamName: string): boolean;
begin
  Result := (aSL.IndexOfName( aParamName) <> -1);
end;


{~SLValueTo
  макрос, который проверяет наличие параметра aParamName в списке строк aSL.
  если такого параметра нет, в результат aTo записывается aDefault.
  если параметр aParamName есть в списке aSL, то в aTo записывается
  значение параметра.
  результат:
    =true, такой параметр присутствует в списке.}
function SLValueTo( aSL: TStringList;
                    aParamName: string;
                    var aTo: string;
                    aDefault: string = ''): boolean;
begin
  Result := (aSL.IndexOfName( aParamName) <> -1);
  if Result
    then aTo := aSL.Values[ aParamName]
    else aTo :=  aDefault;
end;



{~ScanFiles
  выполняет сканирование каталога aDir (рекурсивно, если aRecurse=TRUE),
  и выбирает файлы по маске aFilter в каждом каталоге.
  результат складывается в виде списка файлов, с полным путем, в aTo.
  параметры
    aDir - базовый каталог. символ слеша в конце строки обязателен!
    aFilter - маска выборки файлов. этот параметр не влияет на выборку
              подкаталогов при рекурсивном обходе.
    aRecurse - =true - обход с учетом подкаталогов.
               =false - список файлов только в каталоге aDir.
    aRelativeDir - =true - в списке к именам файлов добавляются только
                            пути относительно базового каталога.
                  =false - в списке файлы сохраняются с полным путем.
    aLowRegistry - =true - преобразование строк файлов в нижний регистр.
                   =false - имена файлов и каталогов остаются как описаны в системе.}
procedure ScanFiles( aDir, aFilter: string;
                     aTo: TStringList;
                     aRecurse: boolean = FALSE;
                     aRelativeDir: boolean = FALSE;
                     aLowRegistry: boolean = FALSE);

  procedure ScanFiles_( aSubDir, aRelDir: string);
  var
    xFileSearch: TFileSearch;
    xFileName: string;
  begin
  
      try
        xFileSearch := TFileSearch.Create;
        try
          // в начале обходим все каталоги
          if aRecurse then
            if xFileSearch.FindFirst(aSubDir + '*.*', faAnyFile) = 0 then
              try
                repeat
                  if (xFileSearch.Name <> '.') and (xFileSearch.Name <> '..') then
                    if ((xFileSearch.Attr AND faDirectory) <> 0)
                      then ScanFiles_( aSubDir + xFileSearch.Name + '\',
                                       aRelDir + xFileSearch.Name + '\');
                until xFileSearch.FindNext <> 0;
                finally
                  xFileSearch.FindClose;
              end;

          // выбираем файлы
          if xFileSearch.FindFirst(aSubDir + aFilter, faAnyFile) = 0 then
            try
              repeat
                if ((xFileSearch.Name <> '.') and (xFileSearch.Name <> '..') and
                    ((xFileSearch.Attr AND faDirectory) = 0)) then begin
                  // сохраняем либо полный путь, либо относительно базового каталога
                  if aRelativeDir
                    then xFileName := aRelDir + xFileSearch.Name
                    else xFileName := aSubDir + xFileSearch.Name;
                  // преобразование строки имени файла к нижнему регистру
                  // вместе с путем
                  if aLowRegistry
                    then xFileName := LOWERCASE( xFileName);
    
                  aTo.Add( xFileName);
                end;
              until xFileSearch.FindNext <> 0;
              finally
                xFileSearch.FindClose;
            end;
          finally
            xFileSearch.Free;
        end;
        except
          ExceptionLog( 'Сбой Un_Tools.ScanFiles.ScanFiles_');
      end;
  
  end;

begin

    try
      ScanFiles_( aDir, '');

      except
        ExceptionLog( 'Сбой Un_Tools.ScanFiles');
    end;

end;


{~CopyFileToArvchive
  копирование файла (с полным путем) aFullFileName в каталог aDirTo.
  файл копируется с перезаписью уже существующего файла в каталоге aDirTo.
  при этом проверяется:
   1) наличие исходного файла;
   2) результат копирования.
  в случае невыполнения этих условий возбуждается исключение.
  параметр:
    aMove =true - после копирования, исходный файл будет удален.
    aDirTo - каталог, куда должен быть скопирован файл.
             обязателен символ "\" в конце строки!}
procedure CopyFileToArvchive( aFullFileName, aDirTo: string;
                              aMove: boolean = TRUE;
                              aCaption: string = 'архив');
var
  xFileNameTo: string;
begin

    try
      // проверяем наличие исходного файла
      if NOT FileExists( aFullFileName) then begin
        
        EXIT;
      end;
      // exchange #2797
      // если каталог архива может не указываться,
      // тогда копировать файл не нужно, а нужно только удалить исходный файл.
      if (LENGTH( TRIM( aDirTo)) > 0) then begin
        xFileNameTo := aDirTo + ExtractFileName( aFullFileName);

        // добавлена проверка, что если архивный каталог указан как и
        // каталог исходных файлов, т.е. копирование будет в тот же самый файл,
        // то копирование тоже не выполняем.
        if (UPPERCASE( TRIM( aFullFileName)) <> UPPERCASE( TRIM( xFileNameTo)))
          then begin

            // копируем файл с пересозданием файла
            CopyFile( aFullFileName, xFileNameTo, True);
            // проверяем наличие скопированного файла
            if NOT FileExists( xFileNameTo)
              then raise( 'Не удалось скопировать файл.');
          end else begin

            WriteLog( FORMAT( 'Исходный файл %s не будет перемещен в %s, '
                             +'расположенный в каталоге исходных файлов.',
                              [ aFullFileName,
                                aCaption]));
          end;
      end;
      // если указана опция удаления исходного файла после копирования,
      // удаляем исходный файл
      if aMove then begin

        DeleteFile( aFullFileName);
      end;
      except
        ExceptionLog( 'Сбой Un_Tools.CopyFileToArvchive');
    end;

end;


{~SaveToIni
  сохранение параметра в файле Send.Dat }
procedure SaveToIni( aFileNameIni, aSection, aParam, aValue: string);
begin
  
  try
    
    with TIniFile.Create( aFileNameIni) do
      try
        WriteString( aSection, aParam, aValue);
        finally
          Free;
      end;
    
    except
      ExceptionLog( 'Сбой скрипта: "Un_Tools.SaveToIni.');
  end;
end;

{~LoadFromIni
  загружает параметр зи Ini файла.
  aFileNameIni - имя файла;
  aSection - секция
  aParam - название параметра;
  aDefault - значение по умолчанию, если такого параметра в секции нет.
~return~
  строка параметра из ini файла или значение по умолчанию.}
function LoadFromIni( aFileNameIni, aSection, aParam: string; aDefault: string = ''): string;
begin
  
  try
    
    if NOT FileExists( aFileNameIni)
      then
        begin
          
          Result := aDefault;
        end
      else
        with TIniFile.Create( aFileNameIni) do
          try
            Result := ReadString( aSection, aParam, aDefault);
            finally
              Free;
          end;
    
    
    except
      ExceptionLog( 'Сбой скрипта: "Un_Tools.LoadFromIni".');
  end;
end;


{~AddToVarArray
  добавление значения aValue в массив вариантов aVarArray (в хвост массива)
  с повторением добавления значения aCount раз. }
function AddToVarArray( var aVarArray: Variant; aValue: Variant; aCount: integer = 1): integer;
var
  i: integer;
begin
  try
    
    

    if VarIsNull( aVarArray)
      then begin
        
        Result := 0;
        aVarArray := VarArrayCreate([0,aCount - 1], varVariant);
      end else begin
        
        Result := Length( aVarArray);
        SetLength(aVarArray, Length( aVarArray) + aCount);
      end;
    aVarArray[ Result] := aValue;
    {
    for i := 1 to aCount do begin
      aVarArray[ Result] := aValue;
      INC( Result);
    end;//for//
    }
    
    except
      ExceptionLog( 'Сбой скрипта: "Un_Tools.AddToVarArray".');
  end;
end;


{~VarArrayUnion
  добавление значение варианта массива aVarArrayFrom к варианту массиву
  aVarArrayTo (копированием элементов) }
procedure VarArrayUnion( var aVarArrayTo, aVarArrayFrom: Variant);
var
  i: integer;
  v: Variant;
begin
  try
    
    try
      if NOT VarIsNull( aVarArrayTo) then
        if NOT VarIsArray( aVarArrayTo) then begin
          
          EXIT;
        end;
      
      if VarIsNull( aVarArrayFrom) then begin
        // значение параметра aVarArrayFrom = NULL
        AddToVarArray( aVarArrayTo, aVarArrayFrom);
        EXIT;
      end;

      if NOT VarIsArray( aVarArrayFrom) then begin
        
        AddToVarArray( aVarArrayTo, aVarArrayFrom);
        EXIT;
      end;
    
      for i := 0 to LENGTH( aVarArrayFrom) - 1 do begin
        v := aVarArrayFrom[i];
        AddToVarArray( aVarArrayTo, v);
      end;//for//
      except
        ExceptionLog( 'Сбой скрипта: "Un_Tools.VarArrayUnion".');
    end;
    finally
      
  end;
end;

{~VarArrayToString
  преобразует aVarArray в текстовую строку.
~return~
  если aVarArray =NULL возвращается NULL.
  если aVarArray единственное значение - возвращается строковое представление
    варианта;
  если aVarArray массив - возвращается список строковых значений всех элементов
    массив.
  допускаются вложенные массивы.
  параметр aShift - префикс слева перед каждой строкой результата.

  пример отображения:
    M: array[0..2]
  результат VarArrayToString( M):
    массив(3)
      [0]="значение"
      [1]="значение"
      [2]=массив(2)
        [0]="значение"
        [1]="значение"

  эта функция используется в отладочных сообщениях, поэтому рекомендуется
  блокировать строки запуска и завершения подпрограммы.
  оставлять этот код допускается в случае поиска сбоя описания
  значений variant в этой подпрограмме.}
function VarArrayToString( aVarArray: Variant; aShift: string = ''): string;
var
  i: integer;
begin

    try
      Result := '';
      if VarIsNull( aVarArray)
        then Result := aShift + 'Значение=NULL'
        else
      if NOT VarIsArray( aVarArray)
        then Result := aShift + FORMAT( 'Значение="%s"', [ VarToStr( aVarArray)])
        else begin
          Result := aShift + FORMAT( 'Массив (%d):', [ LENGTH( aVarArray)]);
          for i := 0 to LENGTH( aVarArray) - 1 do begin
            Result := Result + FORMAT( #13#10'%s[%d]=', [ aShift + '   ', i]);
            if VarIsNull( aVarArray[i])
              then Result := Result + 'NULL'
              else
            if VarIsArray( aVarArray[i])
              then Result := Result + VarArrayToString( aVarArray[i],
                                                        aShift + '   ')
              else Result := Result + FORMAT( '"%s"', [ VarToStr( aVarArray[i])]);
          end;//for//
        end;
      except
        ExceptionLog( 'Сбой Un_Tools.VarArrayToString');
    end;

end;





{~CopyFileEx
  копирование/перемещение файла aSource в файл aDestin.
  aDeleteSource:
        =true - после копирования исходный файл будет удален.
        =false (по умолчанию) - после копирования исходный файл будет оставлен.
  результат:
    =true - операция успешная;
    =false - копирование не выполнено. при этом исходный файл не будет удален,
            независимо от параметра aDeleteSource!
}
function CopyFileEx( aSource, aDestin: string;
                     aDeleteSource: boolean = FALSE): boolean;
begin

    try

      if FileExists( aDestin) then begin

        DeleteFile( aDestin);
      end;

      CopyFile(aSource, aDestin, False);
      Result := FileExists( aDestin);

      if NOT Result
        then WriteLog( 'Копирование не выполнено.');

      if Result then
        if aDeleteSource then begin

          DeleteFile( aSource);
        end;
      except
        ExceptionLog( 'Сбой Un_Tools.CopyFileEx');
    end;

end;
{==============================================================================}
{~CopyFiles
  копирование списка файлов из каталога источника в указананный каталог.
  aFiles - список имен файлов (относительно исходного каталога);
  aDirFrom - исходный каталог;
  aDirTo - конечный каталог;
  aMoveTo - перемещение файлов.
            Если значение =FALSE (по умолчанию), исходные файлы не удаляются.
            Если значение =TRUE исходные файлы уделаются (перемещение в
            указанный каталог).
  результат
    количество скопированных файлов.}
function CopyFiles( aFiles: TStringList;
                    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)
          then BREAK;
        INC( Result);
      end;//for//

      except
        ExceptionLog( 'Сбой Un_Tools.CopyFiles');
    end;

end;


{~ValidateDirectoryString
  функция проверяет концевой символ указания каталога "\".
  если там нет завершающего "\" - подставляем его.
  в результате возвращается строка с концевым символом "\".

  если входной каталог не указан, то берется каталог по умолчанию: aDirDefault.

  если в результате, каталог относительный (не содержит символ разделителя
  диска ":"), то в начало строки каталога добавляется подстрока корневого
  каталога из параметра aDirRoot.

  параметры aDirDefault и aDirRoot не проверяются на завершающие символы "\".}
function ValidateDirectoryString( aDir: string;
                                  aDirDefault: string = '';
                                  aDirRoot: string = ''): string;
begin

    try
      Result := TRIM( aDir);
      if ( LENGTH( Result) > 0) then
        if ( Result[ LENGTH( Result)] <> '\')
          then Result := Result + '\';

      if ( LENGTH( Result) <= 0)
        then Result := aDirDefault;

      if (POS(':', Result) <= 0)
        then Result := aDirRoot + Result;

      except
        ExceptionLog( 'Сбой Un_Tools.ValidateDirectoryString');
    end;

end;


{~ValidateDirectory
  проверка (и создание) каталога aDir.

  в случае ошибок или сбоев выполняется запись в журнал ошибок (WriteError)
  с комментарием aComment.
  комментарий пишется так:
    "Не найден (или нет доступа) каталог "+comment+": "каталог" [- ошибка]

  если параметр aForceDir=true (по умолчанию), то будет попытка создания
  каталога (цепочки каталогов).
  если параметр aForceDir=false то будет только проверяться наличие каталогоа.

  если параметр aWriteError=true - то при проверке каталога, будет запись
    в журнале ошибок, если каталог не будет найден. если каталог будет
    найден - в журнал ничего не пишется.
    запись в журнале будет независимо от этого параметра, если параметр
    aForceDir=true.

  результат:
    =true - каталог существует.
    =false - каталог не найден или нет доступа.}
function ValidateDirectory( aDir, aComment: string;
                            aForceDir: boolean = TRUE;
                            aWriteError: boolean = TRUE): boolean;
var xDir: string;
begin

    try
      Result := FALSE;
      xDir := ValidateDirectoryString( TRIM( aDir));
      if (LENGTH( xDir) > 0) then
        try
          if aForceDir then ForceDirectories( xDir);
          if not DirectoryExists( xDir) then begin
            if (aWriteError OR aForceDir)
              then WriteInfo( FORMAT( 'Не найден (или нет доступа) каталог%s: "%s".',
                                        [ xDir,
                                          TRIM( ' ' + aComment)]));
            EXIT;
          end;
          except
            WriteInfo( FORMAT( 'Сбой проверки/создания каталога%s: "%s" - %s.',
                                [ xDir,
                                  TRIM( ' ' + aComment),
                                  LastException.Message]));
            EXIT;
        end;
      Result := TRUE;
      except
        ExceptionLog( 'Сбой Un_Tools.ValidateDirectory');
    end;

end;


{~DeleteFiles
  удаление списка файлов aFiles из указанного каталога aDir.
  при выполнении операции отображается сообщение (в логе) aTextLog.
  список файлов долбен содержать относительные имена файлов, или полные
  имена, тогда каталог можно не указывать.}
procedure DeleteFiles( aDir: string;
                       aFiles: TStringList;
                       aTextLog: string);
var
  i: integer;
begin

    try
      if (aFiles.Count > 0) then begin
        WriteLog( aTextLog, TRUE);
        for i := 0 to aFiles.Count - 1
          do DeleteFile( aDir + aFiles.Strings[i]);
      end;
      except
        ExceptionLog( 'Сбой Un_Tools.DeleteFiles');
    end;

end;

{~DeleteFilesTmp
  удаление временных файлов.
  удаление списка файлов aFiles из указанного каталога aDir.
  при выполнении операции отображается сообщение (в логе) aTextLog.
  список файлов долбен содержать относительные имена файлов, или полные
  имена, тогда каталог можно не указывать.
  фактически это вызов DeleteFiles только с отличием: эта операция может
  быть заблокирована с опцией отладки: "не_удалять_временные_файлы".}
procedure DeleteFilesTmp( aDir: string;
                          aFiles: TStringList;
                          aTextLog: string);
begin

    try

      DeleteFiles( aDir, aFiles, aTextLog);
      except
        ExceptionLog( 'Сбой Un_Tools.DeleteFilesTmp');
    end;

end;



function ExistsValueAndMaskIntoSettings( aValue, aMask: string;
                                         aList: TStringList;
                                         aMode: integer = 1): boolean;
var
  i: integer;
  s: string;
  xPos: integer;
begin

    try
      Result := FALSE;
      case aMode of
        0:for i := 0 to aList.Count - 1 do begin
            s := TRIM( aList.Strings[ i]);
            if (LENGTH(s) > 0) then begin
              xPos := POS(':', s);
              if (xPos > 0) then
                if (MatchesMask( TRIM( COPY( s, 1, xPos - 1)), aValue)
                     AND
                    MatchesMask( aMask, TRIM( COPY( s, xPos + 1, LENGTH(s) - xPos))))
                  then begin
                    Result := TRUE;
                    BREAK;
                  end;
            end;
          end;//for//
        1:for i := 0 to aList.Count - 1 do begin
            s := TRIM( aList.Strings[ i]);
            if (LENGTH(s) > 0) then begin
              xPos := POS(':', s);
              if (xPos > 0) then
                if ((aValue = TRIM( COPY( s, 1, xPos - 1)))
                     AND
                    MatchesMask( aMask, TRIM( COPY( s, xPos + 1, LENGTH(s) - xPos))))
                  then begin
                    Result := TRUE;
                    BREAK;
                  end;
            end;
          end;//for//
        2:for i := 0 to aList.Count - 1 do begin
            s := TRIM( aList.Strings[ i]);
            if (LENGTH(s) > 0) then begin
              xPos := POS(':', s);
              if (xPos > 0) then
                if (MatchesMask( TRIM( COPY( s, 1, xPos - 1)), aValue)
                     AND
                   (aMask = TRIM( COPY( s, xPos + 1, LENGTH(s) - xPos))))
                  then begin
                    Result := TRUE;
                    BREAK;
                  end;
            end;
          end;//for//
        3:for i := 0 to aList.Count - 1 do begin
            s := TRIM( aList.Strings[ i]);
            if (LENGTH(s) > 0) then begin
              xPos := POS(':', s);
              if (xPos > 0) then
                if ((aValue = TRIM( COPY( s, 1, xPos - 1)))
                    AND
                   (aMask = TRIM( COPY( s, xPos + 1, LENGTH(s) - xPos))))
                  then begin
                    Result := TRUE;
                    BREAK;
                  end;
            end;
          end;//for//

      end;//case//
      except
        ExceptionLog( 'Сбой Un_Tools.ExistsValueAndMaskIntoSettings');
    end;

end;


{~LoadSettings
  Возвращает TStringList с настройками из set файлов
  перенесено из модуля Un_Import всвязи с доработкой Exchange #2389 из-за того,
  что в этом модуле использована эта функция, но модуль используется раньше
  Un_Import.}
function LoadSettings( aFileName: String): TStringList;
var
  i: Integer;
  s: string;
begin

    try
      Result := TStringList.Create;
      if FileExists( aFileName) then begin

        if FileExists( aFileName)
          then Result.LoadFromFile( aFileName)
          else WriteInfo(
                  FORMAT( 'Файл %s не найден или нет доступа.',
                          [ aFileName]));

        for i := Result.Count - 1 downto 0 do begin
          s := Trim(Result.Strings[i]);
          if (LENGTH(s) <= 0)
            then Result.Delete(i)
            else
          if (s[1] = '#')
            then Result.Delete(i)
            else Result.Strings[i] := s;
        end;//for//
      end;
      except
        ExceptionProc( 'LoadSettings');
    end;

end;


{~MatchesIntoSettings
  поиск совпадений по маске в наборе строк.
  результат:
    строка поиска или пустая строка.
  параметры
    aMask - маска
    aList - набор строк
    aMode - режим:
      =0 - набор строк в виде: a:b
           возвращается a у которой match(маска,b)
      =1 - набор строк в виде: a:b
           возвращается b у которой match(маска,1)
      =2 - набор строк в виде: s
           возвращается первая строка s для которой match(маска,s) }
function MatchesIntoSettings( aMask: string;
                              aList: TStringList;
                              aMode: integer = 0): string;
var
  i: integer;
  s: string;
  xPos: integer;
begin

    try
      Result := '';
      case aMode of
        0:for i := 0 to aList.Count - 1 do begin
            s := TRIM( aList.Strings[ i]);
            if (LENGTH(s) > 0) then begin
              xPos := POS(':', s);
              if (xPos > 0) then
                if MatchesMask( aMask, TRIM( COPY( s, xPos + 1, LENGTH(s) - xPos)))
                  then begin
                    Result := TRIM( COPY( s, 1, xPos - 1));
                    BREAK;
                  end;
            end;
          end;//for//
        1:for i := 0 to aList.Count - 1 do begin
            s := TRIM( aList.Strings[ i]);
            if (LENGTH(s) > 0) then begin
              xPos := POS(':', s);
              if (xPos > 0) then
                if MatchesMask( aMask, TRIM( COPY( s, 1, xPos - 1)))
                  then begin
                    Result := TRIM( COPY( s, xPos + 1, LENGTH(s) - xPos));
                    BREAK;
                  end;
            end;
          end;//for//
        2:for i := 0 to aList.Count - 1 do begin
            s := TRIM( aList.Strings[ i]);
            if (LENGTH(s) > 0) then begin
              if MatchesMask( aMask, s)
                then begin
                  Result := s;
                  BREAK;
                end;
            end;
          end;//for//

      end;//case//

      except
        ExceptionLog( 'Сбой Un_Tools.MatchesIntoSettings');
    end;

end;


{~OpenFormProgress
  создание формы хода выполнения операции.
  возвращается объект созданной формы.
  параметры:
    aDirRoot - каталог (слеш в конце строки обязателен),
                относительно которого загружается описание формы
                из подкаталога aDirRoot\forms\.

    aProgressMax - максимальное значение прогресса.

    aCaption - название формы.
              по умолчению = 'Выполнение операции'.}
function OpenFormProgress( aDirRoot: string;
                           aProgressMax: integer;
                           aCaption: string = 'Выполнение операции'): TForm;
var
  xFormDfmFileName: string;
begin

    try
      xFormDfmFileName := aDirRoot + 'Forms\Fm_Process.dfm';
      if not FileExists( xFormDfmFileName) then begin
        WriteInfo( FORMAT( 'Не найден шаблон формы: "%s".',
                          [ xFormDfmFileName]));
        Result := NIL;
        EXIT;
      end;

      //визиуализация выгрузки
      Result := TForm.Create(Application);
      LoadForm( xFormDfmFileName, Result);

      Result.Caption := aCaption;

      AttachProgressControl(
              TProgressBar( Result.FindComponent('ProgressBar')),
              TStatusBar( Result.FindComponent('StatusBar')));

      SetProgress( 0, aProgressMax);
      ShowProgress( 0);

      Result.ClientHeight := 46;
      Result.ClientWidth := 200;

      Result.Show;
      Result.BringToFront;
      except
        ExceptionLog( 'Сбой Un_Tools.OpenFormProgress');
    end;

end;


procedure LogInfoFileValidate( aFileNameValidate: string;
                               aComment: string = '');
var
  SL: TStringList;
begin

    try
      if (LENGTH( aComment) > 0)
        then WriteInfo( aComment);
      if FileExists( aFileNameValidate) then begin
        SL := TStringList.Create;
        try
          SL.LoadFromFile( aFileNameValidate);
          WriteInfo( '    ' + StringReplace( SL.Text, #13#10, #13#10'    '));
          finally
            SL.Free;
        end;
      end;
      except
        ExceptionLog( 'Сбой Un_Tools.LogInfoFileValidate');
    end;

end;


{~TableForClass
  определение системной таблицы в бд для класса aClass.
  если таблица не определена - вызывается исключение.}
function TableForClass( aClass: string): string;
begin

    try
      case aClass of
          '5': Result := 'PayOrder';
         '11': Result := 'BudgOrder';
         '13': Result := 'PayOrder';
         '19': Result := 'IncOrder';
         '24': Result := 'PayOrder';
         '43': Result := 'IncOrder';
         '47': Result := 'InReOrder';
         '48': Result := 'BudgOrder';
         '75': Result := 'PayRequest';
         '79': Result := 'SrcOrder';
         '80': Result := 'SrcOrder';
        '100': Result := 'BudgOrder';
        '101': Result := 'BudgOrder';
        '104': Result := 'SrcAdvice';
        '106': Result := 'ExpAdvice';
        '114': Result := 'PayDetail';
        '117': Result := 'KbkDetail';
        '118': Result := 'SrcRequest';
        '137': Result := 'RegPassingFk';
        '148': Result := 'ExpSchedule';
        '149': Result := 'ExpScheduleRegistry';
        '182': Result := 'CancelReqOrder';
        '193': Result := 'moneytransferorder';
        '194': Result := 'AubucashRequest';
        '195': Result := 'AubucashRequest';
        '198': Result := 'PayDetail';
        '199': Result := 'moneytransferorder';
        '221': Result := 'unspentfundsdecode';
        '222': Result := 'unspentfundsdecode';
      '12002': Result := 'TargetGrantOper';
      else     raise(FORMAT( 'Для класса %s таблица не определена.', [ aClass]));
      end;//case//
      except
        ExceptionProc( 'TableForClass');
    end;

end;

{~MakeZIP
  создание архива aZipFileName исходя из набора файлоа aAddFiles.
  базовый каталог файлов aBaseDirFiles (без концевого слеша "\").
  допускается указание пустой строки в параметре aBaseDirFiles.
  если каталог aBaseDirFiles не указан, то в архиве файлы будут размещены
  с полным путем (кроме диска).
  если указать базовый каталог aBaseDirFiles, то все файлы в aAddFiles
  нужно указывать с относительными каталогами, относительно aBaseDirFiles.
  в архиве файлы тоже будут с относительными каталогами.}
function MakeZIP( aZipFileName: string;
                  aAddFiles: TStringList;
                  aBaseDirFiles: string = ''): boolean;
var
  xZipForge: TZipForge;
  i: integer;
  s: string;
begin

    try
      Result := FALSE;

      if FileExists( aZipFileName) then begin
        WriteLog( 'Удаляется старый файл архива: ' + aZipFileName);
        DeleteFile( aZipFileName);
      end;

      WriteLog( 'Выполняется создание архива...', TRUE);
      xZipForge := TZipForge.Create( NIL);
      try
        xZipForge.FileName := aZipFileName;
        xZipForge.OpenArchive( fmCreate);
        try
          // с концевым слешем
          s := aBaseDirFiles;
          if (LENGTH( s) > 0) then
            if (s[ LENGTH( s)] <> '\')
              then s := s + '\';

          xZipForge.BaseDir := s;
          for i := 0 to aAddFiles.Count - 1
            do xZipForge.AddFiles( aAddFiles.Strings[ i]);
          finally
            xZipForge.CloseArchive;
        end;

        Result := FileExists( xZipForge.FileName);
        if Result
          then WriteLog( 'Создан архив: ' + xZipForge.FileName)
          else WriteInfo( FORMAT( 'Архив %s не создан.',
                                  [ xZipForge.FileName]));
        finally
          xZipForge.Free;
      end;
      except
        ExceptionProc( 'MakeZIP');
    end;

end;


{~MakeZIP_File
  упаковка файла aSourceFile в архив aZipFileName.
  файл в архиве будет в корневом каталоге (т.е. только имя файла без пути)}
function MakeZIP_File( aZipFileName, aSourceFile: string): boolean;
var
  SL: TStringList;
begin

    try
      SL:= TStringList.Create;
      try
        SL.Add( ExtractFileName( aSourceFile));
        Result := MakeZIP( aZipFileName, SL, ExtractFilePath( aSourceFile));
        finally
          SL.Free;
      end;
      except
        ExceptionProc( 'MakeZIP_File');
    end;

end;

function DirectoryCheck( aDir: string): boolean;
begin

    try
      if (LENGTH( aDir) <= 0)
        then Result := TRUE
        else
          if DirectoryExists( aDir)
            then Result := TRUE
            else begin

              ForceDirectories( aDir);
              Result := DirectoryExists( aDir);
            end;

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

end;


begin
end.
