Program Design/Delphi2007/Utils.pas - master - YakuninAV/Convertors

Program Design/Delphi2007/Utils.pas
2 506 строк73 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
unit Utils;

 {$I mormot.defines.inc}

interface

uses
  Windows, Classes, Forms, Controls, SysUtils, Graphics, IniFiles, Obj, ComUnit, StdCtrls, Types

 , mormot.core.base, mormot.core.variants, mormot.core.os, mormot.core.unicode, mormot.core.data, mormot.core.search,
   mormot.core.text, mormot.core.json
;

const
  Digits = ['0'..'9'];
  RusABC = ['�'..'�'];
  RusStrABC = ['�'..'�'];
  LatABC = ['A'..'Z'];
  LatStrABC = ['a'..'z'];
  Months: array[0..12] of String = ('', '������', '�������', '����',
                                    '������', '���', '����',
                                    '����', '������', '��������',
                                    '�������', '������', '�������');
  MonthsRoot: array[0..12] of String = ('', '���', '���', '���',
                                            '���',  '��', '���',
                                            '���', '���', '���',
                                            '���', '���', '���');
  MonthsGen: array[0..12] of String = ('', '������', '�������', '�����',
                                    '������', '���', '����',
                                    '����', '�������', '��������',
                                    '�������', '������', '�������');
  MonthsDat: array[0..12] of String = ('', '������', '�������', '�����',
                                    '������', '���', '����',
                                    '����', '�������', '��������',
                                    '�������', '������', '�������');
  EngMonthsRoot: array[0..12] of String = ('', 'jan', 'feb', 'mar',
                                               'apr', 'may', 'jun',
                                               'jul', 'aug', 'sep',
                                               'oct', 'nov', 'dec');
  Quarters: array[0..12] of String = ('', 'I ��.', 'I ��.', 'I ��.',
                                      'II ��.', 'II ��.', 'II ��.',
                                      'III ��.', 'III ��.', 'III ��.',
                                      'IV ��.', 'IV ��.', 'IV ��.');
  QuartersQ: array[0..4] of String = ('', 'I ��.', 'II ��.', 'III ��.', 'IV ��.');
  MonthToQuarters: array[0..12] of Integer = (0, 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4);
  QuartersToMonth: array[0..4] of Integer = (0, 1, 4, 7, 10);

type
  DBoolArray = array of Boolean;
  PBoolArray = ^DBoolArray;

  TControlClass = class of TControl;

procedure CreateControl(CType: TControlClass; var Reference;
  AParent: TWinControl; AAlign: TAlign);

type
  PIntList = ^TIntList;
  TIntList = array[0..MaxListSize-1] of Integer;

  TSortType = (stInc, stDec);

  TIntegerList = class(TObject)
  private
    FList: PIntList;
    FCount: Integer;
    FDuplicates: Boolean;
    function GetCount: Integer;
    function GetInt(Index: Integer): Integer;
    procedure PutInt(Index, Value: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(Int: Integer);
    procedure AddAt(N, Int: Integer);
    procedure Assign(L: TIntegerList);
    procedure Delete(N: Integer);
    procedure Move(From, Where: Integer);
    procedure Sort(SortType: TSortType);
    procedure Offset(StartIndex, HowMuch: Integer);
    procedure Clear;
    procedure ClearDupes;
    procedure LoadFromArray(A: TIntegerDynArray);
    function SelfToArray: TIntegerDynArray;
    function IndexOf(Int: Integer): Integer;
    property Items[Index: Integer]: Integer read GetInt write PutInt; default;
    property Count: Integer read GetCount;
    property Duplicates: Boolean read FDuplicates write FDuplicates;
  end;

  TLargeIniFile = class(TIniFile)
  public
    procedure ReadSection(const Section: string; Strings: TStrings); override;
    function ReadString(const Section, Ident, Default: string): string; override;
  end;

function DosToWin(Dos: String): String;
function WinToDos(Win: String): String;
//function Utf8ToAnsi(const utf8: UTF8String): String;

function GetCurMonthYear(AMonth: Boolean): Integer;
function GetDateYear(ADate: TDateTime): Integer;
procedure CompleteShortYear(var AYear: Integer); overload;
function CompleteShortYear(const AYear: String): String; overload;
function GetLastDayOfMonth(AMonth, AYear: Integer): Integer;
function GetMonthIndex(const AMonth: String): Integer;
function GetDateString(ADay, AMonth, AYear: Integer): String;
function GetMonthBounds(AMonth, AYear: Integer; ALast: Boolean): String; overload;
function GetMonthBounds(const AMonth, AYear: String; ALast: Boolean): String; overload;
function GetCurrDateString(AForFileName: Boolean = False): String;

function Cut(var S: String; Index, Count: Integer): String;
procedure Replace(const Repstr: String; var S: String; Index, Count: Integer);
function ReplaceEx(const Substr, Repstr: String; var S: String; CaseSens: Boolean = True): Boolean;
procedure ReplaceRec(const Substr, Repstr: String; var S: String; CaseSens: Boolean = True); //��������, �������������� ��������� ����� ������� �������, ���� �� �� ���������
function ReplaceText(const S: String; SrcText, DstText: array of String): String;
function IsNumeric(const S: String): Boolean;
function FloatToStrEx(F: Extended; P: Integer; ThousandSep: Boolean = False; Fixed: Boolean = True): String;
function FloatToStringR(E: extended; P: integer = fv_ExtMaxPrecision): String;
function SetFracZeros(const Value: String; FixMin: Integer = 0): String;
function StrVarArrayOf(const Values: array of string): Variant;

function DelimStrEx(const Str: string; Delims: array of string): TStringDynArray;
function AddStringIfNotExist(const S: String; var A: TStringDynArray): integer;
function InsertString(const S: String; var A: TStringDynArray; Index: integer): integer;
function AddStrArray(const S: TStringDynArray; var A: TStringDynArray; OnlyNotExists: Boolean): integer; overload;
function LastStrItem(const Str, Delim: String): String;
function ContainsContexts(const C: array of String; const S: String): Boolean;
function ContextIndexInStr(const C: array of String; const S: String): Integer;
function PrefixIndexForStr(const P: array of String; const S: String): Integer;
function TextIndexIn(const S: string; const A: array of string): integer;

type
  TSetChar = set of Char;

procedure FilterMultipleChars(var Str: String; OldChar, NewChar: Char;
                              NewCharsCount: Integer); overload;
procedure FilterMultipleChars(var Str: String; OldChars: TSetChar;
                              NewChar: Char; NewCharsCount: Integer); overload;
procedure FilterSimilarLatRusSymbols(var Str: String; const BWListFN: String = '');
procedure FilterFourChars(var Str: String);
function ChangeChars(const Str: String; OldChar, NewChar: Char): String;
function ConsistsOfChars(const Str: String; Chars: TSetChar): Boolean;
function ExtractFirstNumber(const Str: String): Integer;
function FilterContractStr(const Str: String): String;
function FilterDateStr(const Str: String): String;
function DelimArg(const F: String; Sep: Char = ';'; bOpen: Char = '('; bClose: Char = ')'): TStringDynArray;
function CalcConstFormula(const F: String; Prec: Integer = -1): String;
function CheckPrecOfConstFormula(const F: String; Prec: Integer): Boolean;
function FilterConstFormula(const F: String; AddEqualSign: Boolean = True; FltZeroMult: Boolean = False): String;
procedure FilterExcessBrackets(var Str: String; OpenChar: Char = '('; CloseChar: Char = ')');
function FilterFunctions(const F: String): String;
function FilterLogics(const F: String): String;
function FilterFracAdds(const F: String): String;
function CorrectNegativeTokens(const F: String): String;
function FilterUnitaryFractions(const F: String): String;
function FindDualBrackets(const Str: String; OpenChar, CloseChar: Char; var OpenPos: Integer): Integer;
function FindOpenBracket(const Str: String; OpenChar, CloseChar: Char; var ClosePos: Integer): Integer;
function EgualSignCut(const Str: String): String;
function ExtractBoundedText(const Str, LeftBound, RightBound: String; const Prefix: String = ''; const Postfix: String = ''): String;
function StrDistributionEx(const Str: String; Sep: Char; DelEmpty: Boolean): TAsciizCollector;
function StrToArray(const Str: String; Sep: Char = ','): DStringArray;
function ArrayToStr(const StrArr: array of String; Sep: Char = ','): String;
function AddStrArray(const StrArr: array of String; var ResultArr: DStringArray): Integer; overload;
function ArrayIndexOf(const StrVal: String; const StrArr: array of String): Integer;

procedure UpdateComboList(ComboList: TStrings; MaxCount: Integer;
                          const NewItem: String; ClearList: Boolean = False); overload;
procedure UpdateComboList(ComboBox: TCustomComboBox; MaxCount: Integer;
                          const NewItem: String; ClearList: Boolean = False); overload;

procedure Delay(Delta: Cardinal);
procedure WaitFor(ATime: Cardinal);

function DeltaFunc(Value: Extended): Integer; overload;
function DeltaFunc(Value: Int64): Integer; overload;
function Positive(Value: Extended): Integer; overload;
function Positive(Value: Int64): Integer; overload;
function Signum(Value: Extended): Integer; overload;
function Signum(Value: Int64): Integer; overload;
function CalcCRC(const S: String): Cardinal;
function RandomRange(const AFrom, ATo: Integer): Integer;

function GetFlagsList(Flags: Integer): TIntegerDynArray;

function ExtractShortFileName(const FileName: String): String;
function ExpandRelativeFileName(const FileName: String; const BasePath: String = ''): String;
function GetUnexistedFileName(const FileName: String; const FileExt: String = 'Original extension'): String; overload;
function GetUnexistedFileName(const Path, ShortFileName, Ext: String): String; overload;
function StrFileTime(const FileName: String): String;
function IsNullFile(const FileName: String): Boolean;
function FileSizeByName(const FileName: String): Int64;
function FileTimeByName(const FileName: String): TFileTime;
procedure SetFileTimeByName(const FileName: String; FileTime: TFileTime);
function DeleteFileEx(const FileName: String): Boolean;
procedure DeleteFilesWithMask(const FilesMask, FilesPath: String);
procedure DeleteFiles(const Dir: String; const FMask: String = '*.*'; SubDirs: Boolean = False);
function EraseDirectory(const Dir: String): Boolean;
function CopyFiles(const SDir, DDir: String; const FMask: String = '*.*'): Boolean;
function MoveFiles(const SDir, DDir: String; const FMask: String = '*.*'): Boolean;
function CopyFilesEx(const SDir, DDir: String): Boolean;
function MoveFilesEx(const SDir, DDir: String): Boolean;
function CopyFileTime(const SFN, DFN: String; Newer: Boolean = True): Boolean;
function CopyFilesTime(const SDir, DDir: String; Newer: Boolean = True): Boolean;
function FilterEndStrSymbol(const SrcFN, DstFN: String): Boolean;
function GetFilesCount(const Dir: String; IncludeDirs, Nested: Boolean): Integer;
function GetCurrentUser: String;

function CopyFilesToClipboard(const AFileList: String; ASep: Char): Boolean;
function GetFilesFromClipboard(ASep: Char): String;

function ReadParam(const IniFile: TIniFile; const Section, Ident, Default: String;
                   Sep: Char; Count: Integer): TAsciizCollector;

function StrArrayToIntArray(const StrArr: TStringDynArray): TIntegerDynArray;
function ReadIntArray(const Str, Delim: String): TIntegerDynArray;
function WriteIntArray(A: TIntegerDynArray; Delim: String): String;
function IntegerIndexIn(N: Integer; A: array of Integer): Integer;
function AddInteger(N: Integer; var A: TIntegerDynArray): Integer;
procedure DeleteIntegerItems(var A: TIntegerDynArray; Ind, Count: Integer);

implementation

uses
  FileCtrl, Dialogs, Clipbrd, ShlObj, ShellAPI, Variants, StrUtils, Functions,
  Math;

function StrArrayToIntArray(const StrArr: TStringDynArray): TIntegerDynArray;
var
  i: Integer;
begin
  SetLength(Result, Length(StrArr));
  for i := 0 to Length(StrArr)-1 do
    Result[i] := StringToInt(StrArr[i]);
end;

function ReadIntArray(const Str, Delim: String): TIntegerDynArray;
begin
  Result := StrArrayToIntArray(DelimStr(Str, Delim));
end;

function WriteIntArray(A: TIntegerDynArray; Delim: String): String;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Length(A)-1 do begin
    if i > 0 then Result := Result + Delim;
    Result := Result + IntToStr(A[i]);
  end;
end;

function IntegerIndexIn(N: Integer; A: array of Integer): Integer;
begin
  for Result := 0 to Length(A)-1 do
    if A[Result] = N then Exit;
  Result := -1;
end;

function AddInteger(N: Integer; var A: TIntegerDynArray): Integer;
begin
  Result := IntegerIndexIn(N, A);
  if Result < 0 then begin
    Result := Length(A);
    SetLength(A, Result+1);
    A[Result] := N;
  end;
end;

procedure DeleteIntegerItems(var A: TIntegerDynArray; Ind, Count: Integer);
var
  i, C: Integer;
begin
  C := Length(A);
  if (Ind < 0) or (Ind >= C) then Exit;
  if C-Ind < Count then Count := C-Ind;
  C := C-Count;
  for i := Ind to C-1 do
    A[i] := A[i+Count];
  SetLength(A, C);
end;

procedure CreateControl(CType: TControlClass; var Reference;
  AParent: TWinControl; AAlign: TAlign);
begin
  TControl(Reference) := CType.Create(AParent);
  AParent.InsertControl(TControl(Reference));
  TControl(Reference).Align := AAlign;
end;

function DosToWin(Dos: String): String;
var
  A, S: PChar;
begin
  A := PChar(Dos);
  S := StrNew(A);
  OemToAnsi(A, S);
  Result := String(S);
  StrDispose(S);
end;

function WinToDos(Win: String): String;
var
  A, S: PChar;
begin
  A := PChar(Win);
  S := StrNew(A);
  AnsiToOem(A, S);
  Result := String(S);
  StrDispose(S);
end;
{
function Utf8ToAnsi(const utf8: UTF8String): String;
var
  latin1: AnsiString;
  ws: WideString;
  len: Integer;
begin
  len := MultiByteToWideChar(CP_UTF8, 0, PAnsiChar(utf8), Length(utf8), nil, 0);
  SetLength(ws, len);
  MultiByteToWideChar(CP_UTF8, 0, PAnsiChar(utf8), Length(utf8), PWideChar(ws), len);
  len := WideCharToMultiByte(28591, 0, PWideChar(ws), Length(ws), nil, 0, nil, nil);
  SetLength(latin1, len);
  WideCharToMultiByte(28591, 0, PWideChar(ws), Length(ws), PAnsiChar(latin1), len, nil, nil);
  Result := latin1;
end;
}
function GetCurMonthYear(AMonth: Boolean): Integer;
var
  WY, WM, WD: WORD;
begin
  DecodeDate(Now, WY, WM, WD);
  if AMonth then Result := WM
            else Result := WY;
end;

function GetDateYear(ADate: TDateTime): Integer;
var
  WY, WM, WD: WORD;
begin
  DecodeDate(ADate, WY, WM, WD);
  Result := WY;
end;

procedure CompleteShortYear(var AYear: Integer);
const
  Pivot = 10;
var
  CurYear, CurCent: Integer;
begin
  if AYear > 99 then Exit;
  CurYear := GetCurMonthYear(False);
  CurCent := 100*(CurYear div 100);
  Inc(AYear, CurCent);
  if AYear > CurYear+Pivot then Dec(AYear, 100);
end;

function CompleteShortYear(const AYear: String): String; overload;
var
  i: Integer;
begin
  i := StringToInt(AYear);
  CompleteShortYear(i);
  Result := IntToStr(i);
end;

function GetLastDayOfMonth(AMonth, AYear: Integer): Integer;
const
  LastDays: array[0..12] of Integer = (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
  Result := 0;
  if (AMonth < 1) or (AMonth > 12) then Exit;
  Result := LastDays[AMonth];
  if IsLeapYear(AYear) then
    Result := Result + DeltaFunc(AMonth-2);
end;

function GetMonthIndex(const AMonth: String): Integer;
var
  M: String;
begin
  M := AnsiLowerCase(AMonth);
  for Result := 1 to 12 do
    if Pos(MonthsRoot[Result], M) = 1 then Exit;
  for Result := 1 to 12 do
    if Pos(EngMonthsRoot[Result], M) = 1 then Exit;
  Result := 0;
end;

function GetDateString(ADay, AMonth, AYear: Integer): String;
var
  D, M, Y: String;
begin
  Result := '';
  case AMonth of
    1..9: M := '0' + IntToStr(AMonth);
    10..12: M := IntToStr(AMonth);
    else Exit;
  end;
  case ADay of
    1..9: D := '0' + IntToStr(ADay);
    10..31: D := IntToStr(ADay);
    else Exit;
  end;
  CompleteShortYear(AYear);
  Y := IntToStr(AYear);
  Result := D + '.' + M + '.' + Y;
end;

function GetMonthBounds(AMonth, AYear: Integer; ALast: Boolean): String;
var
  Day: Integer;
begin
  Result := '';
  if ALast then Day := GetLastDayOfMonth(AMonth, AYear)
           else Day := 1;
  Result := GetDateString(Day, AMonth, AYear);
end;

function GetMonthBounds(const AMonth, AYear: String; ALast: Boolean): String;
begin
  Result := GetMonthBounds(GetMonthIndex(AnsiLowerCase(AMonth)),
                           StringToInt(AYear), ALast);
end;

function GetCurrDateString(AForFileName: Boolean): String;
var
  Y, M, D: Word;
  C: TAsciizCollector;
  i: Integer;
begin
  DecodeDate(Now, Y, M, D);
  Result := GetDateString(D, M, Y);
  if not AForFileName then Exit;
  C := StrDistribution(PChar(Result), '.');
  Result := '';
  for i := C.Count-1 downto 0 do begin
    if Result > '' then Result := Result + '-';
    Result := Result + C.StrAt[i];
  end;
end;

function ExtractShortFileName(const FileName: String): String;
var
  i: Integer;
begin
  Result := ExtractFileName(FileName);
  if ExtractFileExt(Result) = '' then Exit;
  i := Length(Result);
  while (i > 0) and (Result[i] <> '.') do Dec(i);
  Result := Copy(Result, 1, i-1);
end;

function Cut(var S: String; Index, Count: Integer): String;
begin
  Result := Copy(S, Index, Count);
  Delete(S, Index, Count);
end;

procedure Replace(const Repstr: String; var S: String; Index, Count: Integer);
begin
  Delete(S, Index, Count);
  if Repstr > '' then Insert(Repstr, S, Index);
end;

function ReplaceEx(const Substr, Repstr: String; var S: String; CaseSens: Boolean): Boolean;
var
  P, PP: Integer;
  SS, RS: String;
begin
  Result := False;
  if CaseSens then begin
    SS := Substr;
    RS := S;
  end else begin
    SS := AnsiUpperCase(Substr);
    RS := AnsiUpperCase(S);
  end;
  PP := 0;
  P := Pos(SS, RS);
  while P > 0 do begin
    Replace(Repstr, S, P+PP, Length(Substr));
    Inc(PP, P+Length(Repstr)-1);
    Delete(RS, 1, P+Length(Substr)-1);
    P := Pos(SS, RS);
    Result := True;
  end;
end;

procedure ReplaceRec(const Substr, Repstr: String; var S: String; CaseSens: Boolean = True); //��������, �������������� ��������� ����� ������� �������, ���� �� �� ���������
var
  EntriesWere: Boolean;
begin
  EntriesWere := ReplaceEx(Substr, Repstr, S, CaseSens);
  while EntriesWere do EntriesWere := ReplaceEx(Substr, Repstr, S, CaseSens);  
end;

function ReplaceText(const S: String; SrcText, DstText: array of String): String;
var
  F: String;
  i, p: Integer;
begin
  Result := S;
  if Length(DstText) = 1 then
    for i := 0 to Length(SrcText)-1 do
      ReplaceEx(SrcText[i], DstText[0], Result, True)
  else
    for i := 0 to Length(SrcText)-1 do
      ReplaceEx(SrcText[i], DstText[i], Result, True);
end;

function IsNumeric(const S: String): Boolean;
var
  TS: String;
  V: Extended;
  C: Integer;
begin
  Result := False;
  if S = '' then Exit;
  TS := S;
  FilterChar(@TS[1], ',', '.');
  V := 0;
  Val(TS, V, C);
  Result := C = 0;
end;

function FloatToStrEx(F: Extended; P: Integer; ThousandSep: Boolean = False; Fixed: Boolean = True): String;
const
  DigFmt: array[Boolean] of Char = ('#', '0');
var
  FS: String;
  i: Integer;
begin
  FS := '0.';
  if ThousandSep then FS := ',' + FS;
  if (P < 0) or (P > 12) then P := 12;
  for i := 0 to P-1 do FS := FS + DigFmt[Fixed];
  Result := FormatFloat(FS, F);
end;

function FloatToStringR(E: extended; P: integer): string;
begin
  SetPrecision(E, P);
  Result := FloatToStringP(E, P);
end;

function SetFracZeros(const Value: String; FixMin: Integer = 0): String;
var
  i, p, L: Integer;
begin
  Result := Value;
  L := Length(Value);
  p := Pos('.', Value);
  if p = 0 then begin
    if FixMin < 1 then Exit;
    Result := Result + '.';
    Inc(L);
    p := L;
  end;
  i := L;
  while (i > p + FixMin) and (Result[i] = '0') do Dec(i);
  if i < L then begin
    Delete(Result, i+1, L-i);
    if Result[i] = '.' then Delete(Result, i, 1);    
  end else begin
    i := FixMin - (L - p);
    if i > 0 then Result := Result + pMultChar(i, '0');
  end;
end;

function StrVarArrayOf(const Values: array of string): Variant;
var
  I: Integer;
begin
  Result := VarArrayCreate([0, High(Values)], varVariant);
  for I := 0 to High(Values) do
    Result[I] := Values[I];
end;

function MinLength(Strs: array of string): integer;
var
  i, L: Integer;
begin
  Result := 0;
  L := Length(Strs);
  if L = 0 then Exit;
  Result := Length(Strs[0]);
  for i := 1 to L-1 do
    Result := Min(Result, Length(Strs[i]));
end;

function MinPosEx(SubStrs: array of string; const S: string; Offset: integer = 1): integer;
var
  i, L: Integer;
begin
  Result := 0;
  L := Length(SubStrs);
  if L = 0 then Exit;
  Result := PosEx(SubStrs[0], S, Offset);
  for i := 1 to L-1 do
    Result := Min(Result, PosEx(SubStrs[i], S, Offset));
end;

function MinArray(Vals: array of integer; out Index: integer; MinVal: integer = 1): integer;
var
  i, L: Integer;
begin
  Index := 0;
  Result := MinVal-1;
  L := Length(Vals);
  if L = 0 then Exit;
  i := 0;
  while (i < L) and (Result < MinVal) do begin
    if Vals[i] >= MinVal then begin
      Result := Vals[i];
      Index := i;
    end;
    Inc(i);
  end;
  while (i < L) do begin
    if (Vals[i] >= MinVal) and (Vals[i] < Result) then begin
      Result := Vals[i];
      Index := i;
    end;
    Inc(i);
  end;
end;

function DelimStrEx(const Str: string; Delims: array of string): TStringDynArray;
var
  i,DL,P,L,C,M: integer;
  D, X: array of integer;
begin
  Result:=nil;
  L:=Length(Str);
  if L=0 then Exit;
  DL := Length(Delims);
  if DL = 0 then Exit;
  SetLength(D, DL);
  for i := 0 to DL-1 do
    D[i] := Length(Delims[i]);
  M := MinArray(D, i);
  if M < 1 then Exit;
  SetLength(Result,(L div M)+1);
  SetLength(X, DL);
  C:=0; P:=1;
  inc(L);
  while P<=L do
    begin
      for i := 0 to DL-1 do
        X[i] := PosEx(Delims[i],Str,P);
      M := MinArray(X, i);
      if M=0 then M:=L;
      Result[C]:=Copy(Str,P,M-P);
      inc(C);
      P:=M+D[i];
    end;
  SetLength(Result,C);
end;

function ContainsContexts(const C: array of String; const S: String): Boolean;
begin
  Result := ContextIndexInStr(C, S) >= 0;
end;

function ContextIndexInStr(const C: array of String; const S: String): Integer;
begin
  for Result := 0 to Length(C)-1 do
    if Pos(C[Result], S) > 0 then Exit;
  Result := -1;
end;

function PrefixIndexForStr(const P: array of String; const S: String): Integer;
begin
  for Result := 0 to Length(P)-1 do
    if (P[Result] > '') and (Pos(P[Result], S) = 1) then Exit;
  Result := -1;
end;

function TextIndexIn(const S: string; const A: array of string): integer;
var
  I,H: integer;
begin
  H:=High(A);
  I:=Low(A);
  Result:=-1;
  while (Result=-1) and (I<=H) do
    if AnsiCompareText(S, A[I]) = 0 then Result:=I else
      inc(I);
end;

procedure FilterMultipleChars(var Str: String; OldChars: TSetChar;
                              NewChar: Char; NewCharsCount: Integer); overload;
var
  i, j: Integer;
begin
  for i := 1 to Length(Str) do
    if Str[i] in OldChars then
      Str[i] := NewChar;
  i := 1;
  while i < Length(Str) do begin
    j := 0;
    while (i+j <= Length(Str)) and (Str[i+j] = NewChar) do Inc(j);
    if j > 0 then begin
      if j > NewCharsCount then
        Delete(Str, i, j-NewCharsCount)
      else while j < NewCharsCount do begin
        Insert(NewChar, Str, i);
        Inc(j);
      end;
      Inc(i, NewCharsCount);
    end;
    Inc(i);
  end;
end;

procedure FilterMultipleChars(var Str: String; OldChar, NewChar: Char;
                              NewCharsCount: Integer); overload;
begin
  FilterMultipleChars(Str, [OldChar], NewChar, NewCharsCount);
end;

function ChangeChars(const Str: String; OldChar, NewChar: Char): String;
var
  i: Integer;
begin
  Result := Str;
  for i := 1 to Length(Str) do
    if Str[i] = OldChar then
      Result[i] := NewChar;
end;

function ConsistsOfChars(const Str: String; Chars: TSetChar): Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 1 to Length(Str) do
    if not(Str[i] in Chars) then Exit;
  Result := True;
end;

function ExtractFirstNumber(const Str: String): Integer;
var
  i: Integer;
  R: String;
begin
  R := '';
  i := 1;
  while (i <= Length(Str)) and not(Str[i] in ['0'..'9']) do Inc(i);
  while (i <= Length(Str)) and (Str[i] in ['0'..'9']) do begin
    R := R + Str[i];
    Inc(i);
  end;
  Result := StringToInt(R);
end;

function FilterContractStr(const Str: String): String;
var
  NS, DS: String;

  function SplitNumber(var CS: String): String;
  var
    p: Integer;
  begin
    Result := '';
    p := Pos('��', CS);
    if p > 0 then begin
      Result := Copy(CS, p+2, Length(CS)-p-1);
      DeletePrimeSpaces(Result);
      Delete(CS, p, Length(CS)-p+1);
      DeleteLastSpaces(CS);
    end;
  end;

begin
  Result := '';
  if Str = '' then Exit;
  NS := Str;
  DS := SplitNumber(NS);
  if DS = '' then ;
  DS := FilterDateStr(DS);
  if (NS > '') and (NS[1] = '�') then
    Delete(NS, 1, 1);
  Result := NS + '#' + DS;
end;

function FilterDateStr(const Str: String): String;
var
  S: String;
  i, N: Integer;
  C, D: TAsciizCollector;

  procedure SplitNumbersAndChars(var Str: String);
  var
    i: Integer;
  begin
    i := 1;
    while i <= Length(Str) do begin
      while (i <= Length(Str)) and not(Str[i] in ['0'..'9']) do Inc(i);
      if (i > 1) and (i < Length(Str)) and (Str[i] <> ' ') then begin
        Insert(' ', Str, i);
        Inc(i);
      end;
      while (i <= Length(Str)) and (Str[i] in ['0'..'9']) do Inc(i);
      if (i > 1) and (i < Length(Str)) and (Str[i] <> ' ') then begin
        Insert(' ', Str, i);
        Inc(i);
      end;
    end;
  end;

begin
  Result := '';
  if Str = '' then Exit;
  S := Str;
  FilterChar(PChar(S), '.', ' ');
  FilterChar(PChar(S), '/', ' ');
  SplitNumbersAndChars(S);
  FilterMultipleChars(S, ' ', ' ', 1);
  C := StrDistribution(PChar(S), ' ');
  D := TAsciizCollector.Create(2);
  for i := 0 to C.Count-1 do begin
    N := StringToInt(C.StrAt[i]);
    if N > 0 then begin
      case D.Count of
        0: if N < 32 then
          D.AddString(IntToStr(N));
        1: if N < 13 then
          D.AddString(IntToStr(N));
        2: D.AddString(IntToStr(N));
        else Break;
      end;
    end else begin
      N := 1;
      while (N <= 12) and (Pos(MonthsRoot[N], C.StrAt[i]) < 1) do Inc(N);
      if (N > 0) and (N <= 12) then
        D.AddString(IntToStr(N));
    end;
  end;
  if Length(D.StrAt[0]) = 1 then
    D.StrAt[0] := '0' + D.StrAt[0];
  if Length(D.StrAt[1]) = 1 then
    D.StrAt[1] := '0' + D.StrAt[1];
  case Length(D.StrAt[2]) of
//    0: if D.Count > 1 then D.StrAt[2] := IntToStr(GetCurMonthYear(False));
    1: D.StrAt[2] := '200' + D.StrAt[2];
    2: D.StrAt[2] := '20' + D.StrAt[2];
    3: D.StrAt[2] := '2' + D.StrAt[2];
  end;
  Result := D.TotString('#');
  D.Free;
  C.Free;
end;

function DelimArg(const F: String; Sep, bOpen, bClose: Char): TStringDynArray;
var
  i, s, c, L: Integer;
begin
  L := Length(F);
  SetLength(Result, L+1);
  i := 1; c := 0; s := 1;
  while i <= L do begin
    if F[i] = Sep then begin
      Result[c] := Copy(F, s, i-s);
      s := i+1;
      Inc(c);
    end else
    if F[i] = bOpen then begin
      i := FindDualBrackets(F, bOpen, bClose, i);
    end;
    Inc(i);
  end;
  Result[c] := Copy(F, s, i-s);
  Inc(c);
  SetLength(Result, c);
end;

function GetOperationArgs(const F: String; Index: Integer): TStringDynArray;
var
  i: Integer;
begin
  SetLength(Result, 2);
  i := Index-1;
  while (i > 0) and (F[i] in Digits+['.']) do Dec(i);
  Result[0] := Copy(F, i+1, Index-i-1);
  i := Index+1;
  while (i <= Length(F)) and (F[i] in Digits+['.']) do Inc(i);
  Result[1] := Copy(F, Index+1, i-Index-1);
end;

function CalcConstFormula(const F: String; Prec: Integer): String;
var
  E: TStringDynArray;
  i, o, c: Integer;
  V, D: Extended;
  Oper: Char;
  S: String;
begin
  Result := F;
  DeleteSpaces(Result);
  if Result = '' then Exit;
  if Result[1] = '~' then Result[1] := '-'; //��������� �����
  if Result[1] = '=' then Delete(Result, 1, 1);
  if Result = '' then Exit;
  if IsNumeric(Result) then begin
    Result := FloatToStringR(StringToFloatEx(Result), Prec);
    Exit;
  end;
  repeat
    i := Pos('IF(', Result);
    if i > 0 then begin
      c := FindDualBrackets(Result, '(', ')', i);
      E := DelimArg(Copy(Result, i+1, c-i-1), ';');
      if CorrCompareFloat(StringToFloatEx(CalcConstFormula(E[0])), 1) = 0 then
        Replace('('+E[1]+')', Result, i-2, c-i+3) else Replace('('+E[2]+')', Result, i-2, c-i+3);
    end;
  until i < 1;
  repeat
    i := Pos('NOT(', Result);
    if i > 0 then begin
      c := FindDualBrackets(Result, '(', ')', i);
      if CorrCompareFloat(StringToFloatEx(CalcConstFormula(Copy(Result, i+1, c-i-1))), 1) = 0 then
        Replace('0', Result, i-3, c-i+4) else Replace('1', Result, i-3, c-i+4);
    end;
  until i < 1;
  repeat
    i := Pos('INT(', Result);
    if i > 0 then begin
      c := FindDualBrackets(Result, '(', ')', i);
      Replace(FloatToStr(Int(StringToFloatEx(CalcConstFormula(Copy(Result, i+1, c-i-1))))), Result, i-3, c-i+4);
    end;
  until i < 1;
  repeat
    i := Pos('FRAC(', Result);
    if i > 0 then begin
      c := FindDualBrackets(Result, '(', ')', i);
      Replace(FloatToStr(Frac(StringToFloatEx(CalcConstFormula(Copy(Result, i+1, c-i-1))))), Result, i-4, c-i+5);
    end;
  until i < 1;
  repeat
    i := Pos('ISMASK(', Result);
    if i > 0 then begin
      c := FindDualBrackets(Result, '(', ')', i);
      E := DelimArg(Copy(Result, i+1, c-i-1), ';');
      Replace(IntToStr(Ord(StringToInt(E[0]) and StringToInt(E[1]) > 0)), Result, i-6, c-i+7);
    end;
  until i < 1;
  repeat
    i := Pos('ROUNDP(', Result);
    if i > 0 then begin
      c := FindDualBrackets(Result, '(', ')', i);
      E := DelimArg(Copy(Result, i+1, c-i-1), ';');
      Replace(FloatToStringR(StringToFloatEx(CalcConstFormula(E[0])), StringToInt(E[1])), Result, i-6, c-i+7);
    end;
  until i < 1;
//  o := Pos('(', Result);
  o := 1;
  c := FindDualBrackets(Result, '(', ')', o);
  if (o = 1) and (c = Length(Result)) then //������� ������
    Result := CalcConstFormula(Copy(Result, o+1, c-o-1))
  else
  if o > 0 then begin
    repeat
      S := CalcConstFormula(Copy(Result, o+1, c-o-1));
      if IsNumeric(S) and (StringToFloat(S) < 0) then begin//���� ��������� ������������� ��������, �� ������ ���� ��������, ������� �������� ������� �� �� ������, � ����� - �� ������, ����� �� �������� �������� ���������
        S[1] := '~';
        S := '{' + S + '}';
      end;
      Replace(S, Result, o, c-o+1); //���� ��� ������ �� ����������� �������, �� ��� ����� ��������� ���
      c := FindDualBrackets(Result, '(', ')', o);
    until o = 0;
    Result := ReplaceText(Result, ['{', '}'], ['(', ')']);
  end;
  if Pos('|', Result) > 0 then begin
    E := DelimStr(Result, '|');
    V := StringToFloatEx(CalcConstFormula(E[0]));
    for i := 1 to Length(E)-1 do
      V := CorrFloatTrunc(V) or CorrFloatTrunc(StringToFloatEx(CalcConstFormula(E[i])));
  end else
  if Pos('+', Result) > 0 then begin
    E := DelimStr(Result, '+');
    V := StringToFloatEx(CalcConstFormula(E[0]));
    for i := 1 to Length(E)-1 do
      V := V + StringToFloatEx(CalcConstFormula(E[i]));
  end else
  if Pos('-', Result) > 0 then begin
    E := DelimStr(Result, '-');
    V := StringToFloatEx(CalcConstFormula(E[0]));
    for i := 1 to Length(E)-1 do
      V := V - StringToFloatEx(CalcConstFormula(E[i]));
  end else
  if Pos('>', Result) > 0 then begin
    E := DelimStr(Result, '>');
    if CorrCompareFloat(StringToFloatEx(CalcConstFormula(E[0])), StringToFloatEx(CalcConstFormula(E[1]))) < 0 then
      V := 1 else V := 0;
  end else
  if Pos('<', Result) > 0 then begin
    E := DelimStr(Result, '<');
    if CorrCompareFloat(StringToFloatEx(CalcConstFormula(E[0])), StringToFloatEx(CalcConstFormula(E[1]))) > 0 then
      V := 1 else V := 0;
  end else
  if Pos('=', Result) > 0 then begin
    E := DelimStr(Result, '=');
    if CorrCompareFloat(StringToFloatEx(CalcConstFormula(E[0])), StringToFloatEx(CalcConstFormula(E[1]))) = 0 then
      V := 1 else V := 0;
  end else
{  if Pos('^', Result) > 0 then begin
    E := DelimStr(Result, '^');
    V := Power(StringToFloatEx(CalcConstFormula(E[0])), StringToFloatEx(CalcConstFormula(E[1])));
  end else }
  if Pos('&', Result) > 0 then begin
    E := DelimStr(Result, '&');
    V := StringToFloatEx(CalcConstFormula(E[0]));
    for i := 1 to Length(E)-1 do
      V := CorrFloatTrunc(V) and CorrFloatTrunc(StringToFloatEx(CalcConstFormula(E[i])));
  end else begin
    i := Pos('^', Result);
    while i > 0 do begin
      E := GetOperationArgs(Result, i);
      Replace(FloatToStr(Power(StringToFloatEx(E[0]), StringToFloatEx(E[1]))), Result, i-Length(E[0]), Length(E[0])+Length(E[1])+1);
      i := Pos('^', Result);
    end;
    i := Pos('@', Result);
    while i > 0 do begin
      E := GetOperationArgs(Result, i);
      Replace(FloatToStr(StringToFloatEx(E[0])+StringToFloatEx(E[1])-1), Result, i-Length(E[0]), Length(E[0])+Length(E[1])+1);
      i := Pos('@', Result);
    end;
    i := 1; V := 1; Oper := '=';
    while i <= Length(Result) do begin
      if Result[i] in ['*', '/'] then begin
        if Oper in ['=', '*'] then
          V := V * StringToFloatEx(CalcConstFormula(Copy(Result, 1, i-1)))
        else
        if Oper = '/' then begin
          D := StringToFloatEx(CalcConstFormula(Copy(Result, 1, i-1)));
          if D <> 0 then V := V / D else V := 0;
        end;
        Oper := Result[i];
        Delete(Result, 1, i);
        i := 1;
      end else
        Inc(i);
    end;
    if Oper = '*' then
      V := V * StringToFloatEx(CalcConstFormula(Result))
    else
    if Oper = '/' then begin
      D := StringToFloatEx(CalcConstFormula(Result));
      if D <> 0 then V := V / D else V := 0;
    end else
      V := StringToFloatEx(Result);
  end;
  Result := FloatToStringR(V, Prec);
end;

function CheckPrecOfConstFormula(const F: String; Prec: Integer): Boolean;
var
  R: String;
  i: Integer;
begin
  R := CalcConstFormula(F);
  i := Pos(DecimalSeparator, R);
  Result := (Prec < 0) or (i < 1) or (Length(R)-i < Prec);
end;

procedure FilterExcessBrackets(var Str: String; OpenChar, CloseChar: Char);
var
  i, c, o: Integer;
  S: String;
begin
  i := 1;
  repeat
    c := FindDualBrackets(Str, OpenChar, CloseChar, i);
    while (i = 1) and (c = Length(Str)) do begin
      Str := Copy(Str, 2, Length(Str)-2);
      c := FindDualBrackets(Str, OpenChar, CloseChar, i);
    end;
    if i > 0 then begin
      S := Cut(Str, i+1, c-i-1);
      FilterExcessBrackets(S, OpenChar, CloseChar);
      if (IsNumeric(S) and (S[1] <> '-') and ((i = 1) or not(Str[i-1] in LatABC)))
       or (((i = 1) or (Str[i-1] in ['(', '+'])) and ((i+1 = Length(Str)) or (Str[i+2] in [')', '+', '-']))) then
        Delete(Str, i, 2)
      else Inc(i);
      Insert(S, Str, i);
      Inc(i, Length(S));
    end;
  until i < 1;
end;

function FilterZerosAndOnes(const F: String): String;
var
  M: TStringDynArray;
  i: Integer;
begin
  Result := '';
  M := DelimStr(F, '*');
  if Length(M) > 1 then begin
    for i := 0 to Length(M)-1 do
      if CorrCompareFloat(StringToFloatEx(M[i]), 1) <> 0 then begin
        if Result > '' then Result := Result + '*';
        Result := Result + M[i];
      end;
    if Result = '' then Result := '1';
  end else
    Result := F;
  if (Length(Result) > 2) and ((Result[1] <> '(') or ((Result[Length(Result)] <> ')'))) then
    Result := '(' + Result + ')'; //����� 0 ��� 1  � ������ � � ����� ������� "����"
  ReplaceEx('*1+', '+', Result);
  ReplaceRec('+1*', '+', Result);
  ReplaceEx('*1-', '-', Result);
  ReplaceRec('-1*', '-', Result);
  ReplaceEx('*1)', ')', Result);
  ReplaceEx('/1+', '+', Result);
  ReplaceEx('/1-', '-', Result);
  ReplaceEx('/1*', '*', Result);
  ReplaceRec('/1/', '/', Result);
  ReplaceEx('/1)', ')', Result);
  ReplaceRec('(1*', '(', Result);
  ReplaceRec('(0+', '(', Result);
  ReplaceEx('(0-', '(-', Result);
  ReplaceRec('(0*0+', '(', Result);
  ReplaceEx('(0*0-', '(-', Result);
  ReplaceEx('(0*0)', '0', Result);
  ReplaceEx('+0)', ')', Result);
  ReplaceEx('-0)', ')', Result);
  ReplaceEx('+0*0)', ')', Result);
  ReplaceEx('-0*0)', ')', Result);
  ReplaceRec('+0+', '+', Result);
  ReplaceEx('-0+', '+', Result);
  ReplaceEx('+0-', '-', Result);
  ReplaceRec('-0-', '-', Result);
  ReplaceRec('+0*0+', '+', Result);
  ReplaceEx('-0*0+', '+', Result);
  ReplaceEx('+0*0-', '-', Result);
  ReplaceRec('-0*0-', '-', Result);
  ReplaceEx('@1@', '@', Result);
  ReplaceEx('*1@', '*', Result);
  ReplaceEx('@1*', '*', Result);
  ReplaceEx('(1@', '(', Result);
  ReplaceEx('@1)', ')', Result);
  FilterExcessBrackets(Result);
end;

function PosFunction(const F: String; const FS: array of String; var Fi: Integer): Integer;
begin
  Fi := 0;
  while Fi < Length(FS) do begin
    Result := Pos(FS[Fi], F);
    if Result > 0 then Exit;
    Inc(Fi);
  end;
  Result := 0;
end;

procedure ReplaceResult(const R: String; var S: String; Index, Count: Integer);
begin
//  if not IsNumericStr(R) and (Index > 1) and (Index+Count < Length(S)) then
  Replace('('+R+')', S, Index, Count);
end;

function FilterFunctions(const F: String): String;
var
  M: TStringDynArray;
  i, Fi, c, o, P: Integer;
  V: Extended;
begin
  Result := F;
  repeat
    i := PosFunction(Result, ['ROUND(', 'ROUNDC', 'ROUNDP', 'ROUNDS', 'INT(', 'FRAC(', 'MULIF(', 'IF(', '����(', 'NOT('], Fi);
    if i > 0 then begin
      o := i;
      c := FindDualBrackets(Result, '(', ')', o);
      Insert(FilterFunctions(Cut(Result, o+1, c-o-1)), Result, o+1);
      c := FindDualBrackets(Result, '(', ')', o);
      M := DelimArg(Copy(Result, o+1, c-o-1), ';');
      case Fi of
        0..3: begin
          if IsNumericStr(M[0]) then begin
            V := StringToFloatEx(M[0]);
            case Fi of
              0: P := 0;
              1: P := 2;
              2..3: P := StringToInt(M[1]);
            end;
            SetPrecision(V, P);
            ReplaceResult(FloatToStr(V), Result, i, c-i+1);
          end else
            ReplaceResult(M[0], Result, i, c-i+1);
        end;
        4: begin
          V := StringToFloatEx(CalcConstFormula(M[0]));
          V := Int(V);
          ReplaceResult(FloatToStr(V), Result, i, c-i+1);
        end;
        5: begin
          V := StringToFloatEx(CalcConstFormula(M[0]));
          V := Frac(V);
          ReplaceResult(FloatToStr(V), Result, i, c-i+1);
        end;
        6: if CorrCompareFloat(StringToFloatEx(CalcConstFormula(M[0])), 1) = 0 then
             ReplaceResult(M[1], Result, i, c-i+1) else ReplaceResult('1', Result, i, c-i+1);
        7..8: if CorrCompareFloat(StringToFloatEx(CalcConstFormula(M[0])), 1) = 0 then
                ReplaceResult(M[1], Result, i, c-i+1) else ReplaceResult(M[2], Result, i, c-i+1);
        9: if CorrCompareFloat(StringToFloatEx(CalcConstFormula(M[0])), 1) = 0 then
             ReplaceResult('0', Result, i, c-i+1) else ReplaceResult('1', Result, i, c-i+1);
      end;
    end;
  until i < 1;
end;

function FilterLogics(const F: String): String;
var
  i, Fi, c, o: Integer;
  V: String;
begin
  Result := F;
  if Result = '' then Exit;
  if Result[1] = '=' then Delete(Result, 1, 1);
  repeat
    i := PosFunction(Result, ['=', '>', '<', '&', '|'], Fi);
    if i > 1 then begin
      o := i-1;
      c := o;
      if Result[o] = ')' then
        o := FindOpenBracket(Result, '(', ')', c)
      else begin
        while (o > 0) and (Result[o] in Digits+['.']) do Dec(o);
        Inc(o);
      end;
      c := i+1;
      i := c;
      if Result[i] = '(' then
        c := FindDualBrackets(Result, '(', ')', i)
      else begin
        while (c <= Length(Result)) and (Result[c] in Digits+['.']) do Inc(c);
        Dec(c);
      end;
      V := CalcConstFormula(Copy(Result, o, c-o+1));
      Replace(V, Result, o, c-o+1);
    end;
  until i < 1;
end;

function FilterFracAdds(const F: String): String;
var
  i, c, o: Integer;
  V: String;
begin
  Result := F;
  if Result = '' then Exit;
  if Result[1] = '=' then Delete(Result, 1, 1);
  repeat
    i := Pos('@', Result);
    if i > 1 then begin
      o := i-1;
      c := o;
      if Result[o] = ')' then begin
        o := FindOpenBracket(Result, '(', ')', c);
        V := Copy(Result, o+1, i-o-2);
      end else begin
        while (o > 0) and (Result[o] in Digits+['.']) do Dec(o);
        Inc(o);
        V := '1+' + CalcConstFormula(Copy(Result, o, i-o)+'-1');
      end;
      c := i+1;
      while (c <= Length(Result)) and (Result[c] in Digits+['.']) do Inc(c);
      Dec(c);
      V := V + '+' + CalcConstFormula(Copy(Result, i+1, c-i)+'-1');
      Replace('(' + V + ')', Result, o, c-o+1);
    end;
  until i < 1;
  Result := CorrectNegativeTokens(Result);
end;

function FilterZeroMultipliers(const F: String): String;
var
  i, Fi, c, o: Integer;
  V: String;
begin
  Result := '(' + F + ')';
  repeat
    i := PosFunction(Result, ['(0)*', '(0*', '+0*', '-0*', '*0*', '*(0)', '*0)', '*0+', '*0-', '(0)/', '(0/', '+0/', '-0/', '*0/'], Fi);
    if i > 0 then begin
      case Fi of
        0..4, 9..13: begin
          if Fi = 0 then begin
            Replace('0', Result, i, 3);
            o := i+2;
          end else
            o := i+3;
          c := o;
          if Result[o] = '(' then
            c := FindDualBrackets(Result, '(', ')', o)
          else begin
            while (c <= Length(Result)) and (Result[c] in Digits+['.']) do Inc(c);
            Dec(c);
          end;
          Dec(o);
        end;
        5..8: begin
          if Fi = 5 then 
            Replace('0', Result, i, 3);
          c := i-1;
          o := c;
          if Result[c] = ')' then
            o := FindOpenBracket(Result, '(', ')', c)
          else begin
            while (o > 0) and (Result[o] in Digits+['.']) do Dec(o);
            Inc(o);
          end;
          Inc(c);
        end;
      end;
      Delete(Result, o, c-o+1);
    end;
  until i < 1;
end;

function CorrectNegativeTokens(const F: String): String;
var
  i, Fi: Integer;
begin
  Result := F;
  ReplaceEx('+-', '-', Result);
  ReplaceEx('--', '+', Result);
  repeat
    i := PosFunction(Result, ['*-', '/-', '^-'], Fi);
    if i > 0 then begin
      Insert('(', Result, i+1);
      Inc(i, 3);
      while (i <= Length(Result)) and (Result[i] in Digits+['.']) do Inc(i);
      Insert(')', Result, i);
    end;
  until i < 1;
end;

function FilterUnitaryFractions(const F: String): String;
var
  i, p, m, c: Integer;
  CS: String;
  EqualSign, NonMul: Boolean;

  function ScanMultiplierAfter(const S: String): Boolean;
  begin
    Result := False;
    repeat
      if (m+c <= Length(S)) and (S[m] = '*') then begin
        if (Copy(S, m+1, c) = CS) and ((m+c = Length(S)) or not(S[m+c+1] in Digits+['.'])) then begin
          Result := True;
          Exit;
        end else
          Inc(m);
      end;
      while (m <= Length(S)) and (S[m] in Digits+['.', '/']) do Inc(m);
    until (m+c > Length(S)) or (S[m] <> '*');
  end;

  function ScanMultiplierPrevs(const S: String; out NonMul: Boolean): Boolean;
  begin
    Result := False; NonMul := True;
    repeat
      if S[m] = '*' then begin
        Dec(m);
        NonMul := False;
      end;
      while (m > 0) and (S[m] in Digits+['.', '/']) do Dec(m);
      if ((m = 0) or (S[m] = '*'))
       and (Copy(S, m+1, c) = CS) and not(S[m+c+1] in Digits+['.']) then begin
        Result := True;
        Exit;
      end;
    until (m <= 0) or (S[m] <> '*');
    Result := ((m <= 0) or (S[m] in ['(', '+', '-'])) and (Copy(S, m+1, c) = CS) and not(S[m+c+1] in Digits+['.']);
  end;

begin
  Result := F;
  EqualSign := (Result > '') and (Result[1] = '=');
  if EqualSign then Delete(Result, 1, 1);
  if Result = '' then Exit;
  i := 1;
  repeat
    p := PosEx('/', Result, i);
    if (p >= i) and (p < Length(Result)) then begin
      i := p+1;
      if Result[i] in Digits then begin
        while (i <= Length(Result)) and (Result[i] in Digits+['.']) do Inc(i);
        CS := Copy(Result, p+1, i-p-1); c := Length(CS);
        m := i;
        if ScanMultiplierAfter(Result) then begin
          Delete(Result, m, c+1);
          Delete(Result, p, c+1);
        end else begin
          m := i-1;
          if ScanMultiplierPrevs(Result, NonMul) then begin
            Delete(Result, p, c+1);
            if NonMul then begin
              Delete(Result, m+1, c);
              Insert('1', Result, m+1);
            end else
            if m > 0 then
              Delete(Result, m, c+1) else
              Delete(Result, 1, c+1);
            Dec(i, c+1);
          end;
        end;
      end;
    end else
      i := Length(Result);
  until i >= Length(Result);
  Result := FilterZerosAndOnes(Result);
  if Result = '' then Result := '1';
  if EqualSign then Result := '=' + Result;
end;

function FilterConstFormula(const F: String; AddEqualSign, FltZeroMult: Boolean): String;
var
  M: TStringDynArray;
  i, c, o: Integer;
  V: Extended;
begin
  Result := FilterZerosAndOnes(F);
  DeleteSpaces(Result);
  Result := CorrectNegativeTokens(Result);
  Result := FilterFunctions(Result); //������ ��������� ������� IF � ROUNDx �� ������� �����������
  Result := FilterZerosAndOnes(Result);
  Result := FilterFracAdds(Result);
  Result := FilterZerosAndOnes(Result);
  Result := FilterLogics(Result);
  Result := FilterZerosAndOnes(Result);
  if FltZeroMult then begin
    Result := FilterZeroMultipliers(Result);
    Result := FilterZerosAndOnes(Result);
    Result := FilterZeroMultipliers(Result);
    Result := FilterZerosAndOnes(Result);
  end;
  Result := FilterZerosAndOnes(Result);
  if (Result > '') and AddEqualSign and not IsNumeric(Result) then
    Result := '=' + Result;
{  repeat
    i := Pos('IF(', Result);
    if i > 0 then begin
      c := FindDualBrackets(Result, '(', ')', i);
      M := DelimStr(Copy(Result, i+1, c-i-1), ';'); //����� ������� ������� ������� �������� � ������, ���� ����� �������������� ��������� ������� � �����, ��� ����� ����������!
      if CorrCompareFloat(StringToFloatEx(CalcConstFormula(M[0])), 1) = 0 then
        Replace(M[1], Result, i-2, c-i+3) else Replace(M[2], Result, i-2, c-i+3);
    end;
  until i < 1;
  repeat
    i := Pos('ROUND', Result);
    if i > 0 then begin
      o := i;
      c := FindDualBrackets(Result, '(', ')', o);
      M := DelimStr(Copy(Result, o+1, c-o-1), ';');
      Replace(M[0], Result, i, c-i+1);
    end;
  until i < 1;
  Result := FilterZerosAndOnes(Result);
  if (Result > '') and (StringToFloat(Result) = 0) then
    Result := '=' + Result; }
end;

procedure FilterSimilarLatRusSymbols(var Str: String; const BWListFN: String);
const
  SimRus = ['�','�','�','�','�','�','�','�','�','�','�'];
  SimLat = ['A','B','C','E','H','K','M','O','P','T','X'];
  SomeSym= ['(', ')', '''', '"', ',', '.', '-', ':', ';', '�'];

//  Neutral: array[0..10] of Char = ('0'..'9'
var
  S, CS, OS: String;
  C: TAsciizCollector;
  i, j: Integer;
  Rus, Lat, NormalLat, Dig, Change: Boolean;
  WhiteContexts, BlackContexts: TStringList;
begin
  S := Str;
  FilterMultipleChars(S, ' ', ' ', 1);
  S := Trim(S);
  if S = '' then begin
    Str := '';
    Exit;
  end;
  if (BWListFN > '') and FileExists(BWListFN) then begin
    WhiteContexts := TStringList.Create;
    BlackContexts := TStringList.Create;
    with TIniFile.Create(BWListFN) do try
      ReadSection('White', WhiteContexts);
      ReadSection('Black', BlackContexts);
    finally
      Free;
    end;
  end else begin
    WhiteContexts := nil;
    BlackContexts := nil;
  end;
  C := StrDistribution(PChar(S), ' ');
  for i := 0 to C.Count-1 do begin
    OS := C.StrAt[i];
    S := AnsiUpperCase(OS);
    Rus := False;
    Lat := False;
    NormalLat := False;
    Dig := False;
    for j := 1 to Length(S) do begin
      if S[j] in RusABC then
        Rus := True
      else
      if (S[j] in LatABC+LatStrABC) then begin
        Lat := True;
        if not(S[j] in SimLat) then
          NormalLat := True;
      end else
      if S[j] in Digits then
        Dig := True;
    end;
    Change := False;
    if Lat and not NormalLat and not Dig then begin
      if not Rus then begin
        CS := S;
        while (Length(CS) > 0) and (CS[1] in SomeSym) do
          Delete(CS, 1, 1);
        while (Length(CS) > 0) and (CS[Length(CS)] in SomeSym) do
          Delete(CS, Length(CS), 1);
        Change := (CS = 'MOX') or (CS = 'BEC') or (CS = 'BCE') or (CS = 'BCEX')
          or (CS = 'CTPAH') or (CS = 'CTPAHA') or (CS = 'MOHO') or (CS = 'HOMEP')
          or (CS = 'HOMEPA') or (CS = 'PEMOHT') or (CS = 'MEPA') or (CS = 'TEPMOMETP')
          or (CS = 'KAMEPA') or (CS = 'TOP') or (CS = 'KPECT') or (CS = 'TPECT')
          or (CS = 'CTEHA') or (CS = 'CTEH') or (CS = 'CTEHE') or (CS = 'CTEHKA')
          or (CS = 'OTCOC') or (CS = 'MECTE') or (CS = 'MECTAX') or (CS = 'HACOCOM')
          or (CS = 'HACOCOB') or (CS = 'TEPMOMETPOM') or (CS = 'HA') or (CS = 'CO')
          or (CS = 'TOM') or (CS = 'COCTABA') or (CS = 'COCTABE') or (CS = 'OTCOCA')
          or (CS = 'KBT') or (CS = 'OT') or (CS = 'T') or (CS = 'M') or (CS = 'MM')
          or (CS = 'K') or (CS = 'B') or (CS = 'O') or (CS = 'BO') or (CS = 'C')
          or (CS = 'PACTBOPOB') or (CS = 'PACTBOPA') or (CS = 'MHC') or (CS = 'CETKA')
          or (CS = 'METAHTEHK') or (CS = 'HACOC') or (CS = 'COCTAB') or (CS = 'XP.')
          or ((WhiteContexts <> nil) and (WhiteContexts.IndexOf(CS) >= 0));
        if not Change then 
          if not((CS = 'PC') or (CS = 'MAK-MAT') or ((BlackContexts <> nil) and (BlackContexts.IndexOf(CS) >= 0))) then begin
            MessageBeep(MB_ICONEXCLAMATION);
            Change := (MessageBox(Application.Handle, PChar(CS), '������?',
                                  MB_ICONQUESTION or MB_YESNO or MB_TOPMOST) = IDYES);
          end;
      end else
        Change := True;
    end;
    if Change then
      for j := 1 to Length(S) do begin
        case S[j] of
          'A': CS := '�';
          'B': CS := '�';
          'C': CS := '�';
          'E': CS := '�';
          'H': CS := '�';
          'K': CS := '�';
          'M': CS := '�';
          'O': CS := '�';
          'P': CS := '�';
          'T': CS := '�';
          'X': CS := '�';
          else CS := S[j];
        end;
        if OS[j] in RusStrABC + LatStrABC then OS[j] := AnsiLowerCase(CS)[1] else OS[j] := CS[1];        
      end;
    C.StrAt[i] := OS;
  end;
  Str := C.TotString(' ');
  C.Free;
  if WhiteContexts <> nil then FreeAndNil(WhiteContexts);
  if BlackContexts <> nil then FreeAndNil(BlackContexts);
end;

procedure FilterFourChars(var Str: String);
var
  CS: String;
  i, L: Integer;
  Change, Small: Boolean;
begin
  L := Length(Str);
  for i := 1 to L do begin
    Change := False;
    if (Str[i] = '4') and (i > 1) and (i < L) then begin
      CS := AnsiLowerCase(Copy(Str, i-1, 3));
      Change := (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             or (CS = '�4�') or (CS = '�4�') or (CS = '�4�')
             ;
      Small := Change and (AnsiLowerCase(Str[i-1]+Str[i+1]) = Str[i-1]+Str[i+1]);
    end;
    if not Change and (Str[i] = '4') and (i < L-1) then begin
      CS := AnsiLowerCase(Copy(Str, i, 3));
      Change := (CS = '4��') or (CS = '4��') or (CS = '4��') or (CS = '4��')
             or (CS = '4��') or (CS = '4��') or (CS = '4��') or (CS = '4��')
             or (CS = '4��') or (CS = '4��') or (CS = '4��')
             ;
      Small := Change and (AnsiLowerCase(Str[i+1]+Str[i+2]) = Str[i+1]+Str[i+2]);
    end;
    if not Change and (Str[i] = '4') and (i > 2) then begin
      CS := AnsiLowerCase(Copy(Str, i-2, 3));
      Change := (CS = '��4') or (CS = '��4')
             ;
      Small := Change and (AnsiLowerCase(Str[i-1]) = Str[i-1]);
    end;
    if Change then
      if Small then Str[i] := '�'
               else Str[i] := '�'; 
  end;
end;

function FindDualBrackets(const Str: String; OpenChar, CloseChar: Char;
  var OpenPos: Integer): Integer;
var
  L, i, C: Integer;
begin
  Result := 0;
  L := Length(Str);
  if OpenPos < 1 then OpenPos := 1;
  while (OpenPos <= L) and (Str[OpenPos] <> OpenChar) do Inc(OpenPos);
  if OpenPos >= L then begin
    OpenPos := 0;
    Exit;
  end;
  C := 1; i := OpenPos;
  while (i < L) and (C > 0) do begin
    Inc(i);
    if Str[i] = OpenChar then Inc(C)
    else
    if Str[i] = CloseChar then Dec(C);
  end;
  if C = 0 then Result := i;
end;

function FindOpenBracket(const Str: String; OpenChar, CloseChar: Char; var ClosePos: Integer): Integer;
var
  L, i, C: Integer;
begin
  Result := 0;
  if ClosePos > Length(Str) then ClosePos := Length(Str);
  if ClosePos < 1 then Exit;
  while (ClosePos > 0) and (Str[ClosePos] <> CloseChar) do Dec(ClosePos);
  if ClosePos = 0 then Exit;
  C := 1; i := ClosePos;
  while (i > 0) and (C > 0) do begin
    Dec(i);
    if Str[i] = OpenChar then Dec(C)
    else
    if Str[i] = CloseChar then Inc(C);
  end;
  if C = 0 then Result := i;
end;

function EgualSignCut(const Str: String): String;
begin
  if (Str > '') and (Str[1] = '=') then
    Result := Copy(Str, 2, Length(Str)-1) else Result := Str;
end;

function ExtractBoundedText(const Str, LeftBound, RightBound, Prefix, Postfix: String): String;
var
  l, r, LB: Integer;
begin
  l := Pos(LeftBound, Str);

  r := PosEx(RightBound, Str, l);

  LB := Length(LeftBound);
  if (l > 0) and (r > 0) then
    Result := Prefix + Copy(Str, l+LB, r-l-LB) + Postfix else Result := '';
end;

function StrDistributionEx(const Str: String; Sep: Char; DelEmpty: Boolean): TAsciizCollector;
var
  i: Integer;
  S: String;
begin
  Result := StrDistribution(PChar(Str), Sep);
  i := 0;
  while i < Result.Count do begin
    S := Result.StrAt[i];
    DeleteSpaces(S);
    if S > '' then begin
      Result.StrAt[i] := S;
      Inc(i);
    end else Result.Delete(i);
  end;
end;

function StrToArray(const Str: String; Sep: Char): DStringArray;
var
  i: Integer;
  A: TAsciizCollector;
begin
  A := StrDistribution(PChar(Str), Sep);
  SetLength(Result, A.Count);
  for i := 0 to A.Count-1 do
    Result[i] := A.StrAt[i];
  A.Free;
end;

function ArrayToStr(const StrArr: array of String; Sep: Char = ','): String;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Length(StrArr)-1 do begin
    if i > 0 then Result := Result + Sep;
    Result := Result + StrArr[i];
  end;
end;

function AddStrArray(const StrArr: array of String; var ResultArr: DStringArray): Integer;
var
  L, i: Integer;
begin
  Result := Length(StrArr);
  if Result <= 0 then Exit;
  L := Length(ResultArr);
  SetLength(ResultArr, L+Result);
  for i := 0 to Result-1 do
    ResultArr[L+i] := StrArr[i];
end;

function ArrayIndexOf(const StrVal: String; const StrArr: array of String): Integer;
begin
  for Result := 0 to Length(StrArr)-1 do
    if StrArr[Result] = StrVal then Exit;
  Result := -1;
end;

function AddStringIfNotExist(const S: String; var A: TStringDynArray): integer;
begin
  Result := StrIndexIn(S, A);
  if Result < 0 then
    Result := AddString(S, A);
end;

function InsertString(const S: String; var A: TStringDynArray; Index: integer): integer;
var
  Len,i: integer;
begin
  Result := -1;
  Len := Length(A);
  if Index < 0 then Exit;
  if Index >= Len then
    Result := AddString(S, A)
  else begin
    SetLength(A, Len+1);
    for i := Len-1 downto Index do A[i+1] := A[i];
    A[Index] := S;
    Result := Index;
  end;
end;

function AddStrArray(const S: TStringDynArray; var A: TStringDynArray; OnlyNotExists: Boolean): integer;
var
  i, L: Integer;
begin
  if OnlyNotExists then begin
    for i := 0 to Length(S)-1 do
      AddStringIfNotExist(S[i], A);
  end else begin
    L := Length(A);
    SetLength(A, L+Length(S));
    for i := 0 to Length(S)-1 do
      A[L+i] := S[i];
  end;
end;

function LastStrItem(const Str, Delim: String): String;
var
  A: TStringDynArray;
  L: Integer;
begin
  A := DelimStr(Str, Delim);
  L := Length(A);
  if L > 0 then Result := A[L-1] else Result := '';  
end;

procedure UpdateComboList(ComboList: TStrings; MaxCount: Integer;
                          const NewItem: String; ClearList: Boolean = False);
begin
  if NewItem = '' then Exit;
  with ComboList do begin
    if ClearList then Clear;
    if IndexOf(NewItem) < 0 then Insert(0, NewItem)
    else Move(IndexOf(NewItem), 0);
    if Count > MaxCount then Delete(Count-1);
  end;
end;

procedure UpdateComboList(ComboBox: TCustomComboBox; MaxCount: Integer;
                          const NewItem: String; ClearList: Boolean = False);
begin
  UpdateComboList(ComboBox.Items, MaxCount, NewItem, ClearList);
  if ComboBox.Items.Count > 0 then
    ComboBox.ItemIndex := 0;
end;

procedure Delay(Delta: Cardinal);
var
  i: Cardinal;
begin
  i := GetTickCount;
  while GetTickCount < i+Delta do;
end;

procedure WaitFor(ATime: Cardinal);
var
  i: Cardinal;
begin
  i := GetTickCount;
  if ATime > i then Delay(ATime-i);
end;

function DeltaFunc(Value: Extended): Integer;
begin
  if Value = 0 then Result := 1
               else Result := 0;
end;

function DeltaFunc(Value: Int64): Integer;
begin
  if Value = 0 then Result := 1
               else Result := 0;
end;

function Positive(Value: Extended): Integer;
begin
  if Value > 0 then Result := 1
               else Result := 0;
end;

function Positive(Value: Int64): Integer;
begin
  if Value > 0 then Result := 1
               else Result := 0;
end;

function Signum(Value: Extended): Integer;
begin
  if Value > 0 then Result := 1 else
  if Value < 0 then Result := -1
               else Result := 0;
end;

function Signum(Value: Int64): Integer;
begin
  if Value > 0 then Result := 1 else
  if Value < 0 then Result := -1
               else Result := 0;
end;

function CalcCRC(const S: String): Cardinal;
var
  i: Integer;
begin
  Result := 0;
  for i := 1 to Length(S) do
    Result := Result + Ord(S[i]);        
end;

function RandomRange(const AFrom, ATo: Integer): Integer;
begin
  if AFrom > ATo then
    Result := Random(AFrom - ATo) + ATo
  else
    Result := Random(ATo - AFrom) + AFrom;
end;

function GetFlagsList(Flags: Integer): TIntegerDynArray;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to 31 do
    if Flags and (1 shl i) > 0 then
      AddInteger(1 shl i, Result);
end;

function ExpandRelativeFileName(const FileName, BasePath: String): String;
var
  CP: String;
begin
  try
    if (BasePath = '') or not DirectoryExists(BasePath) then
      Result := ExpandUNCFileName(FileName)
    else begin
      CP := GetCurrentDir;
      try
        if SetCurrentDir(BasePath) then
          Result := ExpandUNCFileName(FileName) else
          Result := FileName;
      finally
        SetCurrentDir(CP);
      end;
    end;
  except
    Result := FileName;
  end;
end;

function GetUnexistedFileName(const FileName, FileExt: String): String; overload;
var
  P, S, E: String;
begin
  P := ExtractFilePath(FileName);
  S := ExtractShortFileName(FileName);
  if FileExt = 'Original extension' then E := ExtractFileExt(FileName)
                                    else E := FileExt;
  Result := GetUnexistedFileName(P, S, E);
end;

function GetUnexistedFileName(const Path, ShortFileName, Ext: String): String; overload;
var
  P: String;
  N: Integer;
begin
  N := 1;
  P := Path;
  if P = '' then P := StartPath;
  if P[Length(P)] <> '\' then P := P + '\';
  while FileExists(P + ShortFileName + IntToStr(N) + Ext) do Inc(N);
  Result := P + ShortFileName + IntToStr(N) + Ext;
end;

function StrFileTime(const FileName: String): String;
var
  A: Integer;
begin
  A := FileAge(FileName);
  if A <> -1 then
    Result := FormatDateTime('dd.mm.yy hh:mm', FileDateToDateTime(A)) else Result := '';
end;

function IsNullFile(const FileName: String): Boolean;
var
  F: Text;
begin
  Result := True;
  AssignFile(F, FileName); Reset(F);
  try
    Result := EOF(F);//FileSize(F) = 0;
  finally
    CloseFile(F);
  end;
end;

function FileSizeByName(const FileName: String): Int64;
var
  H: THandle;
begin
  H := CreateFile(PChar(FileName), GENERIC_READ,
                  0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if H = INVALID_HANDLE_VALUE then Exit;
  Int64Rec(Result).Lo := GetFileSize(H, @Int64Rec(Result).Hi);
  CloseHandle(H);
end;

function FileTimeByName(const FileName: String): TFileTime;
var
  H: THandle;
begin
  FillChar(Result, SizeOf(TFileTime), 0);
  H := CreateFile(PChar(FileName), GENERIC_READ,
                  0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if H = INVALID_HANDLE_VALUE then Exit;
  GetFileTime(H, nil, nil, @Result);
  CloseHandle(H);
end;

procedure SetFileTimeByName(const FileName: String; FileTime: TFileTime);
var
  H: THandle;
begin
  H := CreateFile(PChar(FileName), GENERIC_WRITE,
                  0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if H = INVALID_HANDLE_VALUE then Exit;
  SetFileTime(H, nil, nil, @FileTime);
  CloseHandle(H);
end;

function DeleteFileEx(const FileName: String): Boolean;
begin
  SetFileAttributes(PChar(FileName), FILE_ATTRIBUTE_NORMAL);
  Result := DeleteFile(FileName);
end;

procedure DeleteFilesWithMask(const FilesMask, FilesPath: String);
var
  SearchRec: TSearchRec;
  FP: String;
begin
  FP := IncludeTrailingBackslash(FilesPath);
  if FindFirst(FP + FilesMask, faAnyFile, SearchRec) = 0 then begin
    repeat
      DeleteFileEx(FP + SearchRec.Name);
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
end;

procedure DeleteFiles(const Dir: String; const FMask: String; SubDirs: Boolean);
var
  SearchRec: TSearchRec;
  FDir, F: String;
begin
  FDir := IncludeTrailingBackslash(Dir);
  DeleteFilesWithMask(FMask, FDir);
  if SubDirs then begin
    if FindFirst(FDir + '*.*', faDirectory, SearchRec) = 0 then begin
      repeat
        F := SearchRec.Name;
        if (SearchRec.Attr and faDirectory > 0) and (F <> '.') and (F <> '..') then
          DeleteFiles(FDir + F, FMask, SubDirs);
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);
    end;
  end;
end;

function EraseDirectory(const Dir: String): Boolean;
var
  SearchRec: TSearchRec;
  FDir, F: String;
begin
  Result := False;
  FDir := IncludeTrailingBackslash(Dir);
  if not DirectoryExists(FDir) then Exit;
  DeleteFilesWithMask('*.*', FDir);
  if FindFirst(FDir + '*.*', faDirectory, SearchRec) = 0 then begin
    repeat
      F := SearchRec.Name;
      if (SearchRec.Attr and faDirectory > 0) and (F <> '.') and (F <> '..') then
        Result := EraseDirectory(FDir + F);
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
  Result := RemoveDir(FDir);
end;

function CopyFiles(const SDir, DDir, FMask: String): Boolean;
var
  FSDir, FDDir, F: String;
  SearchRec: TSearchRec;
begin
  Result := False;
  if not DirectoryExists(SDir) then Exit;
  if not DirectoryExists(DDir) then ForceDirectories(DDir);
  FSDir := IncludeTrailingBackslash(SDir);
  FDDir := IncludeTrailingBackslash(DDir);
  if FindFirst(FSDir + FMask, faAnyFile, SearchRec) = 0 then begin
    repeat
      F := SearchRec.Name;
      if SearchRec.Attr and faDirectory = 0 then
        Windows.CopyFile(PChar(FSDir + F), PChar(FDDir + F), False);
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
  Result := True;
end;

function MoveFiles(const SDir, DDir, FMask: String): Boolean;
begin
  Result := CopyFiles(SDir, DDir, FMask);
  if Result then DeleteFilesWithMask(FMask, SDir);
end;

function CopyFilesEx(const SDir, DDir: String): Boolean;
var
  FSDir, FDDir, F: String;
  SearchRec: TSearchRec;
  DirList: TStringList;
  FileList: TStringList;
  i: Integer;
begin
  Result := False;
  if not DirectoryExists(SDir) then Exit;
  FSDir := IncludeTrailingBackslash(SDir);
  FDDir := IncludeTrailingBackslash(DDir);
  DirList := TStringList.Create;
  FileList := TStringList.Create;
  try
    if FindFirst(FSDir + '*.*', faAnyFile, SearchRec) = 0 then begin
      repeat
        F := SearchRec.Name;
        if SearchRec.Attr and faDirectory = 0 then
          FileList.Add(F)
        else if (F <> '.') and (F <> '..') then
          DirList.Add(F);
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);
    end;
    if not DirectoryExists(DDir) then ForceDirectories(DDir);
    for i := 0 to FileList.Count-1 do
      Windows.CopyFile(PChar(FSDir + FileList[i]), PChar(FDDir + FileList[i]), False);
    for i := 0 to DirList.Count-1 do
      CopyFilesEx(FSDir + DirList[i], FDDir + DirList[i]);
  finally
    FileList.Free;
    DirList.Free;
  end;
  Result := True;
end;

function MoveFilesEx(const SDir, DDir: String): Boolean;
var
  FSDir, F: String;
  SearchRec: TSearchRec;
  DirList: TStringList;
  i: Integer;
begin
  Result := False;
  if not DirectoryExists(SDir) then Exit;
  FSDir := IncludeTrailingBackslash(SDir);
  DirList := TStringList.Create;
  try
    if FindFirst(FSDir + '*.*', faDirectory, SearchRec) = 0 then begin
      repeat
        F := SearchRec.Name;
        if (SearchRec.Attr and faDirectory > 0) and (F <> '.') and (F <> '..') then
          DirList.Add(F);
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);
    end;
    Result := CopyFilesEx(SDir, DDir);
    if Result then begin
      DeleteFilesWithMask('*.*', FSDir);
      for i := 0 to DirList.Count-1 do
        EraseDirectory(FSDir + DirList[i]);
    end;
  finally
    DirList.Free;
  end;
end;

function CopyFileTime(const SFN, DFN: String; Newer: Boolean = True): Boolean;
begin
  Result := False;
  if not FileExists(DFN) or (ExtractFileName(SFN) <> ExtractFileName(DFN))
    or (Newer = (FileDateToDateTime(FileAge(SFN)) > FileDateToDateTime(FileAge(DFN)))) then
    Result := Windows.CopyFile(PChar(SFN), PChar(DFN), False);
end;

function CopyFilesTime(const SDir, DDir: String; Newer: Boolean = True): Boolean;
var
  SR: TSearchRec;
  FSDir, FDDir: String;
begin
  Result := False;
  FSDir := SDir;
  FDDir := DDir;
  if (FSDir > '') and (FSDir[Length(FSDir)] <> '\') then FSDir := FSDir + '\';
  if (FDDir > '') and (FDDir[Length(FDDir)] <> '\') then FDDir := FDDir + '\';
  if FindFirst(FSDir + '*.*', faAnyFile, SR) = 0 then begin
    repeat
      if SR.Attr and faDirectory = 0 then
        Result := Result or CopyFileTime(FSDir + SR.Name, FDDir + SR.Name);
    until FindNext(SR) <> 0;
    FindClose(SR);
  end;
end;

function FilterEndStrSymbol(const SrcFN, DstFN: String): Boolean;
var
  S: TFileStream;
  B: PChar;
  Size: Integer;
begin
  Result := False;
  if not FileExists(SrcFN) then Exit;
  S := TFileStream.Create(SrcFN, fmOpenRead);
  try
    Size := S.Size;
    GetMem(B, Size);
    S.Read(B^, Size);
  finally
    S.Free;
  end;
  S := TFileStream.Create(DstFN, fmCreate);
  try
    FilterChar(B, #10, #13);
    S.Write(B^, Size);
    Result := True;
  finally
    S.Free;
    FreeMem(B);
  end;
end;

function GetFilesCount(const Dir: String; IncludeDirs, Nested: Boolean): Integer;
var
  SR: TSearchRec;
  FDir: String;
begin
  Result := 0;
  if not DirectoryExists(Dir) then Exit;
  FDir := IncludeTrailingBackslash(Dir);
  if FindFirst(FDir + '*.*', faAnyFile, SR) = 0 then begin
    repeat
      if SR.Attr and faDirectory = 0 then
        Inc(Result) else
      if (SR.Name <> '.') and (SR.Name <> '..') then begin
        if IncludeDirs then
          Inc(Result);
        if Nested then
          Inc(Result, GetFilesCount(FDir + SR.Name, IncludeDirs, Nested));
      end;
    until FindNext(SR) <> 0;
    FindClose(SR);
  end;
end;

function GetCurrentUser: String;
var
  B: pointer;
  S: Cardinal;
begin
  S := 255;
  GetMem(B, S);
  GetUserName(B, S);
  Result := PChar(B);
  FreeMem(B);
end;

function CopyFilesToClipboard(const AFileList: String; ASep: Char): Boolean;
var
  DropFiles: PDropFiles;
  H: THandle;
  L: Integer;
  FileList: String;
begin
  Result := False;
  FileList := AFileList;
  FilterChar(PChar(FileList), ASep, #0);
  FileList := FileList + #0#0;
  L := Length(FileList);
  H := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT, SizeOf(TDropFiles) + L);
  if H <> 0 then begin
    DropFiles := Windows.GlobalLock(H);
    DropFiles^.pFiles := SizeOf(TDropFiles);
    Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, L);
    Windows.GlobalUnlock(H);
    Clipboard.SetAsHandle(CF_HDROP, H);
    Result := True;
  end;
end;

function GetFilesFromClipboard(ASep: Char): String;
var
  H: THandle;
  B: array [0..MAX_PATH] of Char;
  i, numFiles: Integer;
begin
  Result := '';
  if not Clipboard.HasFormat(CF_HDROP) then Exit;
  H := Clipboard.GetAsHandle(CF_HDROP);
  if H <> 0 then begin
    numFiles := DragQueryFile(H, $FFFFFFFF, nil, 0);
    for i := 0 to numfiles - 1 do begin
      B[0] := #0;
      DragQueryFile(H, i, B, SizeOf(B));
      if Result > '' then Result := Result + ASep;
      Result := Result + B;
    end;
  end;
end;

function ReadParam(const IniFile: TIniFile; const Section, Ident, Default: String;
                   Sep: Char; Count: Integer): TAsciizCollector;
var
  i, C: Integer;
  S: String;
begin
  S := IniFile.ReadString(Section, Ident, Default);
  if S = '' then S := Default;  
  Result := StrDistribution(PChar(S), Sep);
  C := Result.Count;
  for i := C to Count-1 do
    Result.StrAt[i] := Default;
end;

{ TIntegerList }

procedure TIntegerList.Add(Int: Integer);
begin
  if not FDuplicates and (IndexOf(Int) >= 0) then Exit;
  Inc(FCount);
  ReallocMem(FList, FCount*SizeOf(Integer));
  FList^[FCount-1] := Int;
end;

procedure TIntegerList.AddAt(N, Int: Integer);
begin
  if not FDuplicates and (IndexOf(Int) >= 0) then Exit;
  if (N < 0) or (N > FCount) then Exit;
  Add(Int);
  Move(FCount-1, N);
end;

procedure TIntegerList.Assign(L: TIntegerList);
var
  i: Integer;
begin
  Clear;
  for i := 0 to L.Count-1 do Add(L[i]);
end;

procedure TIntegerList.Clear;
var
  i: Integer;
  OldCount: Integer;
begin
  OldCount := FCount;
  if FList <> nil then
    for i := 0 to FCount-1 do
      Delete(0);
//  FCount := 0;
end;

procedure TIntegerList.ClearDupes;
var
  i: Integer;
  U: TIntegerDynArray;
begin
  U := nil;
  i := 0;
  while i < FCount do begin
    if IntegerIndexIn(FList^[i], U) < 0 then begin
      AddInteger(FList^[i], U);
      Inc(i);
    end else
      Delete(i);
  end;
end;

constructor TIntegerList.Create;
begin
  inherited Create;
  FDuplicates := True;
  FCount := 0;
end;

procedure TIntegerList.Delete(N: Integer);
begin
  if FCount = 0 then Exit;
  Move(N, FCount-1);
  Dec(FCount);
  ReallocMem(FList, FCount*SizeOf(Integer));
end;

destructor TIntegerList.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TIntegerList.GetCount: Integer;
begin
  Result := FCount;
end;

function TIntegerList.GetInt(Index: Integer): Integer;
begin
  Result := 0;
  if (Index < 0) or (Index > FCount-1) then Exit;
  Result := FList^[Index];
end;

function TIntegerList.IndexOf(Int: Integer): Integer;
begin
  for Result := 0 to FCount-1 do
    if FList^[Result] = Int then Exit;
  Result := -1;
end;

procedure TIntegerList.LoadFromArray(A: TIntegerDynArray);
var
  i: Integer;
begin
  Clear;
  for i := 0 to Length(A)-1 do
    Add(A[i]);
end;

procedure TIntegerList.Move(From, Where: Integer);
var
  i: Integer;
  Int: Integer;
begin
  Int := FList^[From];
  if From > Where then
    for i := From downto Where+1 do
      FList^[i] := FList^[i-1]
  else if From < Where then
    for i := From to Where-1 do
      FList^[i] := FList^[i+1];
  FList^[Where] := Int;
end;

procedure TIntegerList.Offset(StartIndex, HowMuch: Integer);
var
  i: Integer;
begin
  if (HowMuch = 0) or (StartIndex < 0) then Exit;
  for i := StartIndex to FCount-1 do
    FList^[i] := FList^[i] + HowMuch;
end;

procedure TIntegerList.PutInt(Index, Value: Integer);
begin
  if (Index < 0) or (Index > FCount-1) then Exit;
  FList^[Index] := Value;
end;

function TIntegerList.SelfToArray: TIntegerDynArray;
var
  i: Integer;
begin
  SetLength(Result, Count);
  for i := 0 to Count-1 do
    Result[i] := Items[i]; 
end;

procedure TIntegerList.Sort(SortType: TSortType);
var
  i, j: Integer;
begin
  for i := 1 to FCount-1 do
    case SortType of
      stInc: begin
        j := i;
        while (j > 0) and (FList^[i] < FList^[j-1]) do Dec(j);
        Move(i, j);
      end;
      stDec: begin
        j := i;
        while (j > 0) and (FList^[i] > FList^[j-1]) do Dec(j);
        Move(i, j);
      end;
    end;
end;

{ TLargeIniFile }

procedure TLargeIniFile.ReadSection(const Section: string; Strings: TStrings);
const
  BufSize = 16384*8;  
var
  Buffer, P: PChar;
begin
  GetMem(Buffer, BufSize);
  try
    Strings.BeginUpdate;
    try
      Strings.Clear;
      if GetPrivateProfileString(PChar(Section), nil, nil, Buffer, BufSize, PChar(FileName)) <> 0 then
      begin
        P := Buffer;
        while P^ <> #0 do
        begin
          Strings.Add(P);
          Inc(P, StrLen(P) + 1);
        end;
      end;
    finally
      Strings.EndUpdate;
    end;
  finally
    FreeMem(Buffer, BufSize);
  end;
end;

function TLargeIniFile.ReadString(const Section, Ident, Default: string): string;
var
  Buffer: array[0..8191] of Char;
begin
  SetString(Result, Buffer, GetPrivateProfileString(PChar(Section),
    PChar(Ident), PChar(Default), Buffer, SizeOf(Buffer), PChar(FileName)));
end;

end.