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

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

interface

Uses SysUtils,StrUtils,Math,Variants,Classes,Types,TypInfo,RTLConsts,Dialogs,
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF}
{$IFDEF LINUX}
Types,
Libc,
{$ENDIF}
SysConst;

const

  InvalidHandle: cardinal =$FFFFFFFF;

  MaxBufLevel = 20;
  BufMasks: array [0..MaxBufLevel] of longint= (
    0,
    (1 shl 1)-1,
    (1 shl 2)-1,
    (1 shl 3)-1,
    (1 shl 4)-1,
    (1 shl 5)-1,
    (1 shl 6)-1,
    (1 shl 7)-1,
    (1 shl 8)-1,
    (1 shl 9)-1,
    (1 shl 10)-1,
    (1 shl 11)-1,
    (1 shl 12)-1,
    (1 shl 13)-1,
    (1 shl 14)-1,
    (1 shl 15)-1,
    (1 shl 16)-1,
    (1 shl 17)-1,
    (1 shl 18)-1,
    (1 shl 19)-1,
    (1 shl 20)-1);

  StdDelims= [' ','.',',',':',';','-','+','=','*','&','"','?','/','!','\','(',')','[',']','{','}','�','%','_','@','$','^','<','>','�','�'];
  SpaceChars= [#3,#26,' ',#13,#10,#9];
  AnyDelims=StdDelims+SpaceChars;

type

  TByteSet= Set of byte;
  PByteSet= ^TByteSet;
  TCharSet= TSysCharSet;
  TAnsiCharSet= Set of AnsiChar;
  TItemsSearchOder= (isoFromBeginning,isoFromEnd);

  TGetProcAddr= function(const ProcName: string): Pointer;
  TGetProcAddrStd= function(const ProcName: string): Pointer; stdcall;
  TObjGetProcAddr= function(const ProcName: string): Pointer of object;
  TSortCompare= function(const X1,X2; Params: pointer): integer; // := X1-X2
  TStrCompare= function(const Str1,Str2: string): Integer;
  TStrEquals= function(const Str1,Str2: string): Boolean;
  TFilterCompare= function(const X; Params: pointer): boolean;
  TStrArrayItemConvert= function(const Str: string; I: integer; Params: pointer): string;

  TGetItemAddr= function(H: cardinal): pointer of object;

  PCardinalArray= ^TCardinalArray;
  TCardinalArray= array[0..((MaxInt div SizeOf(cardinal))-1)] of cardinal;
  PIntegerArray = ^TIntegerArray;
  TIntegerArray= array[0..((MaxInt div SizeOf(cardinal))-1)] of integer;

  TAnsiStringDynArray= array of AnsiString;
  TVarRecDynArray= array of TVarRec;
  TPointerDynArray= array of pointer;
  TPTypeInfoDynArray= array of PTypeInfo;
  PCorrSortRec= ^TCorrSortRec;
  TCorrSortRec= record
    Factor: double;
    case integer of
      0: (Data: pointer);
      1: (Tag : integer);
  end;

  TStrParam= record
    Name,Value: string;
  end;

  TStrParamArray= array of TStrParam;

  TDualChar = array[0..1] of Char;

  PStrBuf = ^TStrBuf;
  TStrBuf = record
    Buf: PChar;
    Len: Integer;
    function Str: string;
    function StrComp(AStr: string): Integer;
    function TextComp(AStr: string): Integer;
    procedure Pass(AChars: TSysCharSet);
  end;

  TStrBufArray= array of TStrBuf;

  TBuffer = record
    Data: Pointer;
    Size: Integer;
    class function Create(ASize: Integer) : TBuffer; overload; static;
    class function Create(const Source; ASize: Integer) : TBuffer; overload; static;
  end;

  TBufPtr = record
  private
    FBuf,FPtr: Pointer;
    procedure SetBuf(ABuf: Pointer);
    function GetPos: Integer;
    procedure SetPos(APos: Integer);
    function GetVInt: Integer;
    procedure SetVInt(AValue: Integer);
    function GetVPtr: Pointer;
    procedure SetVPtr(AValue: Pointer);
    function GetVFloat: Double;
    procedure SetVFloat(AValue: Double);
  public
    class function New(ABuf: Pointer): TBufPtr; static;
    function Alloc(ASize: Integer): Pointer;
    function Realloc(ASize: Integer): Pointer;
    procedure Free;
    procedure StoreInt(const AValues: array of Integer);
    procedure Store(const ASource; ACount: Integer);
    function Align(ASize: Integer=4): Integer;
    function Insert(APos,ACount: Integer): Pointer;
    function Copy: Pointer;
    property Buf: Pointer read FBuf write SetBuf;
    property Ptr: Pointer read FPtr;
    property Pos: Integer read GetPos write SetPos;
    property VInt: Integer read GetVInt write SetVInt;
    property VPtr: Pointer read GetVPtr write SetVPtr;
    property VFloat: Double read GetVFloat write SetVFloat;
  end;

function GetStrParamVal(const Name: string; const Params: array of TStrParam): string;
function ParamsFromStr(const Str: string; const PmDelim: string=';'; const EqDelim: string='='): TStrParamArray;
function ArgStrToVarArray(const Args: string): Variant;
function ArgStrToVar(const Arg: string): Variant;

function MayBeIdentifier(Buf: PChar; Len: Integer): Boolean;
function ExtractBrCont(var Str: string; const Brackets: array of Char): string;
function ExprCharPos(const Chars: TSysCharSet; Buf: PChar; Len: Integer; Pos: Integer=0; Brackets: Boolean=true): Integer;
function ExprStrPos(const Str: string; Buf: PChar; Len: Integer; Pos: Integer=0; Brackets: Boolean=true): Integer;
function DelimExpr(Delim: Char; Buf: PChar; Len: Integer): TStrBufArray;
function StrBufArrayToStrArray(BufArray: TStrBufArray): TStringDynArray;																		
function IsCorrectBrackets(Buf: PChar; Len: Integer; const Brackets: array of Char): Boolean;
procedure TrimExprText(var Buf: PChar; var Len:integer);
function TrimBrackets(var Buf: PChar; var Len: Integer; const Brackets: array of Char): Boolean;
function DoTrimBrackets(var Buf: PChar; var Len:integer; const Brackets: array of Char): Integer;

function StoreInt(Buf: Pointer; Value: Integer): Pointer; overload;
function StoreInt(Buf: Pointer; const Values: array of Integer): Pointer; overload;
function StorePtr(Buf: Pointer; Value: Pointer): Pointer;
function AbsInt(X: Integer): Integer;
function WordArrayToPtr(const A: array of word): TPointerDynArray;
function ByteArrayToPtr(const A: array of byte): TPointerDynArray;
function IntArrayToPtr(const A: array of integer): TPointerDynArray;
function StrArrayToPtr(const A: array of string): TPointerDynArray;
procedure SwapDWords(Buffer: pointer; Count: cardinal);
procedure FillDWord(Value: DWORD; var Buf; Count: cardinal);
procedure DWCopy(const Src; var Dst; Count: Integer);
function DWStore(Buf: Pointer; const Src; Count: Integer): Pointer;
function ConstsToVarRecs(const A: array of const): TVarRecDynArray;
procedure SortBuffer(Buffer: pointer; Count: cardinal; Compare: TSortCompare; Params: pointer); overload;
procedure SortBuffer(Buffer: pointer; Count: cardinal; Get: TGetItemAddr; Compare: TSortCompare; Params: pointer); overload;
function FilterBuffer(Buffer,Dest: pointer; Count: cardinal; Compare: TFilterCompare; Params: pointer): cardinal; overload;
function FilterBuffer(Buffer,Dest: pointer; Count: cardinal; Get: TGetItemAddr; Compare: TFilterCompare; Params: pointer): cardinal;  overload;
function SearchBuffer(Buffer: pointer; Count,ItemSize: cardinal; Compare: TFilterCompare; Params: pointer; Pos: cardinal=0): pointer; overload;
function SearchBuffer(Buffer: pointer; Count: cardinal; Compare: TFilterCompare; Params: pointer; Pos: cardinal=0): pointer; overload;
function CheckFreeMem(var P: pointer): boolean;
function IsNullBuffer(const Buffer; BufSize: integer): boolean;
function GetCurTime:Extended;
function GetCPUTacts: int64;
function GetSelfDir: string;
function BytePos(X: byte; Buffer: pointer; Count: integer): integer;
function GetFileList(const Dir,FileMask: string; FileAttr: integer=faAnyFile-faDirectory): TStringDynArray;
function NewFileName(const FileName,Prefix,NewExt: string): string;
function VarBytesFromBuf(const Buf; Size: integer): Variant;
function VarBytesToBuf(const VarBytes: Variant; var Buf; BufSize: integer=0): boolean;
function StrToVarBytes(const Str: PAnsiChar): Variant;
function PStrFromVarBytes(const V: Variant): PAnsiChar;
function VarArrayLength(const V: Variant; Dim: integer=1): integer;
function IntToBin(Value: integer; Digits: integer): string;
function AnsiStrFromBuf(const Buf; Len: integer): AnsiString;

type TContextSearchMode= (csmAny,csmBeginWord,csmWholeWord);
function StrReplaceContext(const Str,Old,New: string; SearchMode: TContextSearchMode=csmAny; IgnoreCase: boolean=true): string;
function StrSearchContextAll(const Str,Context: string; SearchMode: TContextSearchMode; IgnoreCase: boolean): TIntegerDynArray;
function CharsPrefixLen(const Str: string; const Chars: TCharSet; Pos: integer=1): integer;
function ReplaceChars(const Str: string; const OldChars: TCharSet; NewChar: Char): string;
function GetCharsCount(const Str: string; const Chars: TCharSet): integer;
function CharsPos(const Chars: TSysCharSet; Buf: PChar; Len: integer): integer; overload;
function CharsPos(const Chars: TSysCharSet; const Str: string): integer; overload;
function CutNumStr(const Str: string; Digits,FDigits: integer): string;
function FloatToStrFlt(const Value: Extended; FDigits: Integer; Digits: Integer=15; Exp: Integer=64; DecSep: Char='.'): string;
function IsNumericStr(const Str: string): boolean;
function StrToExtended(const Str: string): extended;
function StrToDouble(const Str: string): double;
function StrToCurrency(const Str: string): currency;
function SearchDelim(Delim: byte; var Buf: pointer; Len: integer): integer; overload;
function SearchDelim(Delim: byte; Buf: pointer; var Len: integer; Index: integer): pointer; overload;
function FilterEmptyStrings(const A: array of string): TStringDynArray;
function StrArrayConvert(const A: array of string; Convert: TStrArrayItemConvert; Params: pointer): TStringDynArray;
function ConcatStrArray(const A: array of string; const Delim: string): string;
function StrArrayToList(const A: array of string): TStringList;
function StrArrayFilterEmpty(const A: array of string): TStringDynArray;
function IntArrayToStr(const A: array of integer; const Delim: string): string;
function IntArrayFromStr(const Str,Delim: string): TIntegerDynArray;
function CopyToDelim(const Str,Delim: string; Index: integer): string;
function SearchToDelim(const Str,Delim: string; Index: integer): integer;
function ExtractStrItem(const Str,Delim: string; Index: integer): string;
function ReplaceStrItem(const Str,Delim,Value: string; Index: integer): string;
function ExtractToDelim(const Str,Delim: string; var P: integer): string;
function DelimStr(const Str,Delim: string): TStringDynArray;
function CheckStrItem(const A: array of string; Index: integer): string;
function StrIndexIn(const S: string; const A: array of string): integer;
function StrPrefixIndexIn(const S: string; const A: array of string): integer;
function CopyStrArray(const A: array of string): TStringDynArray;
function StrArrayFromVar(const A: Variant): TStringDynArray;
function StrArrayToVar(const A: array of string): Variant;
function AnsiStrFromFile(const FileName: string): AnsiString;
procedure AnsiStrToFile(const FileName: string; const Str: AnsiString);
function StringsFromText(var T: Text): TStringDynArray;
function AddString(const S: String; var A: TStringDynArray): integer; overload;
function AddString(const S: String; var A: TStringDynArray; P: integer): integer; overload;
function AddAnsiString(const S: AnsiString; var A: TAnsiStringDynArray; P: integer): integer;
procedure DeleteArrayItems(var A: TStringDynArray; Index,Count: integer);
function ExtractNumStrPrefix(var Str: string; const Default: string=''): string;
function StrFilter(const Str: string; Filter: TSysCharSet; Avail: boolean): string;
function StrFilterDelims(const Str: string; Delims: TSysCharSet= StdDelims): string;
function StrFilterSpace(Str: PChar; Len: Integer; Filter: TSysCharSet): string; overload;
function StrFilterSpace(Str: string; Filter: TSysCharSet): string; overload;
function ContextWeight(const CtxStr,Str: string; var MaxWeight: double): double;
function StrCorrCompare(const Str1,Str2: string): double;
function StrCorrCompareText(const Str1,Str2: string; Delims: TSysCharSet=StdDelims): double;
function ExtractTxtCorrExt(const Str1,Str2: string; FCorr: double): string;
function MayBeEqualWords(const Word1,Word2: string; const SingleEnds,PluralEnds: array of string): boolean;
function LowBitPos(X: cardinal): cardinal;
function HighBitPos(X: cardinal): cardinal;
function LowBitMask(X: cardinal): cardinal;
function HighBitMask(X: cardinal): cardinal;
function LowBitMask64(X: int64): int64;
function HighBitMask64(X: int64): int64;
function BitMaskFor(X: cardinal): cardinal;
function BitMaskFor64(X: int64): int64;
function BitCount(X: cardinal): cardinal;
function BitCount64(X: int64): cardinal;
function FileOpenEx(const FileName: string; Mode: LongWord; Flags: LongWord): Integer;
function FileCreateEx(const FileName: string; Flags: LongWord): Integer; overload;
function FileCreateEx(const FileName: string; Rights: Integer; Flags: LongWord): Integer; overload;

type

  TSpinLocker= class(TObject)
  private
    FLockFlag: integer;
    FLockFlagReserved: array[1..64-SizeOf(integer)] of byte;
  public
    class procedure LockFlag(var AFlag: integer);
    class procedure UnlockFlag(var AFlag: integer);
    procedure Lock;
    procedure Unlock;
  end;

  UIntPtr = cardinal;
  IntPtr  = LPARAM;

  TPageMemoryStream = class(TStream)
  private
    FSize : longint;
    FPosition: longint;
    FBufList: TList;
    FLevel: word;
    function GetCapacity: longint;
  public
    constructor Create(ALevel: word);
    destructor Destroy; override;
    procedure SetSize(NewSize: Longint); override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

  TFileStreamEx = class(THandleStream)
  strict private
    FFileName: string;
  public
    constructor Create(const AFileName: string; Mode: Word; Flags: LongWord); overload;
    constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal; Flags: LongWord); overload;
    function ReadOverlap(Pos: int64; var Buffer; Count: Longint): Longint;
    destructor Destroy; override;
    property FileName: string read FFileName;
  end;


implementation

{ TStrBuf }

function TStrBuf.Str: string;
begin
  if (Buf<>nil) and (Len>0) then SetString(Result,Buf,Len) else Result:='';
end;

function TStrBuf.StrComp(AStr: string): Integer;
begin
  Result:=StrLComp(Buf,PChar(AStr),Max(Len,Length(AStr)));
end;

function TStrBuf.TextComp(AStr: string): Integer;
begin
  Result:=StrLIComp(Buf,PChar(AStr),Max(Len,Length(AStr)));
end;

procedure TStrBuf.Pass(AChars: TSysCharSet);
begin
  while (Len>0) and (Buf^ in AChars) do
    begin
      Inc(Buf);
      Dec(Len);
    end;
end;


{ TBuffer }

class function TBuffer.Create(ASize: Integer): TBuffer;
begin
  Result.Size:=ASize;
  GetMem(Result.Data,Result.Size);
end;


class function TBuffer.Create(const Source; ASize: Integer): TBuffer;
begin
  Result:=Create(ASize);
  Move(Source,Result.Data^,ASize);
end;

{ TBufPtr }

procedure TBufPtr.SetBuf(ABuf: Pointer);
begin
  FBuf:=ABuf;
  FPtr:=ABuf;
end;

function TBufPtr.GetPos: Integer;
begin
  Result:=NativeInt(FPtr)-NativeInt(FBuf);
end;

procedure TBufPtr.SetPos(APos: Integer);
begin
  FPtr:=FBuf;
  Inc(PByte(FPtr),APos);
end;

function TBufPtr.GetVInt: Integer;
begin
  Result:=Integer(FPtr^);
  Inc(PInteger(FPtr));
end;

procedure TBufPtr.SetVInt(AValue: Integer);
begin
  Integer(FPtr^):=AValue;
  Inc(PInteger(FPtr));
end;

function TBufPtr.GetVPtr: Pointer;
begin
  Result:=Pointer(FPtr^);
  Inc(PPointer(FPtr));
end;

procedure TBufPtr.SetVPtr(AValue: Pointer);
begin
  Pointer(FPtr^):=AValue;
  Inc(PPointer(FPtr));
end;

function TBufPtr.GetVFloat: Double;
begin
  Result:=Double(FPtr^);
  Inc(PDouble(FPtr));
end;

procedure TBufPtr.SetVFloat(AValue: Double);
begin
  Double(FPtr^):=AValue;
  Inc(PDouble(FPtr));
end;

class function TBufPtr.New(ABuf: Pointer): TBufPtr;
begin
  Result.FBuf:=ABuf;
  Result.FPtr:=ABuf;
end;

function TBufPtr.Alloc(ASize: Integer): Pointer;
begin
  GetMem(Result,ASize);
  Buf:=Result;
end;

function TBufPtr.Realloc(ASize: Integer): Pointer;
var
  O: Integer;
begin
  O:=Pos;
  ReallocMem(FBuf,ASize);
  if O<=ASize then Pos:=O else Pos:=ASize;
  Result:=FBuf;
end;

procedure TBufPtr.Free;
begin
  if FBuf<>nil then FreeMem(FBuf);
  Buf:=nil;
end;

procedure TBufPtr.StoreInt(const AValues: array of Integer);
begin
  FPtr:=DWStore(Ptr,AValues,Length(AValues));
  //FPtr:=Functions.StoreInt(FPtr,AValues);
end;

procedure TBufPtr.Store(const ASource; ACount: Integer);
begin
  Move(ASource,Ptr^,ACount);
  Inc(PByte(FPtr),ACount);
end;

function TBufPtr.Align(ASize: Integer): Integer;
begin
  Result:=Pos and (ASize-1);
  if Result<>0 then
    begin
      Result:=ASize-Result;
      FillChar(FPtr^,Result,0);
      Inc(PByte(FPtr),Result);
    end;
end;

function TBufPtr.Insert(APos, ACount: Integer): Pointer;
var
  P: Pointer;
begin
  Result:=FBuf;
  Inc(PByte(Result),APos);
  P:=Result;
  Inc(PByte(P),ACount);
  System.Move(Result^,P^,GetPos);
  Inc(PByte(FPtr),ACount);
end;

function TBufPtr.Copy: Pointer;
var
  S: Integer;
begin
  S:=Pos;
  GetMem(Result,S);
  Move(Buf^,Result^,S);
end;

function GetStrParamVal(const Name: string; const Params: array of TStrParam): string;
var
  I: Integer;
begin
  for I := 0 to Length(Params) - 1 do
    if AnsiSameText(Name,Params[I].Name) then
      begin
        Result:=Params[I].Value;
        Exit;
      end;
  Result:='';
end;

function ParamsFromStr(const Str,PmDelim,EqDelim: string): TStrParamArray;
var
  S: string;
  L,P,X,R: Integer;
begin
  L:=Length(Str);
  SetLength(Result,(L div Length(PmDelim))+1);
  P:=1;
  R:=0;
  while P<=L do
    begin
      S:=ExtractToDelim(Str,PmDelim,P);
      X:=Pos(EqDelim,S);
      if X>0 then
        begin
          Result[R].Name:=Copy(S,1,X-1);
          X:=X+Length(EqDelim);
          Result[R].Value:=Copy(S,X,Length(S)-X+1);
        end
          else
        Result[R].Name:=S;
      Inc(R);
    end;
  SetLength(Result,R);
end;

function ExtractStrArg(var A: string): Boolean;
var
  L: Integer;
begin
  L:=Length(A);
  Result:=(L>=2) and (A[1]='"') and (A[L]='"');
  if Result then A:=Copy(A,2,L-2);
end;

function BufArrayToStrArray(const A: TStrBufArray): TStringDynArray;
var
  L,I: Integer;
begin
  L:=Length(A);
  SetLength(Result,L);
  for I := 0 to L - 1 do
    Result[I]:=A[I].Str;
end;

function ArgStrToVarArray(const Args: string): Variant;
var
  S: string;
  L,I: Integer;
  T: TStrBufArray;
begin
  S:=Trim(Args);
  T:=DelimExpr(',',PChar(S),Length(S));
  L:=Length(T);
  if L>0 then
    begin
      Result:=VarArrayCreate([0,L-1],varVariant);
      for I := 0 to L - 1 do Result[I]:=ArgStrToVar(T[I].Str);
    end
      else
    Result:=NULL;
end;

function ExtractArrayArg(const A: string; var R: Variant): Boolean;
var
  L: Integer;
begin
  L:=Length(A);
  Result:=(L>=2) and (A[1]='[') and (A[L]=']');
  if Result then R:=ArgStrToVarArray(Copy(A,2,L-2));
end;

function ArgStrToVar(const Arg: string): Variant;
var
  I: Integer;
  F: Double;
  A: string;
begin
  A:=Trim(Arg);
  if A='' then Result:=NULL else
  if ExtractArrayArg(Arg,Result) then Exit else
  if ExtractStrArg(A) then Result:=A else
  if TryStrToInt(Arg,I) then Result:=I else
  if TryStrToFloat(A,F) then Result:=F else
  Result:=NULL;
end;

function MayBeIdentifier(Buf: PChar; Len: Integer): Boolean;
begin
  Result:=(Len>0) and (Buf^ in ['A'..'Z','a'..'z']);
  if Result then
    begin
      Dec(Len);
      while (Len<>0) and (Buf[Len] in ['0'..'9','A'..'Z','a'..'z','_']) do Dec(Len);
      Result:=Len=0;
    end;
end;

function ExtractBrCont(var Str: string; const Brackets: array of Char): string;
var
  P,L: Integer;
begin
  L:=Length(Str);
  if not(L=0) and (Str[L]=Brackets[1]) then
    begin
      P:=Pos(Brackets[0],Str);
      if not(P=0) then
        begin
          Result:=Copy(Str,P+1,L-P-1);
          SetLength(Str,P-1);
        end;
    end;
end;

function ExprCharPos(const Chars: TSysCharSet; Buf: PChar; Len,Pos: Integer; Brackets: Boolean): Integer;
var
  T: Boolean;
  C: Integer;
  Chr: Char;
begin
  T:=true;
  C:=0;
  for Result := Pos to Len-1 do
    begin
      Chr:=Buf[Result];
      case Chr of
        '"': begin T:=not(T); Continue; end;
        '(','[','{': if (T) and (Brackets) then begin Inc(C); Continue; end;
        ')',']','}': if (T) and (Brackets) then begin Dec(C); Continue; end;
      end;
      if T and (C=0) and (Chr in Chars) then Exit;
    end;
  Result:=-1;
end;

function ExprStrPos(const Str: string; Buf: PChar; Len: Integer; Pos: Integer; Brackets: Boolean): Integer;
var
  S: PChar;
  C: TSysCharSet;
  L: Integer;
begin
  S:=PChar(Str);
  L:=Length(Str);
  C:=[S^];
  Len:=Len-L+1;
  Result:=Pos;
  while Result<Len do
    begin
      Result:=ExprCharPos(C,Buf,Len,Result,Brackets);
      if (Result>=0) and (StrLComp(S,Buf+Result,L)<>0) then Inc(Result) else Exit;
    end;
  Result:=-1;
end;

function DelimExpr(Delim: Char; Buf: PChar; Len: Integer): TStrBufArray;
var
  P,L,S: Integer;
begin
  if Len=0 then Exit;
  SetLength(Result,Len+1);
  L:=0;
  S:=0;
  P:=ExprCharPos([Delim],Buf,Len,0);
  while P>=0 do
    begin
      Result[L].Buf:=Buf+S;
      Result[L].Len:=P-S;
      Inc(L);
      S:=P+1;
      P:=ExprCharPos([Delim],Buf,Len,S);
    end;
  Result[L].Buf:=Buf+S;
  Result[L].Len:=Len-S;
  SetLength(Result,L+1);
end;

function StrBufArrayToStrArray(BufArray: TStrBufArray): TStringDynArray;
var
  I: Integer;
begin
  SetLength(Result,Length(BufArray));
  for I := 0 to Length(Result)-1 do Result[I]:=BufArray[I].Str;
end;
function IsCorrectBrackets(Buf: PChar; Len: Integer; const Brackets: array of Char): Boolean;
var
  T: Boolean;
  C: Integer;
begin
  T:=true;
  C:=0;
  while Len<>0 do
    begin
      Dec(Len);
      if Buf^='"' then T:=not(T) else
      if (Buf^=Brackets[0]) and T then Inc(C) else
      if (Buf^=Brackets[1]) and T then begin Dec(C); if C<0 then Break; end;
      Inc(Buf);
    end;
  Result:=C=0;
end;

procedure TrimExprText(var Buf: PChar; var Len:integer);
begin
  while (Len<>0) and (Buf^ in SpaceChars) do
    begin
      Dec(Len);
      Inc(Buf);
    end;
  while (Len<>0) and (Buf[Len-1] in SpaceChars) do Dec(Len);
end;

function TrimBrackets(var Buf: PChar; var Len:integer; const Brackets: array of Char): Boolean;
begin
  Result:=(Len>=2) and (Buf^=Brackets[0]) and (Buf[Len-1]=Brackets[1]) and IsCorrectBrackets(Buf+1,Len-2,Brackets);
  if Result then
    begin
      Inc(Buf);
      Dec(Len,2);
    end;
end;

function DoTrimBrackets(var Buf: PChar; var Len:integer; const Brackets: array of Char): Integer;
begin
  Result:=-1;
  repeat
    Inc(Result);
    TrimExprText(Buf,Len);
  until not(TrimBrackets(Buf,Len,Brackets));
end;


function StoreInt(Buf: Pointer; Value: Integer): Pointer;
begin
  Result:=Buf;
  Integer(Result^):=Value;
  Inc(PInteger(Result));
end;

function StoreInt(Buf: Pointer; const Values: array of Integer): Pointer;
var
  I: Integer;
begin
  Result:=Buf;
  for I := Low(Values) to High(Values) do
    begin
      Integer(Result^):=Values[I];
      Inc(PInteger(Result));
    end;
end;

function StorePtr(Buf: Pointer; Value: Pointer): Pointer;
begin
  Result:=Buf;
  Pointer(Result^):=Value;
  Inc(PPointer(Result));
end;

function AbsInt(X: Integer): Integer;
asm
      TEST      EAX,$80000000
      JZ        @Exit
      NEG       EAX
@Exit:
end;

function PointersFrom(Buffer: pointer; Count: integer; ItemSize: cardinal): TPointerDynArray;
begin
  SetLength(Result,Count);
  for Count:=0 to Length(Result)-1 do
    begin
      Result[Count]:=Buffer;
      inc(cardinal(Buffer),ItemSize);
    end;
end;

function WordArrayToPtr(const A: array of word): TPointerDynArray;
begin
  Result:=PointersFrom(@A,Length(A),SizeOf(word));
end;

function ByteArrayToPtr(const A: array of byte): TPointerDynArray;
begin
  Result:=PointersFrom(@A,Length(A),SizeOf(byte));
end;

function IntArrayToPtr(const A: array of integer): TPointerDynArray;
begin
  Result:=PointersFrom(@A,Length(A),SizeOf(integer));
end;

function StrArrayToPtr(const A: array of string): TPointerDynArray;
begin
  Result:=PointersFrom(@A,Length(A),SizeOf(string));
end;

procedure SwapDWords(Buffer: pointer; Count: cardinal);
var
  P: PCardinal;
  T: cardinal;
begin
  P:=pointer(cardinal(Buffer)+((Count-1) shl 2));
  for Count:=(Count shr 1) downto 1 do
    begin
      T:=P^;
      P^:=cardinal(Buffer^);
      cardinal(Buffer^):=T;
      dec(cardinal(P),4);
      inc(cardinal(Buffer),4);
    end;
end;

procedure FillDWord(Value: DWORD; var Buf; Count: cardinal);
asm
      JECXZ     @Ex
      PUSH      EDI
      MOV       EDI,EDX
      REP       STOSD
      POP       EDI
@Ex:
end;

procedure DWCopy(const Src; var Dst; Count: Integer);
asm
      JECXZ     @Exit
      PUSH      ESI
      MOV       ESI,EAX
      MOV       EAX,EDI
      MOV       EDI,EDX
      REP       MOVSD
      MOV       EDI,EAX
      POP       ESI
@Exit:
end;

function DWStore(Buf: Pointer; const Src; Count: Integer): Pointer;
asm
      JECXZ     @Exit
      PUSH      ESI
      MOV       ESI,EDX
      MOV       EDX,EDI
      MOV       EDI,EAX
      REP       MOVSD
      MOV       EAX,EDI
      MOV       EDI,EDX
      POP       ESI
@Exit:
end;

function ConstsToVarRecs(const A: array of const): TVarRecDynArray;
var
  L,i: integer;
begin
  L:=Length(A);
  SetLength(Result,L);
  for i := L-1 downto 0 do
    Result[i]:=TVarRec(A[i]);
end;

procedure QSort(Buffer: PCardinalArray; L, R: Integer; Compare: TSortCompare; Params: pointer);
var
  I, J: integer;
  P, T: cardinal;
begin
  repeat
    I := L;
    J := R;
    P := Buffer^[(L + R) shr 1];
    repeat
      while Compare(Buffer^[I], P,Params) < 0 do
        Inc(I);
      while Compare(Buffer^[J], P,Params) > 0 do
        Dec(J);
      if I <= J then
      begin
        if I <> J then
        begin
          T := Buffer^[I];
          Buffer^[I] := Buffer^[J];
          Buffer^[J] := T;
        end;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QSort(Buffer, L, J, Compare,Params);
    L := I;
  until I >= R;
end;

type

  THandleSortRec= record
    GetAddr: TGetItemAddr;
    Compare   : TSortCompare;
    CompareParams : pointer;
  end;

  THandleFilterRec= record
    GetAddr: TGetItemAddr;
    Compare: TFilterCompare;
    CompareParams : pointer;
  end;

function SortGetCompare(const X1,X2; Params: pointer): integer;
begin
  with THandleSortRec(Params^) do
    Result:=Compare(GetAddr(cardinal(X1))^,GetAddr(cardinal(X2))^,CompareParams);
end;

function FilterGetCompare(const X; Params: pointer): boolean;
begin
  with THandleFilterRec(Params^) do
    Result:=Compare(GetAddr(cardinal(X))^,CompareParams);
end;

procedure SortBuffer(Buffer: pointer; Count: cardinal; Compare: TSortCompare; Params: pointer);
begin
  if Count>1 then QSort(Buffer,0,Count-1,Compare,Params);
end;

procedure SortBuffer(Buffer: pointer; Count: cardinal; Get: TGetItemAddr; Compare: TSortCompare; Params: pointer);
var
  R: THandleSortRec;
begin
  R.GetAddr:=Get;
  R.Compare:=Compare;
  R.CompareParams:=Params;
  SortBuffer(Buffer,Count,SortGetCompare,@R);
end;

function FilterBuffer(Buffer,Dest: pointer; Count: cardinal; Compare: TFilterCompare; Params: pointer): cardinal;
var
  i: cardinal;
begin
  Result:=0;
  if Count>0 then
    for i:= 0 to Count - 1 do
      begin
        if Compare(Buffer^,Params) then
          begin
            cardinal(Dest^):=cardinal(Buffer^);
            inc(Result);
            inc(cardinal(Dest),SizeOf(cardinal));
          end;
        inc(cardinal(Buffer),SizeOf(cardinal));
      end;
end;

function FilterBuffer(Buffer,Dest: pointer; Count: cardinal; Get: TGetItemAddr; Compare: TFilterCompare; Params: pointer): cardinal;
var
  R: THandleFilterRec;
begin
  R.GetAddr:=Get;
  R.Compare:=Compare;
  R.CompareParams:=Params;
  Result:=FilterBuffer(Buffer,Dest,Count,FilterGetCompare,@R);
end;

function SearchBuffer(Buffer: pointer; Count,ItemSize: cardinal; Compare: TFilterCompare; Params: pointer; Pos: cardinal): pointer;
begin
  Result:=nil;
  Buffer:=pointer(cardinal(Buffer)+(Pos*ItemSize));
  while (Result=nil) and not(Count=Pos) do
    if not(Compare(Buffer^,Params)) then
      begin
        inc(cardinal(Buffer),ItemSize);
        dec(Count);
      end
        else
      Result:=Buffer;
end;

function SearchBuffer(Buffer: pointer; Count: cardinal; Compare: TFilterCompare; Params: pointer; Pos: cardinal): pointer;
begin
  Result:=SearchBuffer(Buffer,Count,SizeOf(DWORD),Compare,Params,Pos);
end;

function CheckFreeMem(var P: pointer): boolean;
begin
  Result:=P<>nil;
  if Result then
    begin
      FreeMem(P);
      P:=nil;
    end;
end;

function IsNullBuffer(const Buffer; BufSize: integer):boolean;assembler;
asm
      PUSH    EDI
      MOV     EDI,EAX
      XOR     EAX,EAX
      MOV     ECX,EDX
      REPE    SCASB
      JNE     @Exit
      OR      EAX,1
@Exit:
      POP     EDI
end;

function GetCurTime:Extended;
var
  Hour,Min,Sec,MSec: word;
  T: TDateTime;
begin
  T:=Time;
  DecodeTime(T,Hour, Min, Sec, MSec);
  Result:=Hour*3600+Min*60+Sec+MSec*0.001;
end;

function GetCPUTacts: int64; assembler;
asm
      RDTSC
end;

function GetSelfDir: string;
begin
  Result:=ExtractFileDir(GetModuleName(HInstance));
end;

function GetFileList(const Dir,FileMask: string; FileAttr: integer): TStringDynArray;
var
  SR: TSearchRec;
  Cnt: integer;
begin
  Cnt:=0;
  if SysUtils.FindFirst(IncludeTrailingPathDelimiter(Dir)+FileMask,FileAttr,SR)=0 then
    begin
      repeat
        Cnt:=AddString(SR.Name,Result,Cnt);
      until SysUtils.FindNext(SR)<>0;
      SysUtils.FindClose(SR);
      SetLength(Result,Cnt);
    end;
end;

function NewFileName(const FileName,Prefix,NewExt: string): string;
var
  T,E: string;
begin
  Result:=ExtractFilePath(FileName);
  if (Result>'') and (Result[Length(Result)]<>'\') then Result:=Result+'\';
  T:=ExtractFileName(FileName);
  if NewExt>'' then
    begin
      E:=ExtractFileExt(FileName);
      if E>'' then T:=Copy(T,1,Length(T)-Length(E));
      T:=T+NewExt;
    end;
  Result:=Result+Prefix+T;
end;

function BytePos(X: byte; Buffer: pointer; Count: integer): integer; assembler;
asm
  push          EDI
  or            ECX,ECX
  jz            @Fail
  mov           EDI,EDX
  cld
  repne scasb
  jne           @Fail
  mov           EAX,EDI
  sub           EAX,EDX
  dec           EAX
  jmp           @End
@Fail:
  mov           EAX,-1
@End:
  pop           EDI
end;

function DWordPos(X: LongWord; Buffer: pointer; Count: integer): integer; assembler;
asm
        PUSH        EDI
        JECXZ       @NotFound
        MOV         EDI,EDX
        REPNE       SCASD
        JNE         @NotFound
        MOV         EAX,EDI
        SUB         EAX,EDX
        SHR         EAX,2
        DEC         EAX
        JMP         @End
@NotFound:
        MOV         EAX,-1
@End:
        POP         EDI
end;

function VarBytesFromBuf(const Buf; Size: integer): Variant;
var
  B: pointer;
begin
  Result:=VarArrayCreate([0,Size-1],varByte);
  B:=VarArrayLock(Result);
  Move(Buf,B^,Size);
  VarArrayUnlock(Result);
end;

function VarBytesToBuf(const VarBytes: Variant; var Buf; BufSize: integer): boolean;
var
  B: pointer;
  L: integer;
begin
  Result:=(VarType(VarBytes)=varArray or varByte) and (VarArrayDimCount(VarBytes)=1);
  if Result then
    begin
      L:=VarArrayLength(VarBytes);
      Result:=(BufSize=0) or (L=BufSize);
      if Result then
        begin
          B:=VarArrayLock(VarBytes);
          Move(B^,Buf,L);
          VarArrayUnlock(VarBytes);
        end;
    end;
end;

function StrToVarBytes(const Str: PAnsiChar): Variant;
var
  L: integer;
  B: PByteArray;
begin
  L:=StrLen(Str);
  Result:=VarArrayCreate([0,L],varByte);
  B:=VarArrayLock(Result);
  Move(Str^,B^,L);
  B[L]:=0;
  VarArrayUnlock(Result);
end;

function PStrFromVarBytes(const V: Variant): PAnsiChar;
begin
  if (VarType(V)=varByte or varArray) and (VarArrayDimCount(V)=1) then
    begin
      Result:=VarArrayLock(V);
      VarArrayUnLock(V);
    end
      else
    Result:=nil;
end;

function VarArrayLength(const V: Variant; Dim: integer): integer;
begin
  if VarIsArray(V) then
    begin
      Result:=VarArrayHighBound(V,Dim)-VarArrayLowBound(V,Dim)+1;
    end
      else
    Result:=0;
end;

function IntToBin(Value: integer; Digits: integer): string;
begin
  if (Digits<=0) or (Digits>32) then Digits:=32;
  SetLength(Result,Digits);
  while Digits<>0 do
    begin
      if (Value and 1)=0 then Result[Digits]:='0' else Result[Digits]:='1';
      dec(Digits);
      Value:=Value shr 1;
    end;
end;

function AnsiStrFromBuf(const Buf; Len: integer): AnsiString;
begin
  SetLength(Result,Len);
  Move(Buf,PAnsiChar(Result)^,Len);
end;

function StrReplaceContext(const Str,Old,New: string; SearchMode: TContextSearchMode; IgnoreCase: boolean): string;
var
  F: TReplaceFlags;
begin
  if Old='' then begin Result:=Str; Exit; end;
  if IgnoreCase then F:=[rfReplaceAll, rfIgnoreCase] else F:=[rfReplaceAll];
  case SearchMode of
    csmAny: Result:=StringReplace(Str,Old,New,F);
    csmBeginWord:
      begin
        Result:=StringReplace(' '+Str,' '+Old,' '+New,F);
        Result:=copy(Result,2,Length(Result)-1);
      end;
    csmWholeWord:
      begin
        Result:=StringReplace(' '+Str+' ',' '+Old+' ',' '+New+' ',F);
        Result:=copy(Result,2,Length(Result)-2);
      end;
  end;
end;

function StrSearchContextAll(const Str,Context: string; SearchMode: TContextSearchMode; IgnoreCase: boolean): TIntegerDynArray;
var
  S,C: string;
  P,L,A: integer;
begin
  SetLength(Result,(Length(Str) div Length(Context))+1);
  if IgnoreCase then
    begin
      S:=AnsiUpperCase(Str); C:=AnsiUpperCase(Context);
    end
      else
    begin
      S:=Str; C:=Context;
    end;
  A:=Length(C);
  case SearchMode of
    csmAny: ;
    csmBeginWord: begin S:=' '+S; C:=' '+C; inc(A); end;
    csmWholeWord: begin S:=' '+S+' '; C:=' '+C+' '; inc(A); end;
  end;
  L:=0; P:=Pos(C,S);
  while not(P=0) do
    begin
      Result[L]:=P;
      inc(L);
      P:=PosEx(C,S,P+A);
    end;
  SetLength(Result,L);
end;

function ReplaceChars(const Str: string; const OldChars: TCharSet; NewChar: Char): string;
var
  I: integer;
begin
  Result:=Str;
  for I := 1 to Length(Result) do
    if Result[I] in OldChars then Result[I]:=NewChar;
end;

function GetCharsCount(const Str: string; const Chars: TCharSet): integer;
var
  I: integer;
begin
  Result:=0;
  for I := 1 to Length(Str) do
    if Str[I] in Chars then inc(Result);
end;

function CharsPrefixLen(const Str: string; const Chars: TCharSet; Pos: integer): integer;
var
  I: integer;
begin
  Result:=0;
  for I := Pos to Length(Str) do
    if Str[I] in Chars then inc(Result)
      else Break;
end;

function CharsPos(const Chars: TSysCharSet; Buf: PChar; Len: integer): integer;
begin
  for Result := 0 to Len-1 do
    if Buf^ in Chars then Exit else Inc(Buf);
  Result:=-1;
end;

function CharsPos(const Chars: TSysCharSet; const Str: string): integer;
begin
  Result:=CharsPos(Chars,PChar(Str),Length(Str))+1;
end;

function CutNumStr(const Str: string; Digits,FDigits: integer): string;
var
  P,N,L: integer;
begin
  Result:=Str;
  P:=CharsPos(['.',','],Str);
  if P>0 then
    begin
      L:=Length(Str);
      N:=L-Integer(Str[1]='-')-1;
      if N>Digits then
        begin
          N:=N-Digits;
          if N<L-P then Delete(Result,L-N+1,N) else Delete(Result,P,L-P+1);
        end;
      L:=Length(Result);
      if (L-P)>FDigits then
        begin
          if FDigits=0 then Result:=Copy(Result,1,P-1) else Result:=Copy(Result,1,P+FDigits);
        end;
    end;
end;

function FloatToStrFlt(const Value: Extended; FDigits,Digits,Exp: Integer; DecSep: Char): string;
var
  R: TFloatRec;
  I,L,E: Integer;
  P: PChar;
begin
  FloatToDecimal(R,Value,fvExtended,18,20);
  if (R.Exponent=-32768) or (R.Exponent=32767) then Exit;
  E:=R.Exponent;
  L:=20;
  for I := 0 to 20 do
    if R.Digits[I]=#0 then
      begin
        L:=I;
        Break;
      end;
  if (L>Digits) and ((L-E)>FDigits) then
    begin
      L:=Digits;
      if R.Digits[Digits]>='5' then
        begin
          for I := Digits-1 downto 0 do
            begin
              if R.Digits[I]<'9' then
                begin
                  Inc(R.Digits[I]);
                  Break;
                end
                  else
                L:=I;
              if L=0 then
                begin
                  L:=1;
                  R.Digits[0]:='1';
                  Inc(E);
                end;
            end;
        end
          else
        begin
          for I := Digits -1 downto 0 do
            if R.Digits[I]='0' then L:=I else Break;
        end;
    end;
  if L=0 then
    begin
      Result:='0';
      Exit;
    end;
  if AbsInt(E)>=Exp then
    begin
      SetLength(Result,L+3+Integer(R.Negative));
      P:=PChar(Result);
      if R.Negative then
        begin
          P^:='-';
          Inc(P);
        end;
        P^:='0'; Inc(P);
        P^:=DecSep; Inc(P);
        Move(R.Digits,P^,L*SizeOf(Char));
        P[L]:='E';
        Result:=Result+IntToStr(E);
        Exit;
    end;
  if E<=0 then
    begin
      SetLength(Result,L-E+2+Integer(R.Negative));
      P:=PChar(Result);
      if R.Negative then Inc(P);
      I:=2-E;
      FillChar(P^,I,'0');
      P[1]:=DecSep;
      Inc(P,I);
      Move(R.Digits,P^,L*SizeOf(Char));
    end
      else
    if E>=L then
      begin
        SetLength(Result,E+Integer(R.Negative));
        P:=PChar(Result);
        if R.Negative then Inc(P);
        Move(R.Digits,P^,L*SizeOf(Char));
        Inc(P,L);
        FillChar(P^,E-L,'0');
      end
        else
      begin
        SetLength(Result,L+Integer(R.Negative)+1);
        P:=PChar(Result);
        if R.Negative then Inc(P);
        Move(R.Digits,P^,E*SizeOf(Char));
        Inc(P,E);
        P^:=DecSep;
        Inc(P);
        Move((@R.Digits[E])^,P^,(L-E)*SizeOf(Char));
      end;
  if R.Negative then Result[1]:='-';
end;

function PrepareStrFloat(const Str: string): string;
var
  Seps: set of Char;
begin
  Seps:=['.',',']-[DecimalSeparator];
  Result:=ReplaceChars(Str,Seps,DecimalSeparator);
end;

function IsNumericStr(const Str: string): boolean;
var
  S: string;
  V: extended;
begin
  S:=PrepareStrFloat(Str);
  Result:=TextToFloat(PChar(S),V,fvExtended);
end;

function StrToExtended(const Str: string): extended;
var
  S: string;
begin
  S:=PrepareStrFloat(Str);
  if not(TextToFloat(PChar(S),Result,fvExtended)) then Result:=0;
end;

function StrToDouble(const Str: string): double;
var
  S: string;
begin
  S:=PrepareStrFloat(Str);
  if not(TryStrToFloat(PChar(S),Result)) then Result:=0;
end;

function StrToCurrency(const Str: string): currency;
var
  S: string;
begin
  S:=PrepareStrFloat(Str);
  if not(TextToFloat(PChar(S),Result,fvCurrency)) then Result:=0;
end;

function SearchDelim(Delim: byte; var Buf: pointer; Len: integer): integer; assembler;
asm
        JECXZ   @FAIL
        PUSH    EDI
        MOV     EDI,[EDX]
        REPNE   SCASB
        JE      @EX
        INC     EDI
@EX:
        MOV     [EDX],EDI
        MOV     EAX,ECX
        POP     EDI
        RET
@FAIL:
        MOV     EAX,-1
        INC     [EDX]
end;

function SearchDelim(Delim: byte; Buf: pointer; var Len: integer; Index: integer): pointer;
begin
  Result:=Buf;
  while (Index>0) do
    begin
      Len:=SearchDelim(Delim,Result,Len);
      if Len=-1 then
        begin
          Result:=nil;
          Break;
        end
          else
        dec(Index);
    end;
end;

function FilterEmptyStrings(const A: array of string): TStringDynArray;
var
  I,L: integer;
begin
  SetLength(Result,Length(A));
  L:=0;
  for I := Low(A) to High(A) do
    if not(Length(A[I])=0) then
      begin
        Result[L]:=A[I];
        inc(L);
      end;
  SetLength(Result,L);
end;

function StrArrayConvert(const A: array of string; Convert: TStrArrayItemConvert; Params: pointer): TStringDynArray;
var
  I: integer;
begin
  SetLength(Result,Length(A));
  for I := 0 to Length(A) - 1 do
    Result[I]:=Convert(A[I],I,Params);
end;

function ConcatStrArray(const A: array of string; const Delim: string): string;
var
  L,i: integer;
  P: pointer;
begin
  L:=Length(A);
  if L>0 then
    begin
      L:=(L-1)*Length(Delim);
      for i := Low(A) to High(A) do L:=L+Length(A[i]);
      Result:=A[0];
      SetLength(Result,L);
      P:=PChar(Result);
      inc(cardinal(P),Length(A[0]));
      for i := Low(A)+1 to High(A) do
        begin
          L:=Length(Delim);
          Move(PChar(Delim)^,P^,L);
          inc(cardinal(P),L);
          L:=Length(A[i]);
          Move(PChar(A[i])^,P^,L);
          inc(cardinal(P),L);
        end;
    end
      else
    Result:='';
end;

function StrArrayToList(const A: array of string): TStringList;
var
  I: integer;
begin
  Result:=TStringList.Create;
  for I := Low(A) to High(A) do Result.Add(A[I]);
end;

function StrArrayFilterEmpty(const A: array of string): TStringDynArray;
var
  L,I: Integer;
begin
  L:=0;
  SetLength(Result,Length(A));
  for I := 0 to Length(A) - 1 do
    if Length(A[I])>0 then
      begin
        Result[L]:=A[I];
        Inc(L);
      end;
  SetLength(Result,L);
end;

function IntArrayToStrArray(const A: array of integer): TStringDynArray;
var
  I: integer;
begin
  SetLength(Result,Length(A));
  for I := 0 to Length(A)-1 do
    Result[I]:=IntToStr(A[I]);
end;

function StrArrayToIntArray(const A: array of string): TIntegerDynArray;
var
  I: integer;
begin
  SetLength(Result,Length(A));
  for I := 0 to Length(A)-1 do
    Result[I]:=StrToIntDef(A[I],0);
end;

function IntArrayToStr(const A: array of integer; const Delim: string): string;
var
  S: TStringDynArray;
begin
  S:=IntArrayToStrArray(A);
  Result:=ConcatStrArray(S,Delim);
end;

function IntArrayFromStr(const Str,Delim: string): TIntegerDynArray;
var
  S: TStringDynArray;
begin
  S:=DelimStr(Str,Delim);
  Result:=StrArrayToIntArray(S);
end;

function SearchToDelim(const Str,Delim: string; Index: integer): integer;
var
  LDelim: integer;
begin
  Result:=1;
  LDelim:=Length(Delim);
  while (Index>0) and (Result>0) do
    begin
      Result:=PosEx(Delim,Str,Result);
      if not(Result=0) then
        begin dec(Index); inc(Result,LDelim); end;
    end;
end;

function CopyToDelim(const Str,Delim: string; Index: integer): string;
begin
  Result:=Copy(Str,1,SearchToDelim(Str,Delim,Index));
end;

function ExtractToDelim(const Str,Delim: string; var P: integer): string;
var
  X: integer;
begin
  X:=PosEx(Delim,Str,P);
  if X=0 then X:=Length(Str)+1;
  Result:=Copy(Str,P,X-P);
  P:=X+Length(Delim);
end;

function ExtractStrItem(const Str,Delim: string; Index: integer): string;
var
  P: integer;
begin
  P:=SearchToDelim(Str,Delim,Index);
  if P>0 then Result:=ExtractToDelim(Str,Delim,P) else Result:='';
end;

function ReplaceStrItem(const Str,Delim,Value: string; Index: integer): string;
var
  P,L: integer;
begin
  P:=SearchToDelim(Str,Delim,Index);
  if P>0 then
    begin
      L:=PosEx(Delim,Str,P);
      if L=0 then L:=Length(Str)+1;
      Result:=copy(Str,1,P-1)+Value+copy(Str,L,Length(Str)+1-L);
    end
      else
    Result:=Str;
end;

function DelimStr(const Str,Delim: string): TStringDynArray;
var
  P,X,L,C,D: integer;
begin
  Result:=nil;
  L:=Length(Str);
  if L=0 then Exit;
  D:=Length(Delim);
  SetLength(Result,(L div D)+1);
  C:=0; P:=1;
  inc(L);
  while P<=L do
    begin
      X:=PosEx(Delim,Str,P);
      if X=0 then X:=L;
      Result[C]:=Copy(Str,P,X-P);
      inc(C);
      P:=X+D;
    end;
  SetLength(Result,C);
end;

function CheckStrItem(const A: array of string; Index: integer): string;
begin
  if (Index>=Low(A)) and (Index<=High(A)) then Result:=A[Index]
    else Result:='';
end;

function StrIndexIn(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 S=A[I] then Result:=I else
      inc(I);
end;

function StrPrefixIndexIn(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 Pos(S,A[I])=1 then Result:=I else
      inc(I);
end;

function CopyStrArray(const A: array of string): TStringDynArray;
var
  I,L: integer;
begin
  L:=Length(A);
  SetLength(Result,L);
  for I := 0 to L-1 do Result[I]:=A[I];
end;

function StrArrayFromVar(const A: Variant): TStringDynArray;
var
  L,H,I: integer;
begin
  if (VarIsArray(A)) and (VarArrayDimCount(A)=1) then
    begin
      L:=VarArrayLowBound(A,1);
      H:=VarArrayHighBound(A,1);
      SetLength(Result,H-L+1);
      for I := L to H do Result[I]:=A[I];
    end
      else
    Result:=nil;
end;

function StrArrayToVar(const A: array of string): Variant;
var
  I: integer;
begin
  if Length(A)=0 then
    begin
      Result:=NULL;
      Exit;
    end;
  Result:=VarArrayCreate([Low(A),High(A)],varOleStr);
  for I := Low(A) to High(A) do Result[I]:=A[I];
end;

function AnsiStrFromFile(const FileName: string): AnsiString;
var
  S: TStream;
  X: integer;
begin
  S:=TFileStream.Create(FileName,fmOpenRead);
  X:=S.Size;
  SetLength(Result,X);
  SetLength(Result,S.Read(PAnsiChar(Result)^,X));
  S.Free;
end;

procedure AnsiStrToFile(const FileName: string; const Str: AnsiString);
var
  S: TStream;
begin
  S:=TFileStream.Create(FileName,fmCreate);
  S.Write(PAnsiChar(Str)^,Length(Str));
  S.Free;
end;

function StringsFromText(var T: Text): TStringDynArray;
var
  S: string;
  L: Integer;
begin
  L:=0;
  while not(EOF(T)) do
    begin
      Readln(T,S);
      L:=AddString(S,Result,L);
    end;
  SetLength(Result,L);
end;

function AddString(const S: String; var A: TStringDynArray): integer;
begin
  Result:=Length(A);
  SetLength(A,Result+1);
  A[Result]:=S;
end;

function AddString(const S: String; var A: TStringDynArray; P: integer): integer;
begin
  Result:=P+1;
  if Result>Length(A) then SetLength(A,Result shl 1);
  A[P]:=S;
end;

function AddAnsiString(const S: AnsiString; var A: TAnsiStringDynArray; P: integer): integer;
begin
  Result:=P+1;
  if Result>Length(A) then SetLength(A,Result shl 1);
  A[P]:=S;
end;

procedure DeleteArrayItems(var A: TStringDynArray; Index,Count: integer);
var
  Len,i: integer;
begin
  Len:=Length(A);
  if (Index<0) or (Index>=Len) then Exit;
  if Len-Index<Count then Count:=Len-Index;
  Len:=Len-Count;
  for i:=Index to Len-1 do A[i]:=A[i+Count];
  SetLength(A,Len);
end;

function ExtractNumStrPrefix(var Str: string; const Default: string): string;
begin
  Result:=Copy(Str,1,CharsPrefixLen(Str,['0'..'9']));
  if Result<>'' then
    begin
      Delete(Str,1,Length(Result));
      Delete(Str,1,CharsPrefixLen(Str,[' ']));
    end
      else
    Result:=Default;
end;

function StrFilter(const Str: string; Filter: TSysCharSet; Avail: boolean): string;
var
  I,L: integer;
begin
  SetLength(Result,Length(Str));
  L:=0;
  for I := 1 to Length(Str) do
    if (Str[I] in Filter)=Avail then
      begin
        inc(L);
        Result[L]:=Str[I];
      end;
  SetLength(Result,L);
end;

function StrFilterDelims(const Str: string; Delims: TSysCharSet): string;
begin
  Result:=StrFilter(Str,Delims,false);
end;

function StrFilterSpace(Str: PChar; Len: Integer; Filter: TSysCharSet): string;
var
  L: Integer;
  C: Char;
begin
  if Len>0 then
    begin
      SetLength(Result,Len);
      L:=0;
      C:=Str^;
      while C<>#0 do
        begin
          Inc(L);
          if C in Filter then
            begin
              repeat
                Inc(Str);
              until not(Str^ in Filter);
              Result[L]:=' ';
            end
              else
            begin
              Result[L]:=C;
              Inc(Str);
            end;
          C:=Str^;
        end;
      if L<Len then SetLength(Result,L);
    end;
end;

function StrFilterSpace(Str: string; Filter: TSysCharSet): string;
begin
  Result:=StrFilterSpace(Pchar(Str),Length(Str),Filter);
end;

function StrLPos(Str,Ctx: PChar; CtxLen: integer): PChar;
var
  I: integer;
begin
  Result:=Str;
  while Result^<>#0 do
    begin
      I:=0;
      while Result[I]=Ctx[I] do
        begin
          inc(I);
          if I=CtxLen then Exit;
        end;
      inc(Result);
    end;
  Result:=nil;
end;

function MaxCtxSearch(const CtxStr,Str: string; CtxPos,CtxLen: integer): integer;
var
  S: PChar;
  P: PChar;
  C: Char;
begin
  Result:=0;
  S:=PChar(CtxStr);
  inc(S,CtxPos-1);
  P:=StrLPos(PChar(Str),S,CtxLen);
  while P<>nil do
    begin
      Result:=CtxLen;
      C:=S[CtxLen];
      if C<>#0 then
        begin
          inc(CtxLen);
          if P[Result]<>C then
            begin
              inc(P);
              P:=StrLPos(P,S,CtxLen);
            end;
        end
          else
        P:=nil;
    end;
end;

{function MaxCtxWeight(L: integer): int64; inline;
begin
  Result:=(L*(L+1)) div 2;
end;

function ContextWeight(const CtxStr,Str: string): int64;
var
  P,X,Len,CtxLen: integer;
  Ctx: string;
  R: int64;
begin
  Len:=Length(CtxStr);
  Result:=0;
  CtxLen:=1;
  P:=1;
  while P+CtxLen-1<=Len do
    begin
       X:=MaxCtxSearch(CtxStr,Str,P,CtxLen);
       if X<>0 then
         begin
           Result:=Result+MaxCtxWeight(X)-MaxCtxWeight(CtxLen-1);
           CtxLen:=X;
         end
           else
         if CtxLen>1 then dec(CtxLen);
       inc(P);
    end;
end;

function StrCorrCompare(const Str1,Str2: string): double;
var
  N: int64;
begin
  N:=MaxCtxWeight(Length(Str1))+MaxCtxWeight(Length(Str2));
  if N=0 then Result:=1 else
    Result:=(ContextWeight(Str1,Str2)+ContextWeight(Str2,Str1))/N;
end;}

function ContextWeight(const CtxStr,Str: string; var MaxWeight: double): double;
var
  W: array of double;
  P,X,Len,CtxLen: integer;
  Ctx: string;
begin
  Len:=Length(CtxStr);
  SetLength(W,Len+1);
  W[0]:=0;
  MaxWeight:=0;
  for P := 1 to Len do
    begin
      MaxWeight:=MaxWeight+(1/P);
      W[P]:=W[P-1]+MaxWeight;
    end;
  Result:=0;
  CtxLen:=1;
  P:=1;
  while P+CtxLen-1<=Len do
    begin
       X:=MaxCtxSearch(CtxStr,Str,P,CtxLen);
       if X<>0 then
         begin
           Result:=Result+W[X]-W[CtxLen-1];
           CtxLen:=X;
         end
           else
         if CtxLen>1 then dec(CtxLen);
       inc(P);
    end;
  MaxWeight:=W[Len];
end;

function StrCorrCompare(const Str1,Str2: string): double;
var
  N,N1: double;
begin
  Result:=ContextWeight(Str1,Str2,N)+ContextWeight(Str2,Str1,N1);
  N:=N+N1;
  if not(N=0) then Result:=Result/N;
end;

function StrCorrCompareText(const Str1,Str2: string; Delims: TSysCharSet): double;
begin
  Result:=StrCorrCompare(AnsiUpperCase(StrFilterDelims(Str1,Delims)),AnsiUpperCase(StrFilterDelims(Str2,Delims)));
end;

function ExtractTxtCorrExt(const Str1,Str2: string; FCorr: double): string;
const
  Dels: set of char = [' ','.',',','(',';',':','/','\'];
var
  S: string;
  I,P,L: integer;
  M,F: double;
begin
  Result:='';
  L:=Length(Str2);
  if Length(Str1)>=L then Exit;
  if Str1='' then
    begin
      Result:=Str2;
      Exit;
    end;
  I:=Pos(Str1,Str2);
  if I>0 then
    begin
      I:=I+Length(Str1);
      Result:=Copy(Str2,I,Length(Str2)-I+1);
      Exit;
    end;
  M:=StrCorrCompare(Str1,Str2);
  repeat
    P:=0;
    for I := L downto 2 do
      if Str2[I] in Dels then
        begin
          P:=I-1;
          F:=StrCorrCompare(Str1,Copy(Str2,1,P));
          if F>=M then
            begin
              L:=P;
              M:=F;
            end;
        end;
  until P<L;
  if (M>=FCorr) and (L<Length(Str2)) then Result:=Copy(Str2,L+1,Length(Str2)-L);
end;

function MayBeEqualWords(const Word1,Word2: string; const SingleEnds,PluralEnds: array of string): boolean;
var
  L,I: integer;
  E1,E2: string;
begin
  L:=0;
  for I:=1 to Min(Length(Word1),Length(Word2)) do
    if Word1[I]<>Word2[I] then
      begin
        L:=I-1;
        Break;
      end;
  if (L=Length(Word1)) and (L=Length(Word2)) then
    begin
      Result:=true;
      Exit;
    end;
  if L<2 then
    begin
      Result:=false;
      Exit;
    end;
  E1:=Copy(Word1,L+1,Length(Word1)-L);
  E2:=Copy(Word2,L+1,Length(Word2)-L);
  Result:=((IndexStr(E1,SingleEnds)>=0) or (E1='')) and (IndexStr(E2,PluralEnds)>=0);
  if not(Result) then
    Result:=(IndexStr(E1,PluralEnds)>=0) and ((IndexStr(E2,SingleEnds)>=0) or (E2=''));
end;

{function HighBitPos(X: cardinal): cardinal;
begin
  Result:=0;
  while not(X=0) do
    begin
      inc(Result);
      X:=X shr 1;
    end;
end;

function HighBitMask(X: cardinal): cardinal;
begin
  if not(X=0) then
    begin
      Result:=0;
      repeat
        inc(Result);
        X:=X shr 1;
      until X=0;
      dec(Result);
      Result:=1 shl Result;
    end
      else
    Result:=0;
end;}

function LowBitPos(X: cardinal): cardinal;
asm
  BSF     EAX,EAX
  JZ      @Exit
  INC     EAX
@Exit:
end;

function HighBitPos(X: cardinal): cardinal;
asm
  BSR     EAX,EAX
  JZ      @Exit
  INC     EAX
@Exit:
end;

function LowBitMask(X: cardinal): cardinal;
asm
  BSF     EDX,EAX
  JZ      @Exit
  XOR     EAX,EAX
  BTS     EAX,EDX
@Exit:
end;

function HighBitMask(X: cardinal): cardinal;
asm
  BSR     EDX,EAX
  JZ      @Exit
  XOR     EAX,EAX
  BTS     EAX,EDX
@Exit:
end;

function LowBitMask64(X: int64): int64;
begin
  Int64Rec(Result).Lo:=LowBitMask(Int64Rec(X).Lo);
  if Int64Rec(Result).Lo=0 then Int64Rec(Result).Hi:=LowBitMask(Int64Rec(X).Hi)
    else Int64Rec(Result).Hi:=0;
end;

function HighBitMask64(X: int64): int64;
begin
  if Int64Rec(X).Hi<>0 then
    begin
      Int64Rec(Result).Hi:=HighBitMask(Int64Rec(X).Hi);
      Int64Rec(Result).Lo:=0;
    end
      else
    Result:=HighBitMask(Int64Rec(X).Lo)
end;

function BitMaskFor(X: cardinal): cardinal;
asm
  BSR     EDX,EAX
  JZ      @Exit
  XOR     EAX,EAX
  BTS     EAX,EDX
  SHL     EAX,1
  DEC     EAX
@Exit:
end;

function BitMaskFor64(X: int64): int64;
begin
  if Int64Rec(X).Hi<>0 then
    begin
      Int64Rec(Result).Hi:=BitMaskFor(Int64Rec(X).Hi);
      Int64Rec(Result).Lo:=$FFFFFFFF;
    end
      else
    Result:=BitMaskFor(Int64Rec(X).Lo);
end;

const

BitsSet: array[0..255] of byte= (
  0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4,
  1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8
);

function BitCountW(X: word): byte;
asm
    PUSH    EBX
    LEA     EBX,BitsSet
    XLATB
    XCHG    AL,AH
    XLATB
    ADD     AL,AH
    POP     EBX
end;

function BitCount(X: cardinal): cardinal;
asm
    TEST    EAX,EAX
    JZ      @Exit
    PUSH    EBX
    LEA     EBX,BitsSet
    XLATB
    MOV     DL,AL
    MOV     AL,AH
    XLATB
    ADD     DL,AL
    TEST    EAX,$FFFF0000
    JZ      @Fin
    SHR     EAX,16
    XLATB
    ADD     DL,AL
    MOV     AL,AH
    XLATB
    ADD     DL,AL
@Fin:
    MOVZX   EAX,DL
    POP     EBX
@Exit:
end;

function BitCount64(X: int64): cardinal;
begin
  Result:=BitCount(int64Rec(X).Hi)+BitCount(int64Rec(X).Lo);
end;

function FileOpenEx(const FileName: string; Mode: LongWord; Flags: LongWord): Integer;
{$IFDEF MSWINDOWS}
const
  AccessMode: array[0..2] of LongWord = (
    GENERIC_READ,
    GENERIC_WRITE,
    GENERIC_READ or GENERIC_WRITE);
  ShareMode: array[0..4] of LongWord = (
    0,
    0,
    FILE_SHARE_READ,
    FILE_SHARE_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE);
begin
  Result := -1;
  if Flags=0 then Flags:=FILE_ATTRIBUTE_NORMAL;
  if ((Mode and 3) <= fmOpenReadWrite) and
    ((Mode and $F0) <= fmShareDenyNone) then
    Result := Integer(CreateFile(PChar(FileName), AccessMode[Mode and 3],
      ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
      Flags, 0));
end;
{$ENDIF}
{$IFDEF LINUX}
const
  ShareMode: array[0..fmShareDenyNone shr 4] of Byte = (
    0,        //No share mode specified
    F_WRLCK,  //fmShareExclusive
    F_RDLCK,  //fmShareDenyWrite
    0);       //fmShareDenyNone
var
  FileHandle, Tvar: Integer;
  LockVar: TFlock;
  smode: Byte;
begin
  Result := -1;
  if FileExists(FileName) and
     ((Mode and 3) <= fmOpenReadWrite) and
     ((Mode and $F0) <= fmShareDenyNone) then
  begin
    FileHandle := open(PChar(FileName), (Mode and 3), FileAccessRights);

    if FileHandle = -1 then  Exit;

    smode := Mode and $F0 shr 4;
    if ShareMode[smode] <> 0 then
    begin
      with LockVar do
      begin
        l_whence := SEEK_SET;
        l_start := 0;
        l_len := 0;
        l_type := ShareMode[smode];
      end;
      Tvar :=  fcntl(FileHandle, F_SETLK, LockVar);
      if Tvar = -1 then
      begin
        __close(FileHandle);
        Exit;
      end;
    end;
    Result := FileHandle;
  end;
end;
{$ENDIF}

function FileCreateEx(const FileName: string; Flags: LongWord): Integer;
{$IFDEF MSWINDOWS}
begin
  if Flags=0 then Flags:=FILE_ATTRIBUTE_NORMAL;
  Result := Integer(CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
    0, nil, CREATE_ALWAYS, Flags, 0));
end;
{$ENDIF}
{$IFDEF LINUX}
begin
  Result := FileCreate(FileName, FileAccessRights);
end;
{$ENDIF}

function FileCreateEx(const FileName: string; Rights: Integer; Flags: LongWord): Integer;
{$IFDEF MSWINDOWS}
begin
  Result := FileCreateEx(FileName,Flags);
end;
{$ENDIF}
{$IFDEF LINUX}
begin
  Result := Integer(open(PChar(FileName), O_RDWR or O_CREAT or O_TRUNC, Rights));
end;
{$ENDIF}

function FileReadOverlap(Handle: Integer; Pos: int64; var Buf; Count: LongWord): Integer;
var
  Overlapped: POverlapped;
begin
  Result:=0;
  Overlapped:=AllocMem(SizeOf(TOverlapped));
  with Overlapped^ do
    begin
      Offset:=Int64Rec(Pos).Lo;
      OffsetHigh:=Int64Rec(Pos).Hi;
      hEvent:=CreateEvent(nil,true,false,nil);
    end;
  if not(ReadFileEx(THandle(Handle),@Buf,Count,Overlapped,nil)) then
    begin
      if GetLastError = ERROR_IO_PENDING then
        begin
          while WaitForSingleObject(Overlapped^.hEvent,0)=WAIT_TIMEOUT do
            Sleep(0);
        end
          else
        Sleep(0);
    end;
  GetOverlappedResult(THandle(Handle),Overlapped^,cardinal(Result),false);
  CloseHandle(Overlapped^.hEvent);
  FreeMem(Overlapped);
end;

{ TSpinLocker }

class procedure TSpinLocker.LockFlag(var AFlag: integer);
begin
  while InterLockedExchange(AFlag,1)=1 do
    Sleep(0);
end;

class procedure TSpinLocker.UnlockFlag(var AFlag: integer);
begin
  InterLockedExchange(AFlag,0);
end;

procedure TSpinLocker.Lock;
begin
  LockFlag(FLockFlag);
end;

procedure TSpinLocker.Unlock;
begin
  UnlockFlag(FLockFlag);
end;

{ TPageMemoryStream }

constructor TPageMemoryStream.Create(ALevel: word);
begin
  FBufList:=TList.Create;
  FLevel:=ALevel;
  SetSize(0);
end;

destructor TPageMemoryStream.Destroy;
var
  I: integer;
  P: pointer;
begin
  for I := 0 to FBufList.Count - 1 do
    begin
      P:=FBufList.Items[I];
      FreeMem(P);
    end;
  FBufList.Free;
  inherited;
end;

function TPageMemoryStream.GetCapacity: longint;
begin
  Result:=FBufList.Count shl FLevel;
end;

function TPageMemoryStream.Read(var Buffer; Count: Integer): Longint;
var
  Seg,Off,PSize,R,C: integer;
  P,B: pointer;
begin
  if (FPosition >= 0) and (Count >= 0) then
  begin
    Result := FSize - FPosition;
    if Result > 0 then
    begin
      if Result > Count then Result := Count;
      Seg:=FPosition shr FLevel;
      Off:=FPosition and BufMasks[FLevel];
      B:=@Buffer;
      PSize:=1 shl FLevel;
      R:=Result;
      C:=PSize-Off;
      P:=pointer(cardinal(FBufList.Items[Seg])+cardinal(Off));
      repeat
        if C>R then C:=R;
        System.Move(P^,B^,C);
        dec(R,C);
        if not(R=0) then
          begin
            inc(Seg);
            P:=FBufList.Items[Seg];
            inc(cardinal(B),C);
            C:=PSize;
          end;
      until R=0;
      Inc(FPosition, Result);
      Exit;
    end;
  end;
  Result := 0;
end;

function TPageMemoryStream.Write(const Buffer; Count: Integer): Longint;
var
  Pos: Longint;
  Seg,Off,PSize,R,C: integer;
  P,B: pointer;
begin
  if (FPosition >= 0) and (Count >= 0) then
  begin
    Pos := FPosition + Count;
    if Pos > 0 then
    begin
      if Pos > FSize then SetSize(Pos);
      Result := Count;
      Seg:=FPosition shr FLevel;
      Off:=FPosition and BufMasks[FLevel];
      B:=@Buffer;
      PSize:=1 shl FLevel;
      R:=Result;
      C:=PSize-Off;
      P:=pointer(cardinal(FBufList.Items[Seg])+cardinal(Off));
      repeat
        if C>R then C:=R;
        System.Move(B^,P^,C);
        dec(R,C);
        if not(R=0) then
          begin
            inc(Seg);
            P:=FBufList.Items[Seg];
            inc(cardinal(B),C);
            C:=PSize;
          end;
      until R=0;
      FPosition := Pos;
      Exit;
    end;
  end;
  Result := 0;
end;

function TPageMemoryStream.Seek(Offset: Integer; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning: FPosition := Offset;
    soFromCurrent: Inc(FPosition, Offset);
    soFromEnd: FPosition := FSize + Offset;
  end;
  Result := FPosition;
end;

procedure TPageMemoryStream.SetSize(NewSize: Longint);
var
  OldPosition: Longint;
  L,C,I: integer;
  P: pointer;
begin
  OldPosition := FPosition;
  L:=(NewSize shr FLevel)+1;
  C:=FBufList.Count;
  if L<C then
    begin
      for I := L to C-1 do
        begin
          P:=FBufList.Items[I];
          FreeMem(P);
        end;
      FBufList.Count:=L;
    end
      else
  if L>C then
    begin
      for I := C to L-1 do
        begin
          GetMem(P,1 shl FLevel);
          FBufList.Add(P);
        end;
    end;
  FSize := NewSize;
  if OldPosition > NewSize then Seek(0, soFromEnd);
end;

{ TFileStreamEx }

constructor TFileStreamEx.Create(const AFileName: string; Mode: Word; Flags: LongWord);
begin
{$IFDEF MSWINDOWS}
  Create(AFilename, Mode, 0, Flags);
{$ELSE}
  Create(AFilename, Mode, FileAccessRights, Flags);
{$ENDIF}
end;

constructor TFileStreamEx.Create(const AFileName: string; Mode: Word; Rights: Cardinal; Flags: LongWord);
begin
  if Mode = fmCreate then
  begin
    inherited Create(FileCreateEx(AFileName, Rights, Flags));
    if FHandle < 0 then
      raise EFCreateError.CreateResFmt(@SFCreateErrorEx, [ExpandFileName(AFileName), SysErrorMessage(GetLastError)]);
  end
  else
  begin
    inherited Create(FileOpenEx(AFileName, Mode, Flags));
    if FHandle < 0 then
      raise EFOpenError.CreateResFmt(@SFOpenErrorEx, [ExpandFileName(AFileName), SysErrorMessage(GetLastError)]);
  end;
  FFileName := AFileName;
end;

destructor TFileStreamEx.Destroy;
begin
  if FHandle >= 0 then FileClose(FHandle);
  inherited Destroy;
end;

function TFileStreamEx.ReadOverlap(Pos: int64; var Buffer; Count: Integer): Longint;
begin
  Result:=FileReadOverlap(FHandle,Pos,Buffer,Count);
end;

end.