{ ****************************************************************************** }
{ * MixedLibrary,writen by QQ 600585@qq.com                                    * }
{ * https://zpascal.net                                                        * }
{ * https://github.com/PassByYou888/zAI                                        * }
{ * https://github.com/PassByYou888/ZServer4D                                  * }
{ * https://github.com/PassByYou888/PascalString                               * }
{ * https://github.com/PassByYou888/zRasterization                             * }
{ * https://github.com/PassByYou888/CoreCipher                                 * }
{ * https://github.com/PassByYou888/zSound                                     * }
{ * https://github.com/PassByYou888/zChinese                                   * }
{ * https://github.com/PassByYou888/zExpression                                * }
{ * https://github.com/PassByYou888/zGameWare                                  * }
{ * https://github.com/PassByYou888/zAnalysis                                  * }
{ * https://github.com/PassByYou888/FFMPEG-Header                              * }
{ * https://github.com/PassByYou888/zTranslate                                 * }
{ * https://github.com/PassByYou888/InfiniteIoT                                * }
{ * https://github.com/PassByYou888/FastMD5                                    * }
{ ****************************************************************************** }

{
  *
  * Unit Name: MixedLibrary
  * Purpose  : mixed Low Level Function Library
  *
}

(*
  update history
  2017-11-26 fixed UmlMD5Stream and umlMD5 calculate x64 and x86,ARM platform more than 4G memory Support QQ600585
*)

unit UnicodeMixedLib;

{$INCLUDE zDefine.inc}

interface

uses
{$IFDEF FPC}
  Dynlibs,
  FPCGenericStructlist,
{$IFDEF MSWINDOWS} Windows, {$ENDIF MSWINDOWS}
{$ELSE FPC}
{$IFDEF MSWINDOWS} Windows, {$ENDIF MSWINDOWS}
  System.IOUtils,
{$ENDIF FPC}
  SysUtils, Types, Math, Variants, CoreClasses, PascalStrings, ListEngine;

const
  C_Max_UInt32 = $FFFFFFFF;
  C_Address_Size = SizeOf(Pointer);
  C_Pointer_Size = C_Address_Size;
  C_Integer_Size = 4;
  C_Int64_Size = 8;
  C_UInt64_Size = 8;
  C_Single_Size = 4;
  C_Double_Size = 8;
  C_Small_Int_Size = 2;
  C_Byte_Size = 1;
  C_Short_Int_Size = 1;
  C_Word_Size = 2;
  C_DWord_Size = 4;
  C_Cardinal_Size = 4;
  C_Boolean_Size = 1;
  C_Bool_Size = 1;
  C_MD5_Size = 16;

  C_PrepareReadCacheSize = 512;
  C_MaxBufferFragmentSize = $F000;

  C_StringError = -911;
  C_SeekError = -910;
  C_FileWriteError = -909;
  C_FileReadError = -908;
  C_FileHandleError = -907;
  C_OpenFileError = -905;
  C_NotOpenFile = -904;
  C_CreateFileError = -903;
  C_FileIsActive = -902;
  C_NotFindFile = -901;
  C_NotError = -900;

type
  U_SystemString = SystemString;
  U_String = TPascalString;
  P_String = PPascalString;
  U_Char = SystemChar;
  U_StringArray = array of U_SystemString;
  U_ArrayString = U_StringArray;

  U_Bytes = TBytes;

  TSR = TSearchRec;

  U_Stream = TCoreClassStream;

  TReliableFileStream = class(TCoreClassStream)
  protected
    SourceIO, BackupFileIO: TCoreClassFileStream;
    FActivted: Boolean;
    FFileName, FBackupFileName: SystemString;

    procedure InitIO;
    procedure FreeIO;

    procedure SetSize(const NewSize: Int64); overload; override;
    procedure SetSize(NewSize: longint); overload; override;
  public
    constructor Create(const FileName_: SystemString; IsNew_, IsWrite_: Boolean);
    destructor Destroy; override;

    function write(const buffer; Count: longint): longint; override;
    function read(var buffer; Count: longint): longint; override;
    function Seek(const Offset: Int64; origin: TSeekOrigin): Int64; override;

    property FileName: SystemString read FFileName;
    property BackupFileName: SystemString read FBackupFileName;
    property Activted: Boolean read FActivted;
  end;

  PIOHnd = ^TIOHnd;

  TIOHnd = record
  public
    IsOnlyRead: Boolean;
    IsOpen: Boolean;
    AutoFree: Boolean;
    Handle: U_Stream;
    Time: TDateTime;
    Size: Int64;
    Position: Int64;
    FileName: U_String;
    FlushBuff: U_Stream;
    FlushPosition: Int64;
    PrepareReadPosition: Int64;
    PrepareReadBuff: U_Stream;
    IORead, IOWrite: Int64;
    WriteStated: Boolean;
    FixedStringL: Byte;
    Data: Pointer;
    Return: Integer;

    function FixedString2Pascal(s: TBytes): TPascalString;
    procedure Pascal2FixedString(var n: TPascalString; var out_: TBytes);
    function CheckFixedStringLoss(s: TPascalString): Boolean;
  end;

  U_ByteArray = array [0 .. MaxInt div SizeOf(Byte) - 1] of Byte;
  P_ByteArray = ^U_ByteArray;

function umlBytesOf(const s: TPascalString): TBytes;
function umlStringOf(const s: TBytes): TPascalString; overload;

function umlNewString(const s: TPascalString): P_String;
procedure umlFreeString(const p: P_String);

function umlComparePosStr(const s: TPascalString; Offset: Integer; const t: TPascalString): Boolean;
function umlPos(const SubStr, s: TPascalString; const Offset: Integer = 1): Integer;

function umlVarToStr(const v: Variant; const Base64Conver: Boolean): TPascalString; overload;
function umlVarToStr(const v: Variant): TPascalString; overload;
function umlStrToVar(const s: TPascalString): Variant;

function umlMax(const v1, v2: UInt64): UInt64; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMax(const v1, v2: Cardinal): Cardinal; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMax(const v1, v2: Word): Word; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMax(const v1, v2: Byte): Byte; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMax(const v1, v2: Int64): Int64; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMax(const v1, v2: Integer): Integer; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMax(const v1, v2: SmallInt): SmallInt; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMax(const v1, v2: ShortInt): ShortInt; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMax(const v1, v2: Double): Double; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMax(const v1, v2: Single): Single; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;

function umlMin(const v1, v2: UInt64): UInt64; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMin(const v1, v2: Cardinal): Cardinal; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMin(const v1, v2: Word): Word; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMin(const v1, v2: Byte): Byte; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMin(const v1, v2: Int64): Int64; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMin(const v1, v2: Integer): Integer; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMin(const v1, v2: SmallInt): SmallInt; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMin(const v1, v2: ShortInt): ShortInt; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMin(const v1, v2: Double): Double; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlMin(const v1, v2: Single): Single; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;

function umlClamp(const v, min_, max_: UInt64): UInt64; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlClamp(const v, min_, max_: Cardinal): Cardinal; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlClamp(const v, min_, max_: Word): Word; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlClamp(const v, min_, max_: Byte): Byte; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlClamp(const v, min_, max_: Int64): Int64; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlClamp(const v, min_, max_: SmallInt): SmallInt; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlClamp(const v, min_, max_: ShortInt): ShortInt; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlClamp(const v, min_, max_: Double): Double; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlClamp(const v, min_, max_: Single): Single; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;

function umlInRange(const v, min_, max_: UInt64): Boolean; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlInRange(const v, min_, max_: Cardinal): Boolean; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlInRange(const v, min_, max_: Word): Boolean; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlInRange(const v, min_, max_: Byte): Boolean; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlInRange(const v, min_, max_: SmallInt): Boolean; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlInRange(const v, min_, max_: ShortInt): Boolean; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlInRange(const v, min_, max_: Double): Boolean; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;
function umlInRange(const v, min_, max_: Single): Boolean; {$IFDEF INLINE_ASM} inline; {$ENDIF} overload;

function umlGetResourceStream(const FileName: TPascalString): TCoreClassStream;

function umlSameVarValue(const v1, v2: Variant): Boolean;
function umlSameVariant(const v1, v2: Variant): Boolean;

function umlRandom(const rnd: TMT19937Random): Integer; overload;
function umlRandom: Integer; overload;

function umlRandomRange64(const rnd: TMT19937Random; const min_, max_: Int64): Int64; overload;
function umlRandomRange(const rnd: TMT19937Random; const min_, max_: Integer): Integer; overload;
function umlRandomRangeS(const rnd: TMT19937Random; const min_, max_: Single): Single; overload;
function umlRandomRangeD(const rnd: TMT19937Random; const min_, max_: Double): Double; overload;
function umlRandomRangeF(const rnd: TMT19937Random; const min_, max_: Double): Double; overload;

function umlRandomRange64(const min_, max_: Int64): Int64; overload;
function umlRandomRange(const min_, max_: Integer): Integer; overload;
function umlRandomRangeS(const min_, max_: Single): Single; overload;
function umlRandomRangeD(const min_, max_: Double): Double; overload;
function umlRandomRangeF(const min_, max_: Double): Double; overload;

function umlDefaultTime: Double;
function umlNow: Double;
function umlDefaultAttrib: Integer;
function umlBoolToStr(const Value: Boolean): TPascalString;
function umlStrToBool(const Value: TPascalString): Boolean;

function umlFileExists(const FileName: TPascalString): Boolean;
function umlDirectoryExists(const DirectoryName: TPascalString): Boolean;
function umlCreateDirectory(const DirectoryName: TPascalString): Boolean;
function umlCurrentDirectory: TPascalString;
function umlCurrentPath: TPascalString;
function umlGetCurrentPath: TPascalString;
procedure umlSetCurrentPath(ph: TPascalString);

function umlFindFirstFile(const FileName: TPascalString; var SR: TSR): Boolean;
function umlFindNextFile(var SR: TSR): Boolean;
function umlFindFirstDir(const DirName: TPascalString; var SR: TSR): Boolean;
function umlFindNextDir(var SR: TSR): Boolean;
procedure umlFindClose(var SR: TSR);

function umlGetFileList(const FullPath: TPascalString; AsLst: TCoreClassStrings): Integer; overload;
function umlGetDirList(const FullPath: TPascalString; AsLst: TCoreClassStrings): Integer; overload;

function umlGetFileList(const FullPath: TPascalString; AsLst: TPascalStringList): Integer; overload;
function umlGetDirList(const FullPath: TPascalString; AsLst: TPascalStringList): Integer; overload;

function umlGetFileListWithFullPath(const FullPath: TPascalString): U_StringArray;
function umlGetDirListWithFullPath(const FullPath: TPascalString): U_StringArray;
function umlGetFileListPath(const FullPath: TPascalString): U_StringArray;
function umlGetDirListPath(const FullPath: TPascalString): U_StringArray;

function umlCombinePath(const s1, s2: TPascalString): TPascalString;
function umlCombineFileName(const pathName, FileName: TPascalString): TPascalString;
function umlCombineUnixPath(const s1, s2: TPascalString): TPascalString;
function umlCombineUnixFileName(const pathName, FileName: TPascalString): TPascalString;
function umlCombineWinPath(const s1, s2: TPascalString): TPascalString;
function umlCombineWinFileName(const pathName, FileName: TPascalString): TPascalString;
function umlGetFileName(platform_: TExecutePlatform; const s: TPascalString): TPascalString; overload;
function umlGetFileName(const s: TPascalString): TPascalString; overload;
function umlGetWindowsFileName(const s: TPascalString): TPascalString;
function umlGetUnixFileName(const s: TPascalString): TPascalString;
function umlGetFilePath(platform_: TExecutePlatform; const s: TPascalString): TPascalString; overload;
function umlGetFilePath(const s: TPascalString): TPascalString; overload;
function umlGetWindowsFilePath(const s: TPascalString): TPascalString;
function umlGetUnixFilePath(const s: TPascalString): TPascalString;
function umlChangeFileExt(const s, ext: TPascalString): TPascalString;
function umlGetFileExt(const s: TPascalString): TPascalString;

{ FileIO }
procedure InitIOHnd(var IOHnd: TIOHnd);
function umlFileCreateAsStream(const FileName: TPascalString; stream: U_Stream; var IOHnd: TIOHnd; OnlyRead_: Boolean): Boolean; overload;
function umlFileCreateAsStream(const FileName: TPascalString; stream: U_Stream; var IOHnd: TIOHnd): Boolean; overload;
function umlFileCreateAsStream(stream: U_Stream; var IOHnd: TIOHnd): Boolean; overload;
function umlFileCreateAsStream(stream: U_Stream; var IOHnd: TIOHnd; OnlyRead_: Boolean): Boolean; overload;
function umlFileOpenAsStream(const FileName: TPascalString; stream: U_Stream; var IOHnd: TIOHnd; OnlyRead_: Boolean): Boolean;
function umlFileCreateAsMemory(var IOHnd: TIOHnd): Boolean;
function umlFileCreate(const FileName: TPascalString; var IOHnd: TIOHnd): Boolean;
function umlFileOpen(const FileName: TPascalString; var IOHnd: TIOHnd; OnlyRead_: Boolean): Boolean;
function umlFileClose(var IOHnd: TIOHnd): Boolean;
function umlFileUpdate(var IOHnd: TIOHnd): Boolean;
function umlFileTest(var IOHnd: TIOHnd): Boolean;
procedure umlResetPrepareRead(var IOHnd: TIOHnd);
function umlFilePrepareRead(var IOHnd: TIOHnd; Size: Int64; var buff): Boolean;
function umlFileRead(var IOHnd: TIOHnd; const Size: Int64; var buff): Boolean;
function umlBlockRead(var IOHnd: TIOHnd; var buff; const Size: Int64): Boolean;
function umlFilePrepareWrite(var IOHnd: TIOHnd): Boolean;
function umlFileFlushWrite(var IOHnd: TIOHnd): Boolean;
function umlFileWrite(var IOHnd: TIOHnd; const Size: Int64; var buff): Boolean;
function umlBlockWrite(var IOHnd: TIOHnd; var buff; const Size: Int64): Boolean;
function umlFileWriteFixedString(var IOHnd: TIOHnd; var Value: TPascalString): Boolean;
function umlFileReadFixedString(var IOHnd: TIOHnd; var Value: TPascalString): Boolean;
function umlFileSeek(var IOHnd: TIOHnd; Pos_: Int64): Boolean;
function umlFileGetPOS(var IOHnd: TIOHnd): Int64;
function umlFileSetSize(var IOHnd: TIOHnd; siz_: Int64): Boolean;
function umlFilePOS(var IOHnd: TIOHnd): Int64;
function umlFileGetSize(var IOHnd: TIOHnd): Int64;
function umlFileSize(var IOHnd: TIOHnd): Int64;

function umlGetFileTime(const FileName: TPascalString): TDateTime;
procedure umlSetFileTime(const FileName: TPascalString; newTime: TDateTime);

function umlGetFileSize(const FileName: TPascalString): Int64;

function umlGetFileCount(const FileName: TPascalString): Integer;
function umlGetFileDateTime(const FileName: TPascalString): TDateTime;
function umlDeleteFile(const FileName: TPascalString; const _VerifyCheck: Boolean): Boolean; overload;
function umlDeleteFile(const FileName: TPascalString): Boolean; overload;
function umlCopyFile(const SourFile, DestFile: TPascalString): Boolean;
function umlRenameFile(const OldName, NewName: TPascalString): Boolean;

procedure umlSetLength(var sVal: TPascalString; Len: Integer); overload;
procedure umlSetLength(var sVal: U_Bytes; Len: Integer); overload;
procedure umlSetLength(var sVal: TArrayPascalString; Len: Integer); overload;

function umlGetLength(const sVal: TPascalString): Integer; overload;
function umlGetLength(const sVal: U_Bytes): Integer; overload;
function umlGetLength(const sVal: TArrayPascalString): Integer; overload;

function umlUpperCase(const s: TPascalString): TPascalString;
function umlLowerCase(const s: TPascalString): TPascalString;
function umlCopyStr(const sVal: TPascalString; MainPosition, LastPosition: Integer): TPascalString;
function umlSameText(const s1, s2: TPascalString): Boolean;

function umlDeleteChar(const SText, Ch: TPascalString): TPascalString; overload;
function umlDeleteChar(const SText: TPascalString; const SomeChars: array of SystemChar): TPascalString; overload;
function umlDeleteChar(const SText: TPascalString; const SomeCharsets: TOrdChars): TPascalString; overload;
function umlGetNumberCharInText(const n: TPascalString): TPascalString;

function umlMatchChar(CharValue: U_Char; cVal: P_String): Boolean; overload;
function umlMatchChar(CharValue: U_Char; cVal: TPascalString): Boolean; overload;
function umlExistsChar(StrValue: TPascalString; cVal: TPascalString): Boolean;

function umlTrimChar(const s, trim_s: TPascalString): TPascalString;

function umlGetFirstStr(const sVal, trim_s: TPascalString): TPascalString;
function umlGetLastStr(const sVal, trim_s: TPascalString): TPascalString;
function umlDeleteFirstStr(const sVal, trim_s: TPascalString): TPascalString;
function umlDeleteLastStr(const sVal, trim_s: TPascalString): TPascalString;
function umlGetIndexStrCount(const sVal, trim_s: TPascalString): Integer;
function umlGetIndexStr(const sVal: TPascalString; trim_s: TPascalString; index: Integer): TPascalString;

procedure umlGetSplitArray(const sour: TPascalString; var dest: TArrayPascalString; const splitC: TPascalString); overload;
procedure umlGetSplitArray(const sour: TPascalString; var dest: U_StringArray; const splitC: TPascalString); overload;
function ArrayStringToText(var ary: TArrayPascalString; const splitC: TPascalString): TPascalString;
function umlStringsToSplitText(lst: TCoreClassStrings; const splitC: TPascalString): TPascalString; overload;
function umlStringsToSplitText(lst: TListPascalString; const splitC: TPascalString): TPascalString; overload;

function umlGetFirstStr_Discontinuity(const sVal, trim_s: TPascalString): TPascalString;
function umlDeleteFirstStr_Discontinuity(const sVal, trim_s: TPascalString): TPascalString;
function umlGetLastStr_Discontinuity(const sVal, trim_s: TPascalString): TPascalString;
function umlDeleteLastStr_Discontinuity(const sVal, trim_s: TPascalString): TPascalString;
function umlGetIndexStrCount_Discontinuity(const sVal, trim_s: TPascalString): Integer;
function umlGetIndexStr_Discontinuity(const sVal: TPascalString; trim_s: TPascalString; index: Integer): TPascalString;

function umlGetFirstTextPos(const s: TPascalString; const TextArry: TArrayPascalString; var OutText: TPascalString): Integer;
function umlDeleteText(const sour: TPascalString; const bToken, eToken: TArrayPascalString; ANeedBegin, ANeedEnd: Boolean): TPascalString;
function umlGetTextContent(const sour: TPascalString; const bToken, eToken: TArrayPascalString): TPascalString;

type
  TTextType = (ntBool, ntInt, ntInt64, ntUInt64, ntWord, ntByte, ntSmallInt, ntShortInt, ntUInt, ntSingle, ntDouble, ntCurrency, ntUnknow);
function umlGetNumTextType(const s: TPascalString): TTextType;

function umlIsHex(const sVal: TPascalString): Boolean;
function umlIsNumber(const sVal: TPascalString): Boolean;
function umlIsIntNumber(const sVal: TPascalString): Boolean;
function umlIsFloatNumber(const sVal: TPascalString): Boolean;
function umlIsBool(const sVal: TPascalString): Boolean;
function umlNumberCount(const sVal: TPascalString): Integer;

function umlPercentageToFloat(OriginMax, OriginMin, ProcressParameter: Double): Double;
function umlPercentageToInt64(OriginParameter, ProcressParameter: Int64): Integer;
function umlPercentageToInt(OriginParameter, ProcressParameter: Integer): Integer;
function umlPercentageToStr(OriginParameter, ProcressParameter: Integer): TPascalString;
function umlSmartSizeToStr(Size: Int64): TPascalString;

function umlIntToStr(Parameter: Single): TPascalString; overload;
function umlIntToStr(Parameter: Double): TPascalString; overload;
function umlIntToStr(Parameter: Int64): TPascalString; overload;

function umlPointerToStr(param: Pointer): TPascalString;

function umlMBPSToStr(Size: Int64): TPascalString;
function umlSizeToStr(Parameter: Int64): TPascalString;
function umlStrToDateTime(s: TPascalString): TDateTime;
function umlDateTimeToStr(t: TDateTime): TPascalString;
function umlTimeTickToStr(const t: TTimeTick): TPascalString;
function umlTimeToStr(t: TDateTime): TPascalString;
function umlDateToStr(t: TDateTime): TPascalString;
function umlFloatToStr(const f: Double): TPascalString;
function umlShortFloatToStr(const f: Double): TPascalString;

function umlStrToInt(const V_: TPascalString): Integer; overload;
function umlStrToInt(const V_: TPascalString; _Def: Integer): Integer; overload;
function umlStrToInt64(const V_: TPascalString; _Def: Int64): Int64; overload;
function umlStrToInt64(const V_: TPascalString): Int64; overload;
function umlStrToFloat(const V_: TPascalString; _Def: Double): Double; overload;
function umlStrToFloat(const V_: TPascalString): Double; overload;

function umlMultipleMatch(IgnoreCase: Boolean; const SourceStr, TargetStr, umlMultipleString, umlMultipleCharacter: TPascalString): Boolean; overload;
function umlMultipleMatch(IgnoreCase: Boolean; const SourceStr, TargetStr: TPascalString): Boolean; overload;
function umlMultipleMatch(const SourceStr, TargetStr: TPascalString): Boolean; overload;
function umlMultipleMatch(const ValueCheck: array of TPascalString; const Value: TPascalString): Boolean; overload;
function umlSearchMatch(const SourceStr, TargetStr: TPascalString): Boolean; overload;
function umlSearchMatch(const ValueCheck: TArrayPascalString; Value: TPascalString): Boolean; overload;

// <prefix>.<postfix> formula, match sour -> dest
// example: <prefix>.*
// example: *.<postfix>
function umlMatchFileInfo(const exp_, sour_, dest_: TPascalString): Boolean;

function umlGetDateTimeStr(NowDateTime: TDateTime): TPascalString;
function umlDecodeTimeToStr(NowDateTime: TDateTime): TPascalString;
function umlMakeRanName: TPascalString;

function umlStringReplace(const s, OldPattern, NewPattern: TPascalString; IgnoreCase: Boolean): TPascalString;
function umlReplaceString(const s, OldPattern, NewPattern: TPascalString; IgnoreCase: Boolean): TPascalString;
function umlCharReplace(const s: TPascalString; OldPattern, NewPattern: U_Char): TPascalString;
function umlReplaceChar(const s: TPascalString; OldPattern, NewPattern: U_Char): TPascalString;

function umlEncodeText2HTML(const psSrc: TPascalString): TPascalString;

function umlURLEncode(const Data: TPascalString): TPascalString;
function umlURLDecode(const Data: TPascalString; FormEncoded: Boolean): TPascalString;

type
  TBase64Context = record
    Tail: array [0 .. 3] of Byte;
    TailBytes: Integer;
    LineWritten: Integer;
    LineSize: Integer;
    TrailingEol: Boolean;
    PutFirstEol: Boolean;
    LiberalMode: Boolean;
    fEOL: array [0 .. 3] of Byte;
    EOLSize: Integer;
    OutBuf: array [0 .. 3] of Byte;
    EQUCount: Integer;
    UseUrlAlphabet: Boolean;
  end;

  TBase64EOLMarker = (emCRLF, emCR, emLF, emNone);

  TBase64ByteArray = array [0 .. MaxInt div SizeOf(Byte) - 1] of Byte;
  PBase64ByteArray = ^TBase64ByteArray;

const
  BASE64_DECODE_OK = 0;
  BASE64_DECODE_INVALID_CHARACTER = 1;
  BASE64_DECODE_WRONG_DATA_SIZE = 2;
  BASE64_DECODE_NOT_ENOUGH_SPACE = 3;

  Base64Symbols: array [0 .. 63] of Byte = (
    $41, $42, $43, $44, $45, $46, $47, $48, $49, $4A, $4B, $4C, $4D, $4E, $4F, $50,
    $51, $52, $53, $54, $55, $56, $57, $58, $59, $5A, $61, $62, $63, $64, $65, $66,
    $67, $68, $69, $6A, $6B, $6C, $6D, $6E, $6F, $70, $71, $72, $73, $74, $75, $76,
    $77, $78, $79, $7A, $30, $31, $32, $33, $34, $35, $36, $37, $38, $39, $2B, $2F);

  Base64Values: array [0 .. 255] of Byte = (
    $FE, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FE, $FE, $FF, $FF, $FE, $FF, $FF,
    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
    $FE, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $3E, $FF, $FF, $FF, $3F,
    $34, $35, $36, $37, $38, $39, $3A, $3B, $3C, $3D, $FF, $FF, $FF, $FD, $FF, $FF,
    $FF, $00, $01, $02, $03, $04, $05, $06, $07, $08, $09, $0A, $0B, $0C, $0D, $0E,
    $0F, $10, $11, $12, $13, $14, $15, $16, $17, $18, $19, $FF, $FF, $FF, $FF, $FF,
    $FF, $1A, $1B, $1C, $1D, $1E, $1F, $20, $21, $22, $23, $24, $25, $26, $27, $28,
    $29, $2A, $2B, $2C, $2D, $2E, $2F, $30, $31, $32, $33, $FF, $FF, $FF, $FF, $FF,
    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
    $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF);

function B64EstimateEncodedSize(Ctx: TBase64Context; InSize: Integer): Integer;
function B64InitializeDecoding(var Ctx: TBase64Context; LiberalMode: Boolean): Boolean;
function B64InitializeEncoding(var Ctx: TBase64Context; LineSize: Integer; fEOL: TBase64EOLMarker; TrailingEol: Boolean): Boolean;
function B64Encode(var Ctx: TBase64Context; buffer: PByte; Size: Integer; OutBuffer: PByte; var OutSize: Integer): Boolean;
function B64Decode(var Ctx: TBase64Context; buffer: PByte; Size: Integer; OutBuffer: PByte; var OutSize: Integer): Boolean;
function B64FinalizeEncoding(var Ctx: TBase64Context; OutBuffer: PByte; var OutSize: Integer): Boolean;
function B64FinalizeDecoding(var Ctx: TBase64Context; OutBuffer: PByte; var OutSize: Integer): Boolean;
function umlBase64Encode(InBuffer: PByte; InSize: Integer; OutBuffer: PByte; var OutSize: Integer; WrapLines: Boolean): Boolean;
function umlBase64Decode(InBuffer: PByte; InSize: Integer; OutBuffer: PByte; var OutSize: Integer; LiberalMode: Boolean): Integer;
procedure umlBase64EncodeBytes(var sour, dest: TBytes); overload;
procedure umlBase64DecodeBytes(var sour, dest: TBytes); overload;
procedure umlBase64EncodeBytes(var sour: TBytes; var dest: TPascalString); overload;
procedure umlBase64DecodeBytes(const sour: TPascalString; var dest: TBytes); overload;
procedure umlDecodeLineBASE64(const buffer: TPascalString; var output: TPascalString);
procedure umlEncodeLineBASE64(const buffer: TPascalString; var output: TPascalString);
procedure umlDecodeStreamBASE64(const buffer: TPascalString; output: TCoreClassStream);
procedure umlEncodeStreamBASE64(buffer: TCoreClassStream; var output: TPascalString);
function umlDivisionBase64Text(const buffer: TPascalString; width: Integer; DivisionAsPascalString: Boolean): TPascalString;
function umlTestBase64(const text: TPascalString): Boolean;

type
  PMD5 = ^TMD5;
  TMD5 = array [0 .. 15] of Byte;
  TMD5List = {$IFDEF FPC}specialize {$ENDIF FPC} TGenericsList<TMD5>;

const
  NullMD5: TMD5 = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  ZeroMD5: TMD5 = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);

procedure umlTransformMD5(var Accu; const Buf); inline;
function umlMD5(const buffPtr: PByte; bufSiz: NativeUInt): TMD5;
function umlMD5Char(const buffPtr: PByte; const BuffSize: NativeUInt): TPascalString;
function umlMD5String(const buffPtr: PByte; const BuffSize: NativeUInt): TPascalString;
function umlStreamMD5(stream: TCoreClassStream; StartPos, EndPos: Int64): TMD5; overload;
function umlStreamMD5(stream: TCoreClassStream): TMD5; overload;
function umlStreamMD5Char(stream: TCoreClassStream): TPascalString; overload;
function umlStreamMD5String(stream: TCoreClassStream): TPascalString; overload;
function umlStreamMD5Str(stream: TCoreClassStream): TPascalString; overload;
function umlStringMD5(const Value: TPascalString): TPascalString;
function umlFileMD5___(FileName: TPascalString): TMD5; overload;
function umlFileMD5(FileName: TPascalString; StartPos, EndPos: Int64): TMD5; overload;
function umlCombineMD5(const m1: TMD5): TMD5; overload;
function umlCombineMD5(const m1, m2: TMD5): TMD5; overload;
function umlCombineMD5(const m1, m2, m3: TMD5): TMD5; overload;
function umlCombineMD5(const m1, m2, m3, m4: TMD5): TMD5; overload;
function umlCombineMD5(const buff: array of TMD5): TMD5; overload;
function umlMD5ToStr(md5: TMD5): TPascalString; overload;
function umlMD5ToString(md5: TMD5): TPascalString; overload;
function umlMD52String(md5: TMD5): TPascalString; overload;
function umlMD5Compare(const m1, m2: TMD5): Boolean;
function umlCompareMD5(const m1, m2: TMD5): Boolean;
function umlIsNullMD5(m: TMD5): Boolean;
function umlWasNullMD5(m: TMD5): Boolean;

{$REGION 'crc16define'}


const
  CRC16Table: array [0 .. 255] of Word = (
    $0000, $C0C1, $C181, $0140, $C301, $03C0, $0280, $C241, $C601, $06C0, $0780,
    $C741, $0500, $C5C1, $C481, $0440, $CC01, $0CC0, $0D80, $CD41, $0F00, $CFC1,
    $CE81, $0E40, $0A00, $CAC1, $CB81, $0B40, $C901, $09C0, $0880, $C841, $D801,
    $18C0, $1980, $D941, $1B00, $DBC1, $DA81, $1A40, $1E00, $DEC1, $DF81, $1F40,
    $DD01, $1DC0, $1C80, $DC41, $1400, $D4C1, $D581, $1540, $D701, $17C0, $1680,
    $D641, $D201, $12C0, $1380, $D341, $1100, $D1C1, $D081, $1040, $F001, $30C0,
    $3180, $F141, $3300, $F3C1, $F281, $3240, $3600, $F6C1, $F781, $3740, $F501,
    $35C0, $3480, $F441, $3C00, $FCC1, $FD81, $3D40, $FF01, $3FC0, $3E80, $FE41,
    $FA01, $3AC0, $3B80, $FB41, $3900, $F9C1, $F881, $3840, $2800, $E8C1, $E981,
    $2940, $EB01, $2BC0, $2A80, $EA41, $EE01, $2EC0, $2F80, $EF41, $2D00, $EDC1,
    $EC81, $2C40, $E401, $24C0, $2580, $E541, $2700, $E7C1, $E681, $2640, $2200,
    $E2C1, $E381, $2340, $E101, $21C0, $2080, $E041, $A001, $60C0, $6180, $A141,
    $6300, $A3C1, $A281, $6240, $6600, $A6C1, $A781, $6740, $A501, $65C0, $6480,
    $A441, $6C00, $ACC1, $AD81, $6D40, $AF01, $6FC0, $6E80, $AE41, $AA01, $6AC0,
    $6B80, $AB41, $6900, $A9C1, $A881, $6840, $7800, $B8C1, $B981, $7940, $BB01,
    $7BC0, $7A80, $BA41, $BE01, $7EC0, $7F80, $BF41, $7D00, $BDC1, $BC81, $7C40,
    $B401, $74C0, $7580, $B541, $7700, $B7C1, $B681, $7640, $7200, $B2C1, $B381,
    $7340, $B101, $71C0, $7080, $B041, $5000, $90C1, $9181, $5140, $9301, $53C0,
    $5280, $9241, $9601, $56C0, $5780, $9741, $5500, $95C1, $9481, $5440, $9C01,
    $5CC0, $5D80, $9D41, $5F00, $9FC1, $9E81, $5E40, $5A00, $9AC1, $9B81, $5B40,
    $9901, $59C0, $5880, $9841, $8801, $48C0, $4980, $8941, $4B00, $8BC1, $8A81,
    $4A40, $4E00, $8EC1, $8F81, $4F40, $8D01, $4DC0, $4C80, $8C41, $4400, $84C1,
    $8581, $4540, $8701, $47C0, $4680, $8641, $8201, $42C0, $4380, $8341, $4100,
    $81C1, $8081, $4040
    );
{$ENDREGION 'crc16define'}

function umlCRC16(const Value: PByte; const Count: NativeUInt): Word;
function umlStringCRC16(const Value: TPascalString): Word;
function umlStreamCRC16(stream: U_Stream; StartPos, EndPos: Int64): Word; overload;
function umlStreamCRC16(stream: U_Stream): Word; overload;

{$REGION 'crc32define'}


const
  CRC32Table: array [0 .. 255] of Cardinal = (
    $00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F, $E963A535,
    $9E6495A3, $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD,
    $E7B82D07, $90BF1D91, $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D,
    $6DDDE4EB, $F4D4B551, $83D385C7, $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
    $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, $3B6E20C8, $4C69105E, $D56041E4,
    $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, $35B5A8FA, $42B2986C,
    $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, $26D930AC,
    $51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
    $2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB,
    $B6662D3D, $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F,
    $9FBFE4A5, $E8B8D433, $7807C9A2, $0F00F934, $9609A88E, $E10E9818, $7F6A0DBB,
    $086D3D2D, $91646C97, $E6635C01, $6B6B51F4, $1C6C6162, $856530D8, $F262004E,
    $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, $65B0D9C6, $12B7E950, $8BBEB8EA,
    $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, $4DB26158, $3AB551CE,
    $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, $4369E96A,
    $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
    $5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409,
    $CE61E49F, $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81,
    $B7BD5C3B, $C0BA6CAD, $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, $EAD54739,
    $9DD277AF, $04DB2615, $73DC1683, $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
    $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, $F00F9344, $8708A3D2, $1E01F268,
    $6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7, $FED41B76, $89D32BE0,
    $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, $D6D6A3E8,
    $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
    $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF,
    $4669BE79, $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703,
    $220216B9, $5505262F, $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7,
    $B5D0CF31, $2CD99E8B, $5BDEAE1D, $9B64C2B0, $EC63F226, $756AA39C, $026D930A,
    $9C0906A9, $EB0E363F, $72076785, $05005713, $95BF4A82, $E2B87A14, $7BB12BAE,
    $0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, $86D3D2D4, $F1D4E242,
    $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, $88085AE6,
    $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
    $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D,
    $3E6E77DB, $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5,
    $47B2CF7F, $30B5FFE9, $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605,
    $CDD70693, $54DE5729, $23D967BF, $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
    $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D
    );
{$ENDREGION 'crc32define'}

function umlCRC32(const Value: PByte; const Count: NativeUInt): Cardinal;
function umlString2CRC32(const Value: TPascalString): Cardinal;
function umlStreamCRC32(stream: U_Stream; StartPos, EndPos: Int64): Cardinal; overload;
function umlStreamCRC32(stream: U_Stream): Cardinal; overload;

function umlTrimSpace(const s: TPascalString): TPascalString;

function umlSeparatorText(Text_: TPascalString; dest: TCoreClassStrings; SeparatorChar: TPascalString): Integer; overload;
function umlSeparatorText(Text_: TPascalString; dest: THashVariantList; SeparatorChar: TPascalString): Integer; overload;
function umlSeparatorText(Text_: TPascalString; dest: TListPascalString; SeparatorChar: TPascalString): Integer; overload;

function umlStringsMatchText(OriginValue: TCoreClassStrings; DestValue: TPascalString; IgnoreCase: Boolean): Boolean;

function umlStringsInExists(dest: TListPascalString; SText: TPascalString; IgnoreCase: Boolean): Boolean; overload;
function umlStringsInExists(dest: TCoreClassStrings; SText: TPascalString; IgnoreCase: Boolean): Boolean; overload;
function umlStringsInExists(dest: TCoreClassStrings; SText: TPascalString): Boolean; overload;

function umlTextInStrings(const SText: TPascalString; dest: TListPascalString; IgnoreCase: Boolean): Boolean; overload;
function umlTextInStrings(const SText: TPascalString; dest: TCoreClassStrings; IgnoreCase: Boolean): Boolean; overload;
function umlTextInStrings(const SText: TPascalString; dest: TCoreClassStrings): Boolean; overload;

function umlAddNewStrTo(SourceStr: TPascalString; dest: TListPascalString; IgnoreCase: Boolean): Boolean; overload;
function umlAddNewStrTo(SourceStr: TPascalString; dest: TCoreClassStrings; IgnoreCase: Boolean): Boolean; overload;
function umlAddNewStrTo(SourceStr: TPascalString; dest: TCoreClassStrings): Boolean; overload;
function umlAddNewStrTo(SourceStr, dest: TCoreClassStrings): Integer; overload;
function umlDeleteStrings(const SText: TPascalString; dest: TCoreClassStrings; IgnoreCase: Boolean): Integer;
function umlDeleteStringsNot(const SText: TPascalString; dest: TCoreClassStrings; IgnoreCase: Boolean): Integer;
function umlMergeStrings(Source, dest: TCoreClassStrings; IgnoreCase: Boolean): Integer; overload;
function umlMergeStrings(Source, dest: TListPascalString; IgnoreCase: Boolean): Integer; overload;

function umlConverStrToFileName(const Value: TPascalString): TPascalString;

function umlSplitTextMatch(const SText, Limit, MatchText: TPascalString; IgnoreCase: Boolean): Boolean;
function umlSplitTextTrimSpaceMatch(const SText, Limit, MatchText: TPascalString; IgnoreCase: Boolean): Boolean;
function umlSplitDeleteText(const SText, Limit, MatchText: TPascalString; IgnoreCase: Boolean): TPascalString;
function umlSplitTextAsList(const SText, Limit: TPascalString; AsLst: TCoreClassStrings): Boolean;
function umlSplitTextAsListAndTrimSpace(const SText, Limit: TPascalString; AsLst: TCoreClassStrings): Boolean;
function umlListAsSplitText(const List: TCoreClassStrings; Limit: TPascalString): TPascalString; overload;
function umlListAsSplitText(const List: TListPascalString; Limit: TPascalString): TPascalString; overload;
function umlDivisionText(const buffer: TPascalString; width: Integer; DivisionAsPascalString: Boolean): TPascalString;

function umlUpdateComponentName(const Name: TPascalString): TPascalString;
function umlMakeComponentName(Owner: TCoreClassComponent; RefrenceName: TPascalString): TPascalString;
procedure umlReadComponent(stream: TCoreClassStream; comp: TCoreClassComponent);
procedure umlWriteComponent(stream: TCoreClassStream; comp: TCoreClassComponent);
procedure umlCopyComponentDataTo(comp, copyto: TCoreClassComponent);

function umlProcessCycleValue(CurrentVal, DeltaVal, StartVal, OverVal: Single; var EndFlag: Boolean): Single;

type
  TCSVGetLineCall = procedure(var L: TPascalString; var IsEnd: Boolean);
  TCSVSaveCall = procedure(const sour: TPascalString; const king, Data: TArrayPascalString);
  TCSVGetLineMethod = procedure(var L: TPascalString; var IsEnd: Boolean) of object;
  TCSVSaveMethod = procedure(const sour: TPascalString; const king, Data: TArrayPascalString) of object;
{$IFDEF FPC}
  TCSVGetLineProc = procedure(var L: TPascalString; var IsEnd: Boolean) is nested;
  TCSVSaveProc = procedure(const sour: TPascalString; const king, Data: TArrayPascalString) is nested;
{$ELSE FPC}
  TCSVGetLineProc = reference to procedure(var L: TPascalString; var IsEnd: Boolean);
  TCSVSaveProc = reference to procedure(const sour: TPascalString; const king, Data: TArrayPascalString);
{$ENDIF FPC}

procedure ImportCSV_C(const sour: TArrayPascalString; OnNotify: TCSVSaveCall);
procedure CustomImportCSV_C(const OnGetLine: TCSVGetLineCall; OnNotify: TCSVSaveCall);
procedure ImportCSV_M(const sour: TArrayPascalString; OnNotify: TCSVSaveMethod);
procedure CustomImportCSV_M(const OnGetLine: TCSVGetLineMethod; OnNotify: TCSVSaveMethod);
procedure ImportCSV_P(const sour: TArrayPascalString; OnNotify: TCSVSaveProc);
procedure CustomImportCSV_P(const OnGetLine: TCSVGetLineProc; OnNotify: TCSVSaveProc);

function GetExtLib(LibName: SystemString): HMODULE;
function FreeExtLib(LibName: SystemString): Boolean;
function GetExtProc(const LibName, ProcName: SystemString): Pointer;

type
  TArrayRawByte = array [0 .. MaxInt - 1] of Byte;
  PArrayRawByte = ^TArrayRawByte;

function umlCompareByteString(const s1: TPascalString; const s2: PArrayRawByte): Boolean; overload;
function umlCompareByteString(const s2: PArrayRawByte; const s1: TPascalString): Boolean; overload;
procedure umlSetByteString(const sour: TPascalString; const dest: PArrayRawByte); overload;
procedure umlSetByteString(const dest: PArrayRawByte; const sour: TPascalString); overload;
function umlGetByteString(const sour: PArrayRawByte; const L: Integer): TPascalString;

procedure SaveMemory(p: Pointer; siz: NativeInt; DestFile: TPascalString);

{ fast cache for fileMD5 }
function umlFileMD5(FileName: TPascalString): TMD5; overload;
procedure umlCacheFileMD5(FileName: U_String);
procedure umlCacheFileMD5FromDirectory(Directory_, Filter_: U_String);

function umlBinToInt(Value: U_String): UInt64;
function umlIntToBin(v: UInt64): U_String;

var
  Lib_DateTimeFormatSettings: TFormatSettings;

implementation

uses
{$IF Defined(WIN32) or Defined(WIN64)}
  Fast_MD5,
{$ENDIF}
  DoStatusIO, MemoryStream64;

procedure TReliableFileStream.InitIO;
begin
  if not FActivted then
      exit;

  DoStatus(PFormat('Reliable IO Open : %s', [umlGetFileName(FileName).text]));
  DoStatus(PFormat('Backup %s size: %s', [umlGetFileName(FileName).text, umlSizeToStr(SourceIO.Size).text]));

  BackupFileIO := TCoreClassFileStream.Create(FBackupFileName, fmCreate);
  BackupFileIO.Size := SourceIO.Size;
  SourceIO.Position := 0;
  BackupFileIO.Position := 0;
  BackupFileIO.CopyFrom(SourceIO, SourceIO.Size);
  BackupFileIO.Position := 0;
  DisposeObject(SourceIO);
  SourceIO := nil;
end;

procedure TReliableFileStream.FreeIO;
begin
  if not FActivted then
      exit;

  DisposeObject(BackupFileIO);
  BackupFileIO := nil;
  try
    umlDeleteFile(FFileName);
    umlRenameFile(FBackupFileName, FileName);
  except
  end;
  DoStatus(PFormat('Reliable IO Close : %s', [umlGetFileName(FileName).text]));
end;

procedure TReliableFileStream.SetSize(const NewSize: Int64);
begin
  SourceIO.Size := NewSize;
end;

procedure TReliableFileStream.SetSize(NewSize: longint);
begin
  SetSize(Int64(NewSize));
end;

constructor TReliableFileStream.Create(const FileName_: SystemString; IsNew_, IsWrite_: Boolean);
var
  m: Word;
begin
  inherited Create;
  if IsNew_ then
      m := fmCreate
  else if IsWrite_ then
      m := fmOpenReadWrite
  else
      m := fmOpenRead or fmShareDenyNone;
{$IFDEF ZDB_BACKUP}
  FActivted := IsNew_ or IsWrite_;
{$ELSE ZDB_BACKUP}
  FActivted := False;
{$ENDIF ZDB_BACKUP}
  SourceIO := TCoreClassFileStream.Create(FileName_, m);

  BackupFileIO := nil;
  FFileName := FileName_;
  FBackupFileName := FileName_ + '.save';
  umlDeleteFile(FBackupFileName);
  InitIO;
end;

destructor TReliableFileStream.Destroy;
begin
  DisposeObject(SourceIO);
  FreeIO;
  inherited Destroy;
end;

function TReliableFileStream.write(const buffer; Count: longint): longint;
begin
  if FActivted then
    begin
      Result := BackupFileIO.write(buffer, Count);
    end
  else
    begin
      Result := SourceIO.write(buffer, Count);
    end;
end;

function TReliableFileStream.read(var buffer; Count: longint): longint;
begin
  if FActivted then
    begin
      Result := BackupFileIO.read(buffer, Count);
    end
  else
    begin
      Result := SourceIO.read(buffer, Count);
    end;
end;

function TReliableFileStream.Seek(const Offset: Int64; origin: TSeekOrigin): Int64;
begin
  if FActivted then
    begin
      Result := BackupFileIO.Seek(Offset, origin);
    end
  else
    begin
      Result := SourceIO.Seek(Offset, origin);
    end;
end;

function TIOHnd.FixedString2Pascal(s: TBytes): TPascalString;
var
  buff: TBytes;
begin
  if (length(s) > 0) and (s[0] > 0) then
    begin
      SetLength(buff, s[0]);
      CopyPtr(@s[1], @buff[0], length(buff));
      Result.Bytes := buff;
      SetLength(buff, 0);
    end
  else
      Result := '';
end;

procedure TIOHnd.Pascal2FixedString(var n: TPascalString; var out_: TBytes);
var
  buff: TBytes;
begin
  while True do
    begin
      buff := n.Bytes;
      if length(buff) > FixedStringL - 1 then
          n.DeleteFirst
      else
          break;
    end;

  SetLength(out_, FixedStringL);
  out_[0] := length(buff);
  if out_[0] > 0 then
      CopyPtr(@buff[0], @out_[1], out_[0]);
  SetLength(buff, 0);
end;

function TIOHnd.CheckFixedStringLoss(s: TPascalString): Boolean;
var
  buff: TBytes;
begin
  buff := s.Bytes;
  Result := length(buff) > FixedStringL - 1;
  SetLength(buff, 0);
end;

function umlBytesOf(const s: TPascalString): TBytes;
begin
  Result := s.Bytes
end;

function umlStringOf(const s: TBytes): TPascalString;
begin
  Result.Bytes := s;
end;

function umlNewString(const s: TPascalString): P_String;
var
  p: P_String;
begin
  new(p);
  p^ := s;
  Result := p;
end;

procedure umlFreeString(const p: P_String);
begin
  if p <> nil then
    begin
      p^ := '';
      Dispose(p);
    end;
end;

function umlComparePosStr(const s: TPascalString; Offset: Integer; const t: TPascalString): Boolean;
begin
  Result := s.ComparePos(Offset, @t);
end;

function umlPos(const SubStr, s: TPascalString; const Offset: Integer = 1): Integer;
begin
  Result := s.GetPos(SubStr, Offset);
end;

function umlVarToStr(const v: Variant; const Base64Conver: Boolean): TPascalString; overload;
var
  n, b64: TPascalString;
begin
  try
    case VarType(v) of
      varSmallInt, varInteger, varShortInt, varByte, varWord, varLongWord: Result := IntToStr(v);
      varInt64: Result := IntToStr(Int64(v));
      varUInt64: {$IFDEF FPC} Result := IntToStr(UInt64(v)); {$ELSE} Result := UIntToStr(UInt64(v)); {$ENDIF}
      varSingle, varDouble, varCurrency, varDate: Result := FloatToStr(v);
      varOleStr, varString, varUString:
        begin
          n.text := VarToStr(v);

          if Base64Conver and umlExistsChar(n, #10#13#9#8#0) then
            begin
              umlEncodeLineBASE64(n, b64);
              Result := '___base64:' + b64.text;
            end
          else
              Result := n.text;
        end;
      varBoolean: Result := umlBoolToStr(v);
      else
        Result := VarToStr(v);
    end;
  except
    try
        Result := VarToStr(v);
    except
        Result := '';
    end;
  end;
end;

function umlVarToStr(const v: Variant): TPascalString;
begin
  Result := umlVarToStr(v, True);
end;

function umlStrToVar(const s: TPascalString): Variant;
var
  b64: TPascalString;
begin
  if s.Exists([#10, #13, #9, #8, #0]) then
    begin
      umlEncodeLineBASE64(s, b64);
      Result := '___base64:' + b64.text;
    end
  else
      Result := s.text;
end;

function umlMax(const v1, v2: UInt64): UInt64;
begin
  if v1 > v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMax(const v1, v2: Cardinal): Cardinal;
begin
  if v1 > v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMax(const v1, v2: Word): Word;
begin
  if v1 > v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMax(const v1, v2: Byte): Byte;
begin
  if v1 > v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMax(const v1, v2: Int64): Int64;
begin
  if v1 > v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMax(const v1, v2: Integer): Integer;
begin
  if v1 > v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMax(const v1, v2: SmallInt): SmallInt;
begin
  if v1 > v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMax(const v1, v2: ShortInt): ShortInt;
begin
  if v1 > v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMax(const v1, v2: Double): Double;
begin
  if v1 > v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMax(const v1, v2: Single): Single;
begin
  if v1 > v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMin(const v1, v2: UInt64): UInt64;
begin
  if v1 < v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMin(const v1, v2: Cardinal): Cardinal;
begin
  if v1 < v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMin(const v1, v2: Word): Word;
begin
  if v1 < v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMin(const v1, v2: Byte): Byte;
begin
  if v1 < v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMin(const v1, v2: Int64): Int64;
begin
  if v1 < v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMin(const v1, v2: Integer): Integer;
begin
  if v1 < v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMin(const v1, v2: SmallInt): SmallInt;
begin
  if v1 < v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMin(const v1, v2: ShortInt): ShortInt;
begin
  if v1 < v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMin(const v1, v2: Double): Double;
begin
  if v1 < v2 then
      Result := v1
  else
      Result := v2;
end;

function umlMin(const v1, v2: Single): Single;
begin
  if v1 < v2 then
      Result := v1
  else
      Result := v2;
end;

function umlClamp(const v, min_, max_: UInt64): UInt64;
begin
  if min_ > max_ then
      Result := umlClamp(v, max_, min_)
  else if v > max_ then
      Result := max_
  else if v < min_ then
      Result := min_
  else
      Result := v;
end;

function umlClamp(const v, min_, max_: Cardinal): Cardinal;
begin
  if min_ > max_ then
      Result := umlClamp(v, max_, min_)
  else if v > max_ then
      Result := max_
  else if v < min_ then
      Result := min_
  else
      Result := v;
end;

function umlClamp(const v, min_, max_: Word): Word;
begin
  if min_ > max_ then
      Result := umlClamp(v, max_, min_)
  else if v > max_ then
      Result := max_
  else if v < min_ then
      Result := min_
  else
      Result := v;
end;

function umlClamp(const v, min_, max_: Byte): Byte;
begin
  if min_ > max_ then
      Result := umlClamp(v, max_, min_)
  else if v > max_ then
      Result := max_
  else if v < min_ then
      Result := min_
  else
      Result := v;
end;

function umlClamp(const v, min_, max_: Int64): Int64;
begin
  if min_ > max_ then
      Result := umlClamp(v, max_, min_)
  else if v > max_ then
      Result := max_
  else if v < min_ then
      Result := min_
  else
      Result := v;
end;

function umlClamp(const v, min_, max_: SmallInt): SmallInt;
begin
  if min_ > max_ then
      Result := umlClamp(v, max_, min_)
  else if v > max_ then
      Result := max_
  else if v < min_ then
      Result := min_
  else
      Result := v;
end;

function umlClamp(const v, min_, max_: ShortInt): ShortInt;
begin
  if min_ > max_ then
      Result := umlClamp(v, max_, min_)
  else if v > max_ then
      Result := max_
  else if v < min_ then
      Result := min_
  else
      Result := v;
end;

function umlClamp(const v, min_, max_: Double): Double;
begin
  if min_ > max_ then
      Result := umlClamp(v, max_, min_)
  else if v > max_ then
      Result := max_
  else if v < min_ then
      Result := min_
  else
      Result := v;
end;

function umlClamp(const v, min_, max_: Single): Single;
begin
  if min_ > max_ then
      Result := umlClamp(v, max_, min_)
  else if v > max_ then
      Result := max_
  else if v < min_ then
      Result := min_
  else
      Result := v;
end;

function umlInRange(const v, min_, max_: UInt64): Boolean;
begin
  Result := (v >= umlMin(min_, max_)) and (v <= umlMax(min_, max_));
end;

function umlInRange(const v, min_, max_: Cardinal): Boolean;
begin
  Result := (v >= umlMin(min_, max_)) and (v <= umlMax(min_, max_));
end;

function umlInRange(const v, min_, max_: Word): Boolean;
begin
  Result := (v >= umlMin(min_, max_)) and (v <= umlMax(min_, max_));
end;

function umlInRange(const v, min_, max_: Byte): Boolean;
begin
  Result := (v >= umlMin(min_, max_)) and (v <= umlMax(min_, max_));
end;

function umlInRange(const v, min_, max_: SmallInt): Boolean;
begin
  Result := (v >= umlMin(min_, max_)) and (v <= umlMax(min_, max_));
end;

function umlInRange(const v, min_, max_: ShortInt): Boolean;
begin
  Result := (v >= umlMin(min_, max_)) and (v <= umlMax(min_, max_));
end;

function umlInRange(const v, min_, max_: Double): Boolean;
begin
  Result := (v >= umlMin(min_, max_)) and (v <= umlMax(min_, max_));
end;

function umlInRange(const v, min_, max_: Single): Boolean;
begin
  Result := (v >= umlMin(min_, max_)) and (v <= umlMax(min_, max_));
end;

function umlGetResourceStream(const FileName: TPascalString): TCoreClassStream;
var
  n: TPascalString;
begin
  if FileName.Exists('.') then
      n := umlDeleteLastStr(FileName, '.')
  else
      n := FileName;

  Result := TCoreClassResourceStream.Create(HInstance, n.text, RT_RCDATA);
end;

function umlSameVarValue(const v1, v2: Variant): Boolean;
begin
  try
      Result := VarSameValue(v1, v2);
  except
      Result := False;
  end;
end;

function umlSameVariant(const v1, v2: Variant): Boolean;
begin
  try
      Result := VarSameValue(v1, v2);
  except
      Result := False;
  end;
end;

function umlRandom(const rnd: TMT19937Random): Integer;
begin
  Result := rnd.Rand32(MaxInt);
end;

function umlRandom: Integer;
begin
  Result := MT19937Rand32(MaxInt);
end;

function umlRandomRange64(const rnd: TMT19937Random; const min_, max_: Int64): Int64;
var
  mn, mx: Int64;
begin
  if min_ = max_ then
    begin
      Result := min_;
      exit;
    end;

  mn := min_;
  mx := max_;

  if mn > mx then
      inc(mn)
  else
      inc(mx);

  if mn > mx then
      Result := rnd.Rand64(mn - mx) + mx
  else
      Result := rnd.Rand64(mx - mn) + mn;
end;

function umlRandomRange(const rnd: TMT19937Random; const min_, max_: Integer): Integer;
var
  mn, mx: Integer;
begin
  if min_ = max_ then
    begin
      Result := min_;
      exit;
    end;

  mn := min_;
  mx := max_;

  if mn > mx then
      inc(mn)
  else
      inc(mx);

  if mn > mx then
      Result := rnd.Rand32(mn - mx) + mx
  else
      Result := rnd.Rand32(mx - mn) + mn;
end;

function umlRandomRangeS(const rnd: TMT19937Random; const min_, max_: Single): Single;
begin
  Result := (umlRandomRange64(rnd, Trunc(min_ * 1000), Trunc(max_ * 1000))) * 0.001;
end;

function umlRandomRangeD(const rnd: TMT19937Random; const min_, max_: Double): Double;
begin
  Result := (umlRandomRange64(rnd, Trunc(min_ * 10000), Trunc(max_ * 10000))) * 0.0001;
end;

function umlRandomRangeF(const rnd: TMT19937Random; const min_, max_: Double): Double;
begin
  Result := (umlRandomRange64(rnd, Trunc(min_ * 10000), Trunc(max_ * 10000))) * 0.0001;
end;

function umlRandomRange64(const min_, max_: Int64): Int64;
var
  mn, mx: Int64;
begin
  if min_ = max_ then
    begin
      Result := min_;
      exit;
    end;
  mn := min_;
  mx := max_;

  if mn > mx then
      inc(mn)
  else
      inc(mx);

  if mn > mx then
      Result := MT19937Rand64(mn - mx) + mx
  else
      Result := MT19937Rand64(mx - mn) + mn;
end;

function umlRandomRange(const min_, max_: Integer): Integer;
var
  mn, mx: Integer;
begin
  if min_ = max_ then
    begin
      Result := min_;
      exit;
    end;
  mn := min_;
  mx := max_;

  if mn > mx then
      inc(mn)
  else
      inc(mx);

  if mn > mx then
      Result := MT19937Rand32(mn - mx) + mx
  else
      Result := MT19937Rand32(mx - mn) + mn;
end;

function umlRandomRangeS(const min_, max_: Single): Single;
begin
  Result := (umlRandomRange64(Trunc(min_ * 1000), Trunc(max_ * 1000))) * 0.001;
end;

function umlRandomRangeD(const min_, max_: Double): Double;
begin
  Result := (umlRandomRange64(Trunc(min_ * 10000), Trunc(max_ * 10000))) * 0.0001;
end;

function umlRandomRangeF(const min_, max_: Double): Double;
begin
  Result := (umlRandomRange64(Trunc(min_ * 10000), Trunc(max_ * 10000))) * 0.0001;
end;

function umlDefaultTime: Double;
begin
  Result := Now;
end;

function umlNow: Double;
begin
  Result := Now();
end;

function umlDefaultAttrib: Integer;
begin
  Result := 0;
end;

function umlBoolToStr(const Value: Boolean): TPascalString;
begin
  if Value then
      Result := 'True'
  else
      Result := 'False';
end;

function umlStrToBool(const Value: TPascalString): Boolean;
var
  NewValue: TPascalString;
begin
  NewValue := umlTrimSpace(Value);
  if NewValue.Same('Yes') then
      Result := True
  else if NewValue.Same('No') then
      Result := False
  else if NewValue.Same('True') then
      Result := True
  else if NewValue.Same('False') then
      Result := False
  else if NewValue.Same('1') then
      Result := True
  else if NewValue.Same('0') then
      Result := False
  else
      Result := False;
end;

function umlFileExists(const FileName: TPascalString): Boolean;
begin
  if FileName.L > 0 then
      Result := FileExists(FileName.text)
  else
      Result := False;
end;

function umlDirectoryExists(const DirectoryName: TPascalString): Boolean;
begin
  if DirectoryName.Len > 0 then
      Result := DirectoryExists(DirectoryName.text)
  else
      Result := False;
end;

function umlCreateDirectory(const DirectoryName: TPascalString): Boolean;
begin
  Result := umlDirectoryExists(DirectoryName);
  if Result then
      exit;

  try
      Result := ForceDirectories(DirectoryName.text);
  except
    try
        Result := CreateDir(DirectoryName.text);
    except
        Result := False;
    end;
  end;
end;

function umlCurrentDirectory: TPascalString;
begin
  Result.text := GetCurrentDir;
end;

function umlCurrentPath: TPascalString;
begin
  Result.text := GetCurrentDir;
  case CurrentPlatform of
    epWin32, epWin64: if (Result.Len = 0) or (Result.Last <> '\') then
          Result := Result.text + '\';
    else
      if (Result.Len = 0) or (Result.Last <> '/') then
          Result := Result.text + '/';
  end;
end;

function umlGetCurrentPath: TPascalString;
begin
  Result := umlCurrentPath();
end;

procedure umlSetCurrentPath(ph: TPascalString);
begin
  SetCurrentDir(ph.text);
end;

function umlFindFirstFile(const FileName: TPascalString; var SR: TSR): Boolean;
label SearchPoint;
begin
  if FindFirst(FileName.text, faAnyFile, SR) <> 0 then
    begin
      Result := False;
      exit;
    end;
  if ((SR.Attr and faDirectory) <> faDirectory) then
    begin
      Result := True;
      exit;
    end;
SearchPoint:
  if FindNext(SR) <> 0 then
    begin
      Result := False;
      exit;
    end;
  if ((SR.Attr and faDirectory) <> faDirectory) then
    begin
      Result := True;
      exit;
    end;
  goto SearchPoint;
end;

function umlFindNextFile(var SR: TSR): Boolean;
label SearchPoint;
begin
SearchPoint:
  if FindNext(SR) <> 0 then
    begin
      Result := False;
      exit;
    end;
  if ((SR.Attr and faDirectory) <> faDirectory) then
    begin
      Result := True;
      exit;
    end;
  goto SearchPoint;
end;

function umlFindFirstDir(const DirName: TPascalString; var SR: TSR): Boolean;
label SearchPoint;
begin
  if FindFirst(DirName.text, faAnyFile, SR) <> 0 then
    begin
      Result := False;
      exit;
    end;
  if ((SR.Attr and faDirectory) = faDirectory) and (SR.Name <> '.') and (SR.Name <> '..') then
    begin
      Result := True;
      exit;
    end;
SearchPoint:
  if FindNext(SR) <> 0 then
    begin
      Result := False;
      exit;
    end;
  if ((SR.Attr and faDirectory) = faDirectory) and (SR.Name <> '.') and (SR.Name <> '..') then
    begin
      Result := True;
      exit;
    end;
  goto SearchPoint;
end;

function umlFindNextDir(var SR: TSR): Boolean;
label SearchPoint;
begin
SearchPoint:
  if FindNext(SR) <> 0 then
    begin
      Result := False;
      exit;
    end;
  if ((SR.Attr and faDirectory) = faDirectory) and (SR.Name <> '.') and (SR.Name <> '..') then
    begin
      Result := True;
      exit;
    end;
  goto SearchPoint;
end;

procedure umlFindClose(var SR: TSR);
begin
  FindClose(SR);
end;

function umlGetFileList(const FullPath: TPascalString; AsLst: TCoreClassStrings): Integer;
var
  _SR: TSR;
begin
  Result := 0;
  if umlFindFirstFile(umlCombineFileName(FullPath, '*'), _SR) then
    begin
      repeat
        AsLst.Add(_SR.Name);
        inc(Result);
      until not umlFindNextFile(_SR);
    end;
  umlFindClose(_SR);
end;

function umlGetDirList(const FullPath: TPascalString; AsLst: TCoreClassStrings): Integer;
var
  _SR: TSR;
begin
  Result := 0;
  if umlFindFirstDir(umlCombineFileName(FullPath, '*'), _SR) then
    begin
      repeat
        AsLst.Add(_SR.Name);
        inc(Result);
      until not umlFindNextDir(_SR);
    end;
  umlFindClose(_SR);
end;

function umlGetFileList(const FullPath: TPascalString; AsLst: TPascalStringList): Integer;
var
  _SR: TSR;
begin
  Result := 0;
  if umlFindFirstFile(umlCombineFileName(FullPath, '*'), _SR) then
    begin
      repeat
        AsLst.Add(_SR.Name);
        inc(Result);
      until not umlFindNextFile(_SR);
    end;
  umlFindClose(_SR);
end;

function umlGetDirList(const FullPath: TPascalString; AsLst: TPascalStringList): Integer;
var
  _SR: TSR;
begin
  Result := 0;
  if umlFindFirstDir(umlCombineFileName(FullPath, '*'), _SR) then
    begin
      repeat
        AsLst.Add(_SR.Name);
        inc(Result);
      until not umlFindNextDir(_SR);
    end;
  umlFindClose(_SR);
end;

function umlGetFileListWithFullPath(const FullPath: TPascalString): U_StringArray;
var
  ph: TPascalString;
  ns: TPascalStringList;
  i: Integer;
begin
  ph := FullPath;
  ns := TPascalStringList.Create;
  umlGetFileList(FullPath, ns);
  SetLength(Result, ns.Count);
  for i := 0 to ns.Count - 1 do
      Result[i] := umlCombineFileName(ph, ns[i]).text;
  DisposeObject(ns);
end;

function umlGetDirListWithFullPath(const FullPath: TPascalString): U_StringArray;
var
  ph: TPascalString;
  ns: TPascalStringList;
  i: Integer;
begin
  ph := FullPath;
  ns := TPascalStringList.Create;
  umlGetDirList(FullPath, ns);
  SetLength(Result, ns.Count);
  for i := 0 to ns.Count - 1 do
      Result[i] := umlCombinePath(ph, ns[i]).text;
  DisposeObject(ns);
end;

function umlGetFileListPath(const FullPath: TPascalString): U_StringArray;
var
  ph: TPascalString;
  ns: TPascalStringList;
  i: Integer;
begin
  ph := FullPath;
  ns := TPascalStringList.Create;
  umlGetFileList(FullPath, ns);
  SetLength(Result, ns.Count);
  for i := 0 to ns.Count - 1 do
      Result[i] := ns[i];
  DisposeObject(ns);
end;

function umlGetDirListPath(const FullPath: TPascalString): U_StringArray;
var
  ph: TPascalString;
  ns: TPascalStringList;
  i: Integer;
begin
  ph := FullPath;
  ns := TPascalStringList.Create;
  umlGetDirList(FullPath, ns);
  SetLength(Result, ns.Count);
  for i := 0 to ns.Count - 1 do
      Result[i] := ns[i];
  DisposeObject(ns);
end;

function umlCombinePath(const s1, s2: TPascalString): TPascalString;
begin
  if CurrentPlatform in [epWin32, epWin64] then
      Result := umlCombineWinPath(s1, s2)
  else
      Result := umlCombineUnixPath(s1, s2);
end;

function umlCombineFileName(const pathName, FileName: TPascalString): TPascalString;
begin
  if CurrentPlatform in [epWin32, epWin64] then
      Result := umlCombineWinFileName(pathName, FileName)
  else
      Result := umlCombineUnixFileName(pathName, FileName);
end;

function umlCombineUnixPath(const s1, s2: TPascalString): TPascalString;
var
  n1, n2, n: TPascalString;
begin
  n1 := umlTrimSpace(s1);
  n2 := umlTrimSpace(s2);

  n1 := umlCharReplace(n1, '\', '/');
  n2 := umlCharReplace(n2, '\', '/');

  if (n2.Len > 0) and (n2.First = '/') then
      n2.DeleteFirst;

  if n1.Len > 0 then
    begin
      if n1.Last = '/' then
          Result := n1.text + n2.text
      else
          Result := n1.text + '/' + n2.text;
    end
  else
      Result := n2;

  repeat
    n := Result;
    Result := umlStringReplace(Result, '//', '/', True);
  until Result.Same(n);
  if (Result.Len > 0) and (Result.Last <> '/') then
      Result.Append('/');
end;

function umlCombineUnixFileName(const pathName, FileName: TPascalString): TPascalString;
var
  pn, fn, n: TPascalString;
begin
  pn := umlTrimSpace(pathName);
  fn := umlTrimSpace(FileName);

  pn := umlCharReplace(pn, '\', '/');
  fn := umlCharReplace(fn, '\', '/');

  if (fn.Len > 0) and (fn.First = '/') then
      fn.DeleteFirst;
  if (fn.Len > 0) and (fn.Last = '/') then
      fn.DeleteLast;

  if pn.Len > 0 then
    begin
      if pn.Last = '/' then
          Result := pn.text + fn.text
      else
          Result := pn.text + '/' + fn.text;
    end
  else
      Result := fn;

  repeat
    n := Result;
    Result := umlStringReplace(Result, '//', '/', True);
  until Result.Same(n);
end;

function umlCombineWinPath(const s1, s2: TPascalString): TPascalString;
var
  n1, n2, n: TPascalString;
begin
  n1 := umlTrimSpace(s1);
  n2 := umlTrimSpace(s2);

  n1 := umlCharReplace(n1, '/', '\');
  n2 := umlCharReplace(n2, '/', '\');

  if (n2.Len > 0) and (n2.First = '\') then
      n2.DeleteFirst;

  if n1.Len > 0 then
    begin
      if n1.Last = '\' then
          Result := n1.text + n2.text
      else
          Result := n1.text + '\' + n2.text;
    end
  else
      Result := n2;

  repeat
    n := Result;
    Result := umlStringReplace(Result, '\\', '\', True);
  until Result.Same(n);
  if (Result.Len > 0) and (Result.Last <> '\') then
      Result.Append('\');
end;

function umlCombineWinFileName(const pathName, FileName: TPascalString): TPascalString;
var
  pn, fn, n: TPascalString;
begin
  pn := umlTrimSpace(pathName);
  fn := umlTrimSpace(FileName);

  pn := umlCharReplace(pn, '/', '\');
  fn := umlCharReplace(fn, '/', '\');

  if (fn.Len > 0) and (fn.First = '\') then
      fn.DeleteFirst;
  if (fn.Len > 0) and (fn.Last = '\') then
      fn.DeleteLast;

  if pn.Len > 0 then
    begin
      if pn.Last = '\' then
          Result := pn.text + fn.text
      else
          Result := pn.text + '\' + fn.text;
    end
  else
      Result := fn;

  repeat
    n := Result;
    Result := umlStringReplace(Result, '\\', '\', True);
  until Result.Same(n);

  if Result.Last = '\' then
      Result.DeleteLast;
end;

function umlGetFileName(platform_: TExecutePlatform; const s: TPascalString): TPascalString;
var
  n: TPascalString;
begin
  case platform_ of
    epWin32, epWin64:
      begin
        n := umlCharReplace(umlTrimSpace(s), '/', '\');
        if n.Len = 0 then
            Result := ''
        else if (n.Last = '\') then
            Result := ''
        else if n.Exists('\') then
            Result := umlGetLastStr(n, '\')
        else
            Result := n;
      end;
    else
      begin
        n := umlCharReplace(umlTrimSpace(s), '\', '/');
        if n.Len = 0 then
            Result := ''
        else if (n.Last = '/') then
            Result := ''
        else if n.Exists('/') then
            Result := umlGetLastStr(n, '/')
        else
            Result := n;
      end;
  end;
end;

function umlGetFileName(const s: TPascalString): TPascalString;
begin
  Result := umlGetFileName(CurrentPlatform, s);
end;

function umlGetWindowsFileName(const s: TPascalString): TPascalString;
var
  n: TPascalString;
begin
  n := umlCharReplace(umlTrimSpace(s), '/', '\');
  if n.Len = 0 then
      Result := ''
  else if (n.Last = '\') then
      Result := ''
  else if n.Exists('\') then
      Result := umlGetLastStr(n, '\')
  else
      Result := n;
end;

function umlGetUnixFileName(const s: TPascalString): TPascalString;
var
  n: TPascalString;
begin
  n := umlCharReplace(umlTrimSpace(s), '\', '/');
  if n.Len = 0 then
      Result := ''
  else if (n.Last = '/') then
      Result := ''
  else if n.Exists('/') then
      Result := umlGetLastStr(n, '/')
  else
      Result := n;
end;

function umlGetFilePath(platform_: TExecutePlatform; const s: TPascalString): TPascalString;
var
  n: TPascalString;
begin
  case platform_ of
    epWin32, epWin64:
      begin
        n := umlCharReplace(umlTrimSpace(s), '/', '\');
        if n.Len = 0 then
            Result := ''
        else if not n.Exists('\') then
            Result := ''
        else if (n.Last <> '\') then
            Result := umlDeleteLastStr(n, '\')
        else
            Result := n;
        if umlMultipleMatch('?:', Result) then
            Result.Append('\');
      end;
    else
      begin
        n := umlCharReplace(umlTrimSpace(s), '\', '/');
        if n.Len = 0 then
            Result := ''
        else if not n.Exists('/') then
            Result := ''
        else if (n.Last <> '/') then
            Result := umlDeleteLastStr(n, '/')
        else
            Result := n;
      end;
  end;
end;

function umlGetFilePath(const s: TPascalString): TPascalString;
begin
  Result := umlGetFilePath(CurrentPlatform, s);
end;

function umlGetWindowsFilePath(const s: TPascalString): TPascalString;
var
  n: TPascalString;
begin
  n := umlCharReplace(umlTrimSpace(s), '/', '\');
  if n.Len = 0 then
      Result := ''
  else if not n.Exists('\') then
      Result := ''
  else if (n.Last <> '\') then
      Result := umlDeleteLastStr(n, '\')
  else
      Result := n;
  if umlMultipleMatch('?:', Result) then
      Result.Append('\');
end;

function umlGetUnixFilePath(const s: TPascalString): TPascalString;
var
  n: TPascalString;
begin
  n := umlCharReplace(umlTrimSpace(s), '\', '/');
  if n.Len = 0 then
      Result := ''
  else if not n.Exists('/') then
      Result := ''
  else if (n.Last <> '/') then
      Result := umlDeleteLastStr(n, '/')
  else
      Result := n;
end;

function umlChangeFileExt(const s, ext: TPascalString): TPascalString;
var
  ph, fn: TPascalString;
  n: TPascalString;
begin
  if s.Len = 0 then
    begin
      Result := ext;
      exit;
    end;

  ph := umlGetFilePath(s);
  fn := umlGetFileName(s);

  n := ext;
  if (n.Len > 0) and (n.First <> '.') then
      n.text := '.' + n.text;
  if umlExistsChar(fn, '.') then
      Result := umlDeleteLastStr(fn, '.') + n
  else
      Result := fn + n;

  if ph.Len > 0 then
      Result := umlCombineFileName(ph, Result);
end;

function umlGetFileExt(const s: TPascalString): TPascalString;
begin
  if (s.Len > 0) and (umlExistsChar(s, '.')) then
      Result := '.' + umlGetLastStr(s, '.')
  else
      Result := '';
end;

procedure InitIOHnd(var IOHnd: TIOHnd);
begin
  IOHnd.IsOnlyRead := True;
  IOHnd.IsOpen := False;
  IOHnd.AutoFree := False;
  IOHnd.Handle := nil;
  IOHnd.Time := 0;
  IOHnd.Size := 0;
  IOHnd.Position := 0;
  IOHnd.FileName := '';
  IOHnd.FlushBuff := nil;
  IOHnd.FlushPosition := -1;
  IOHnd.PrepareReadPosition := -1;
  IOHnd.PrepareReadBuff := nil;
  IOHnd.IORead := 0;
  IOHnd.IOWrite := 0;
  IOHnd.WriteStated := False;
  IOHnd.FixedStringL := 64 + 1;
  IOHnd.Data := nil;
  IOHnd.Return := C_NotError;
end;

function umlFileCreateAsStream(const FileName: TPascalString; stream: U_Stream; var IOHnd: TIOHnd; OnlyRead_: Boolean): Boolean;
begin
  if IOHnd.IsOpen = True then
    begin
      IOHnd.Return := C_FileIsActive;
      Result := False;
      exit;
    end;
  stream.Position := 0;
  IOHnd.Handle := stream;
  IOHnd.Return := C_NotError;
  IOHnd.Size := stream.Size;
  IOHnd.Position := stream.Position;
  IOHnd.Time := umlDefaultTime;
  IOHnd.FileName := FileName;
  IOHnd.IsOpen := True;
  IOHnd.IsOnlyRead := OnlyRead_;
  IOHnd.AutoFree := False;
  Result := True;
end;

function umlFileCreateAsStream(const FileName: TPascalString; stream: U_Stream; var IOHnd: TIOHnd): Boolean;
begin
  Result := umlFileCreateAsStream(FileName, stream, IOHnd, False);
end;

function umlFileCreateAsStream(stream: U_Stream; var IOHnd: TIOHnd): Boolean;
begin
  Result := umlFileCreateAsStream('', stream, IOHnd, False);
end;

function umlFileCreateAsStream(stream: U_Stream; var IOHnd: TIOHnd; OnlyRead_: Boolean): Boolean;
begin
  Result := umlFileCreateAsStream('', stream, IOHnd, False);
end;

function umlFileOpenAsStream(const FileName: TPascalString; stream: U_Stream; var IOHnd: TIOHnd; OnlyRead_: Boolean): Boolean;
begin
  if IOHnd.IsOpen = True then
    begin
      IOHnd.Return := C_FileIsActive;
      Result := False;
      exit;
    end;
  stream.Position := 0;
  IOHnd.Handle := stream;
  IOHnd.Return := C_NotError;
  IOHnd.Size := stream.Size;
  IOHnd.Position := stream.Position;
  IOHnd.Time := umlDefaultTime;
  IOHnd.FileName := FileName;
  IOHnd.IsOpen := True;
  IOHnd.IsOnlyRead := OnlyRead_;
  IOHnd.AutoFree := False;
  Result := True;
end;

function umlFileCreateAsMemory(var IOHnd: TIOHnd): Boolean;
begin
  if IOHnd.IsOpen = True then
    begin
      IOHnd.Return := C_FileIsActive;
      Result := False;
      exit;
    end;
  IOHnd.Handle := TMemoryStream64.CustomCreate(8192);
  IOHnd.Return := C_NotError;
  IOHnd.Size := IOHnd.Handle.Size;
  IOHnd.Position := IOHnd.Handle.Position;
  IOHnd.Time := umlDefaultTime;
  IOHnd.FileName := 'Memory';
  IOHnd.IsOpen := True;
  IOHnd.IsOnlyRead := False;
  IOHnd.AutoFree := True;
  Result := True;
end;

function umlFileCreate(const FileName: TPascalString; var IOHnd: TIOHnd): Boolean;
begin
  if IOHnd.IsOpen = True then
    begin
      IOHnd.Return := C_FileIsActive;
      Result := False;
      exit;
    end;
  try
      IOHnd.Handle := TReliableFileStream.Create(FileName.text, True, True);
  except
    IOHnd.Handle := nil;
    IOHnd.Return := C_CreateFileError;
    Result := False;
    exit;
  end;
  IOHnd.Return := C_NotError;
  IOHnd.Size := 0;
  IOHnd.Position := 0;
  IOHnd.Time := Now;
  IOHnd.FileName := FileName;
  IOHnd.IsOpen := True;
  IOHnd.IsOnlyRead := False;
  IOHnd.AutoFree := True;
  Result := True;
end;

function umlFileOpen(const FileName: TPascalString; var IOHnd: TIOHnd; OnlyRead_: Boolean): Boolean;
begin
  if IOHnd.IsOpen = True then
    begin
      IOHnd.Return := C_FileIsActive;
      Result := False;
      exit;
    end;
  if not umlFileExists(FileName) then
    begin
      IOHnd.Return := C_NotFindFile;
      Result := False;
      exit;
    end;
  try
      IOHnd.Handle := TReliableFileStream.Create(FileName.text, False, not OnlyRead_);
  except
    IOHnd.Handle := nil;
    IOHnd.Return := C_OpenFileError;
    Result := False;
    exit;
  end;
  IOHnd.IsOnlyRead := OnlyRead_;
  IOHnd.Return := C_NotError;
  IOHnd.Size := IOHnd.Handle.Size;
  IOHnd.Position := 0;
  IOHnd.Time := umlGetFileTime(FileName);
  IOHnd.FileName := FileName;
  IOHnd.IsOpen := True;
  IOHnd.AutoFree := True;
  Result := True;
end;

function umlFileClose(var IOHnd: TIOHnd): Boolean;
begin
  if IOHnd.IsOpen = False then
    begin
      IOHnd.Return := C_NotOpenFile;
      Result := False;
      exit;
    end;
  if IOHnd.Handle = nil then
    begin
      IOHnd.Return := C_FileHandleError;
      Result := False;
      exit;
    end;

  umlFileFlushWrite(IOHnd);

  if IOHnd.PrepareReadBuff <> nil then
      DisposeObject(IOHnd.PrepareReadBuff);
  IOHnd.PrepareReadBuff := nil;
  IOHnd.PrepareReadPosition := -1;

  try
    if IOHnd.AutoFree then
        DisposeObject(IOHnd.Handle)
    else
        IOHnd.Handle := nil;
  except
  end;
  IOHnd.Handle := nil;
  IOHnd.Return := C_NotError;
  IOHnd.Time := umlDefaultTime;
  IOHnd.FileName := '';
  IOHnd.IsOpen := False;
  IOHnd.WriteStated := False;
  Result := True;
end;

function umlFileUpdate(var IOHnd: TIOHnd): Boolean;
begin
  if (IOHnd.IsOpen = False) or (IOHnd.Handle = nil) then
    begin
      IOHnd.Return := C_FileHandleError;
      Result := False;
      exit;
    end;

  umlFileFlushWrite(IOHnd);
  umlResetPrepareRead(IOHnd);
  IOHnd.WriteStated := False;

  Result := True;
end;

function umlFileTest(var IOHnd: TIOHnd): Boolean;
begin
  if (IOHnd.IsOpen = False) or (IOHnd.Handle = nil) then
    begin
      IOHnd.Return := C_FileHandleError;
      Result := False;
      exit;
    end;
  IOHnd.Return := C_NotError;
  Result := True;
end;

procedure umlResetPrepareRead(var IOHnd: TIOHnd);
begin
  if IOHnd.PrepareReadBuff <> nil then
      DisposeObject(IOHnd.PrepareReadBuff);
  IOHnd.PrepareReadBuff := nil;
  IOHnd.PrepareReadPosition := -1;
end;

function umlFilePrepareRead(var IOHnd: TIOHnd; Size: Int64; var buff): Boolean;
var
  m64: TMemoryStream64;
  preRedSiz: Int64;
begin
  Result := False;

  if not(IOHnd.Handle.InheritsFrom(TCoreClassFileStream) or IOHnd.Handle.InheritsFrom(TReliableFileStream)) then
      exit;

  if Size > C_PrepareReadCacheSize then
    begin
      umlResetPrepareRead(IOHnd);
      IOHnd.Handle.Position := IOHnd.Position;
      exit;
    end;

  if IOHnd.PrepareReadBuff = nil then
      IOHnd.PrepareReadBuff := TMemoryStream64.Create;

  m64 := TMemoryStream64(IOHnd.PrepareReadBuff);

  if (IOHnd.Position < IOHnd.PrepareReadPosition) or (IOHnd.PrepareReadPosition + m64.Size < IOHnd.Position + Size) then
    begin
      // prepare read buffer
      IOHnd.Handle.Position := IOHnd.Position;
      IOHnd.PrepareReadPosition := IOHnd.Position;

      m64.Clear;
      IOHnd.PrepareReadPosition := IOHnd.Handle.Position;
      if IOHnd.Handle.Size - IOHnd.Handle.Position >= C_PrepareReadCacheSize then
        begin
          Result := m64.CopyFrom(IOHnd.Handle, C_PrepareReadCacheSize) = C_PrepareReadCacheSize;
          inc(IOHnd.IORead, C_PrepareReadCacheSize);
        end
      else
        begin
          preRedSiz := IOHnd.Handle.Size - IOHnd.Handle.Position;
          Result := m64.CopyFrom(IOHnd.Handle, preRedSiz) = preRedSiz;
          inc(IOHnd.IORead, preRedSiz);
        end;
    end;

  if (IOHnd.Position >= IOHnd.PrepareReadPosition) and (IOHnd.PrepareReadPosition + m64.Size >= IOHnd.Position + Size) then
    begin
      CopyPtr(Pointer(NativeUInt(m64.Memory) + (IOHnd.Position - IOHnd.PrepareReadPosition)), @buff, Size);
      inc(IOHnd.Position, Size);
      Result := True;
    end
  else
    begin
      // safe process
      umlResetPrepareRead(IOHnd);
      IOHnd.Handle.Position := IOHnd.Position;
      exit;
    end;
end;

function umlFileRead(var IOHnd: TIOHnd; const Size: Int64; var buff): Boolean;
var
  BuffPointer: Pointer;
  i: NativeInt;
  BuffInt: NativeUInt;
begin
  if not umlFileFlushWrite(IOHnd) then
    begin
      Result := False;
      exit;
    end;

  if Size = 0 then
    begin
      IOHnd.Return := C_NotError;
      Result := True;
      exit;
    end;

  if umlFilePrepareRead(IOHnd, Size, buff) then
    begin
      IOHnd.Return := C_NotError;
      Result := True;
      exit;
    end;

  try
    if Size > C_MaxBufferFragmentSize then
      begin
        // process Chunk buffer
        BuffInt := NativeUInt(@buff);
        BuffPointer := Pointer(BuffInt);
        for i := 1 to (Size div C_MaxBufferFragmentSize) do
          begin
            if IOHnd.Handle.read(BuffPointer^, C_MaxBufferFragmentSize) <> C_MaxBufferFragmentSize then
              begin
                IOHnd.Return := C_FileReadError;
                Result := False;
                exit;
              end;
            BuffInt := BuffInt + C_MaxBufferFragmentSize;
            BuffPointer := Pointer(BuffInt);
          end;
        // process buffer rest
        i := Size mod C_MaxBufferFragmentSize;
        if IOHnd.Handle.read(BuffPointer^, i) <> i then
          begin
            IOHnd.Return := C_FileReadError;
            Result := False;
            exit;
          end;
        inc(IOHnd.Position, Size);
        IOHnd.Return := C_NotError;
        Result := True;
        inc(IOHnd.IORead, Size);
        exit;
      end;
    if IOHnd.Handle.read(buff, Size) <> Size then
      begin
        IOHnd.Return := C_FileReadError;
        Result := False;
        exit;
      end;
    inc(IOHnd.Position, Size);
    IOHnd.Return := C_NotError;
    Result := True;
    inc(IOHnd.IORead, Size);
  except
    IOHnd.Return := C_FileReadError;
    Result := False;
  end;
end;

function umlBlockRead(var IOHnd: TIOHnd; var buff; const Size: Int64): Boolean;
begin
  Result := umlFileRead(IOHnd, Size, buff);
end;

function umlFilePrepareWrite(var IOHnd: TIOHnd): Boolean;
begin
  Result := True;

  if not umlFileTest(IOHnd) then
      exit;

  if IOHnd.FlushBuff <> nil then
      exit;

  if (IOHnd.Handle is TCoreClassFileStream) or (IOHnd.Handle is TReliableFileStream) then
    begin
      IOHnd.FlushBuff := TMemoryStream64.CustomCreate(1024 * 1024 * 8);
      IOHnd.FlushPosition := IOHnd.Handle.Position;
    end;
end;

function umlFileFlushWrite(var IOHnd: TIOHnd): Boolean;
var
  m64: TMemoryStream64;
begin
  if IOHnd.FlushBuff <> nil then
    begin
      m64 := TMemoryStream64(IOHnd.FlushBuff);
      IOHnd.FlushBuff := nil;

      if IOHnd.Handle.write(m64.Memory^, m64.Size) <> m64.Size then
        begin
          IOHnd.Return := C_FileWriteError;
          Result := False;
          exit;
        end;
      inc(IOHnd.IOWrite, m64.Size);
      DisposeObject(m64);
    end;
  Result := True;
end;

function umlFileWrite(var IOHnd: TIOHnd; const Size: Int64; var buff): Boolean;
var
  BuffPointer: Pointer;
  i: NativeInt;
  BuffInt: NativeUInt;
begin
  if (IOHnd.IsOnlyRead) or (not IOHnd.IsOpen) then
    begin
      IOHnd.Return := C_FileWriteError;
      Result := False;
      exit;
    end;
  if Size = 0 then
    begin
      IOHnd.Return := C_NotError;
      Result := True;
      exit;
    end;

  IOHnd.WriteStated := True;

  umlResetPrepareRead(IOHnd);

  if Size <= $F000 then
      umlFilePrepareWrite(IOHnd);

  if IOHnd.FlushBuff <> nil then
    begin
      if TMemoryStream64(IOHnd.FlushBuff).Write64(buff, Size) <> Size then
        begin
          IOHnd.Return := C_FileWriteError;
          Result := False;
          exit;
        end;

      inc(IOHnd.Position, Size);
      if IOHnd.Position > IOHnd.Size then
          IOHnd.Size := IOHnd.Position;
      IOHnd.Return := C_NotError;
      Result := True;

      // 64M flush buffer
      if IOHnd.FlushBuff.Size > 64 * 1024 * 1024 then
          umlFileFlushWrite(IOHnd);
      exit;
    end;

  try
    if Size > C_MaxBufferFragmentSize then
      begin
        // process buffer chunk
        BuffInt := NativeUInt(@buff);
        BuffPointer := Pointer(BuffInt);
        for i := 1 to (Size div C_MaxBufferFragmentSize) do
          begin
            if IOHnd.Handle.write(BuffPointer^, C_MaxBufferFragmentSize) <> C_MaxBufferFragmentSize then
              begin
                IOHnd.Return := C_FileWriteError;
                Result := False;
                exit;
              end;
            BuffInt := BuffInt + C_MaxBufferFragmentSize;
            BuffPointer := Pointer(BuffInt);
          end;
        // process buffer rest
        i := Size mod C_MaxBufferFragmentSize;
        if IOHnd.Handle.write(BuffPointer^, i) <> i then
          begin
            IOHnd.Return := C_FileWriteError;
            Result := False;
            exit;
          end;

        inc(IOHnd.Position, Size);
        if IOHnd.Position > IOHnd.Size then
            IOHnd.Size := IOHnd.Position;
        IOHnd.Return := C_NotError;
        Result := True;
        inc(IOHnd.IOWrite, Size);
        exit;
      end;
    if IOHnd.Handle.write(buff, Size) <> Size then
      begin
        IOHnd.Return := C_FileWriteError;
        Result := False;
        exit;
      end;

    inc(IOHnd.Position, Size);
    if IOHnd.Position > IOHnd.Size then
        IOHnd.Size := IOHnd.Position;
    IOHnd.Return := C_NotError;
    Result := True;
    inc(IOHnd.IOWrite, Size);
  except
    IOHnd.Return := C_FileWriteError;
    Result := False;
  end;
end;

function umlBlockWrite(var IOHnd: TIOHnd; var buff; const Size: Int64): Boolean;
begin
  Result := umlFileWrite(IOHnd, Size, buff);
end;

function umlFileWriteFixedString(var IOHnd: TIOHnd; var Value: TPascalString): Boolean;
var
  buff: TBytes;
begin
  IOHnd.Pascal2FixedString(Value, buff);
  if umlFileWrite(IOHnd, IOHnd.FixedStringL, buff[0]) = False then
    begin
      IOHnd.Return := C_FileWriteError;
      Result := False;
      exit;
    end;

  IOHnd.Return := C_NotError;
  Result := True;
end;

function umlFileReadFixedString(var IOHnd: TIOHnd; var Value: TPascalString): Boolean;
var
  buff: TBytes;
begin
  try
    SetLength(buff, IOHnd.FixedStringL);
    if umlFileRead(IOHnd, IOHnd.FixedStringL, buff[0]) = False then
      begin
        IOHnd.Return := C_FileReadError;
        Result := False;
        exit;
      end;
    Value := IOHnd.FixedString2Pascal(buff);
    SetLength(buff, 0);
    IOHnd.Return := C_NotError;
    Result := True;
  except
    Value.text := '';
    IOHnd.Return := C_StringError;
    Result := False;
  end;
end;

function umlFileSeek(var IOHnd: TIOHnd; Pos_: Int64): Boolean;
begin
  if (Pos_ <> IOHnd.Position) or (Pos_ <> IOHnd.Handle.Position) then
    if not umlFileFlushWrite(IOHnd) then
      begin
        Result := False;
        exit;
      end;

  IOHnd.Return := C_SeekError;
  Result := False;
  try
    IOHnd.Position := IOHnd.Handle.Seek(Pos_, TSeekOrigin.soBeginning);
    Result := IOHnd.Position <> -1;
    if Result then
        IOHnd.Return := C_NotError;
  except
  end;
end;

function umlFileGetPOS(var IOHnd: TIOHnd): Int64;
begin
  Result := IOHnd.Position;
end;

function umlFileSetSize(var IOHnd: TIOHnd; siz_: Int64): Boolean;
begin
  if not umlFileFlushWrite(IOHnd) then
    begin
      Result := False;
      exit;
    end;

  IOHnd.Handle.Size := siz_;
  Result := True;
  IOHnd.Return := C_NotError;
end;

function umlFilePOS(var IOHnd: TIOHnd): Int64;
begin
  Result := umlFileGetPOS(IOHnd);
end;

function umlFileGetSize(var IOHnd: TIOHnd): Int64;
begin
  Result := IOHnd.Size;
end;

function umlFileSize(var IOHnd: TIOHnd): Int64;
begin
  Result := umlFileGetSize(IOHnd);
end;

function umlGetFileTime(const FileName: TPascalString): TDateTime;
{$IFDEF MSWINDOWS}
  function CovFileDate_(Fd: TFileTime): TDateTime;
  var
    Tct: _SystemTime;
    t: TFileTime;
  begin
    FileTimeToLocalFileTime(Fd, t);
    FileTimeToSystemTime(t, Tct);
    CovFileDate_ := SystemTimeToDateTime(Tct);
  end;

var
  SR: TSR;
begin
  if umlFindFirstFile(FileName, SR) then
      Result := CovFileDate_(SR.FindData.ftLastWriteTime)
  else
      Result := 0;
  umlFindClose(SR);
end;
{$ELSE MSWINDOWS}


var
  f: THandle;
begin
  f := FileOpen(FileName.text, fmOpenRead or fmShareDenyNone);
  if f <> THandle(-1) then
    begin
      Result := FileDateToDateTime(FileGetDate(f));
      FileClose(f);
    end
  else
      Result := 0;
end;
{$ENDIF MSWINDOWS}


procedure umlSetFileTime(const FileName: TPascalString; newTime: TDateTime);
begin
  FileSetDate(FileName.text, DateTimeToFileDate(newTime));
end;

function umlGetFileSize(const FileName: TPascalString): Int64;
var
  SR: TSR;
begin
  Result := 0;
  if umlFindFirstFile(FileName, SR) = True then
    begin
      Result := SR.Size;
      while umlFindNextFile(SR) do
          Result := Result + SR.Size;
    end;
  umlFindClose(SR);
end;

function umlGetFileCount(const FileName: TPascalString): Integer;
var
  SR: TSR;
begin
  Result := 0;
  if umlFindFirstFile(FileName, SR) = True then
    begin
      Result := Result + 1;
      while umlFindNextFile(SR) = True do
          Result := Result + 1;
    end;
  umlFindClose(SR);
end;

function umlGetFileDateTime(const FileName: TPascalString): TDateTime;
begin
  if not FileAge(FileName.text, Result, False) then
      Result := Now;
end;

function umlDeleteFile(const FileName: TPascalString; const _VerifyCheck: Boolean): Boolean;
var
  _SR: TSR;
  ph: TPascalString;
begin
  if umlExistsChar(FileName, '*?') then
    begin
      ph := umlGetFilePath(FileName);
      if umlFindFirstFile(FileName, _SR) then
        begin
          repeat
            try
                DeleteFile(umlCombineFileName(ph, _SR.Name).text);
            except
            end;
          until not umlFindNextFile(_SR);
        end;
      umlFindClose(_SR);
      Result := True;
    end
  else
    begin
      try
          Result := DeleteFile(FileName.text);
      except
          Result := False;
      end;
      if Result and _VerifyCheck then
          Result := not umlFileExists(FileName)
      else
          Result := True;
    end;
end;

function umlDeleteFile(const FileName: TPascalString): Boolean;
begin
  Result := umlDeleteFile(FileName, False);
end;

function umlCopyFile(const SourFile, DestFile: TPascalString): Boolean;
var
  _SH, _DH: TCoreClassFileStream;
begin
  Result := False;
  _SH := nil;
  _DH := nil;
  try
    if not umlFileExists(SourFile) then
        exit;
    if umlMultipleMatch(True, ExpandFileName(SourFile.text), ExpandFileName(DestFile.text)) then
        exit;
    _SH := TCoreClassFileStream.Create(SourFile.text, fmOpenRead or fmShareDenyNone);
    _DH := TCoreClassFileStream.Create(DestFile.text, fmCreate);
    Result := _DH.CopyFrom(_SH, _SH.Size) = _SH.Size;
    DisposeObject(_SH);
    DisposeObject(_DH);
    umlSetFileTime(DestFile, umlGetFileTime(SourFile));
  except
    if _SH <> nil then
        DisposeObject(_SH);
    if _DH <> nil then
        DisposeObject(_DH);
  end;
end;

function umlRenameFile(const OldName, NewName: TPascalString): Boolean;
begin
  Result := RenameFile(OldName.text, NewName.text);
end;

procedure umlSetLength(var sVal: TPascalString; Len: Integer);
begin
  sVal.Len := Len;
end;

procedure umlSetLength(var sVal: U_Bytes; Len: Integer);
begin
  SetLength(sVal, Len);
end;

procedure umlSetLength(var sVal: TArrayPascalString; Len: Integer);
begin
  SetLength(sVal, Len);
end;

function umlGetLength(const sVal: TPascalString): Integer;
begin
  Result := sVal.Len;
end;

function umlGetLength(const sVal: U_Bytes): Integer;
begin
  Result := length(sVal);
end;

function umlGetLength(const sVal: TArrayPascalString): Integer;
begin
  Result := length(sVal);
end;

function umlUpperCase(const s: TPascalString): TPascalString;
begin
  Result := s.UpperText;
end;

function umlLowerCase(const s: TPascalString): TPascalString;
begin
  Result := s.LowerText;
end;

function umlCopyStr(const sVal: TPascalString; MainPosition, LastPosition: Integer): TPascalString;
begin
  Result := sVal.GetString(MainPosition, LastPosition);
end;

function umlSameText(const s1, s2: TPascalString): Boolean;
begin
  Result := s1.Same(s2);
end;

function umlDeleteChar(const SText, Ch: TPascalString): TPascalString;
var
  i: Integer;
begin
  Result := '';
  if SText.Len > 0 then
    for i := 1 to SText.Len do
      if not CharIn(SText[i], Ch) then
          Result.Append(SText[i]);
end;

function umlDeleteChar(const SText: TPascalString; const SomeChars: array of SystemChar): TPascalString;
var
  i: Integer;
begin
  Result := '';
  if SText.Len > 0 then
    for i := 1 to SText.Len do
      if not CharIn(SText[i], SomeChars) then
          Result.Append(SText[i]);
end;

function umlDeleteChar(const SText: TPascalString; const SomeCharsets: TOrdChars): TPascalString; overload;
var
  i: Integer;
begin
  Result := '';
  if SText.Len > 0 then
    for i := 1 to SText.Len do
      if not CharIn(SText[i], SomeCharsets) then
          Result.Append(SText[i]);
end;

function umlGetNumberCharInText(const n: TPascalString): TPascalString;
var
  i: Integer;
begin
  Result := '';
  i := 0;
  if n.Len = 0 then
      exit;

  while i <= n.Len do
    begin
      if (not CharIn(n[i], c0to9)) then
        begin
          if (Result.Len = 0) then
              inc(i)
          else
              exit;
        end
      else
        begin
          Result.Append(n[i]);
          inc(i);
        end;
    end;
end;

function umlMatchChar(CharValue: U_Char; cVal: P_String): Boolean;
begin
  Result := CharIn(CharValue, cVal);
end;

function umlMatchChar(CharValue: U_Char; cVal: TPascalString): Boolean;
begin
  Result := CharIn(CharValue, @cVal);
end;

function umlExistsChar(StrValue: TPascalString; cVal: TPascalString): Boolean;
var
  c: SystemChar;
begin
  Result := True;
  for c in StrValue.buff do
    if CharIn(c, @cVal) then
        exit;
  Result := False;
end;

function umlTrimChar(const s, trim_s: TPascalString): TPascalString;
var
  L, bp, EP: Integer;
begin
  Result := '';
  L := s.Len;
  if L > 0 then
    begin
      bp := 1;
      while CharIn(s[bp], @trim_s) do
        begin
          inc(bp);
          if (bp > L) then
            begin
              Result := '';
              exit;
            end;
        end;
      if bp > L then
          Result := ''
      else
        begin
          EP := L;

          while CharIn(s[EP], @trim_s) do
            begin
              dec(EP);
              if (EP < 1) then
                begin
                  Result := '';
                  exit;
                end;
            end;
          Result := s.GetString(bp, EP + 1);
        end;
    end;
end;

function umlGetFirstStr(const sVal, trim_s: TPascalString): TPascalString;
var
  umlGetFirstName_PrevPos, umlGetFirstName_Pos: Integer;
begin
  Result := sVal;
  if Result.Len <= 0 then
    begin
      exit;
    end;
  umlGetFirstName_Pos := 1;
  while umlMatchChar(Result[umlGetFirstName_Pos], @trim_s) do
    begin
      if umlGetFirstName_Pos = Result.Len then
          exit;
      inc(umlGetFirstName_Pos);
    end;
  umlGetFirstName_PrevPos := umlGetFirstName_Pos;
  while not umlMatchChar(Result[umlGetFirstName_Pos], @trim_s) do
    begin
      if umlGetFirstName_Pos = Result.Len then
        begin
          Result := umlCopyStr(Result, umlGetFirstName_PrevPos, umlGetFirstName_Pos + 1);
          exit;
        end;
      inc(umlGetFirstName_Pos);
    end;
  Result := umlCopyStr(Result, umlGetFirstName_PrevPos, umlGetFirstName_Pos);
end;

function umlGetLastStr(const sVal, trim_s: TPascalString): TPascalString;
var
  umlGetLastName_PrevPos, umlGetLastName_Pos: Integer;
begin
  Result := sVal;
  umlGetLastName_Pos := Result.Len;
  if umlGetLastName_Pos <= 0 then
    begin
      exit;
    end;
  while umlMatchChar(Result[umlGetLastName_Pos], @trim_s) do
    begin
      if umlGetLastName_Pos = 1 then
          exit;
      dec(umlGetLastName_Pos);
    end;
  umlGetLastName_PrevPos := umlGetLastName_Pos;
  while not umlMatchChar(Result[umlGetLastName_Pos], @trim_s) do
    begin
      if umlGetLastName_Pos = 1 then
        begin
          Result := umlCopyStr(Result, umlGetLastName_Pos, umlGetLastName_PrevPos + 1);
          exit;
        end;
      dec(umlGetLastName_Pos);
    end;
  Result := umlCopyStr(Result, umlGetLastName_Pos + 1, umlGetLastName_PrevPos + 1);
end;

function umlDeleteFirstStr(const sVal, trim_s: TPascalString): TPascalString;
var
  umlMaskFirstName_Pos: Integer;
begin
  Result := sVal;
  if Result.Len <= 0 then
    begin
      Result := '';
      exit;
    end;
  umlMaskFirstName_Pos := 1;
  while umlMatchChar(Result[umlMaskFirstName_Pos], @trim_s) do
    begin
      if umlMaskFirstName_Pos = Result.Len then
        begin
          Result := '';
          exit;
        end;
      inc(umlMaskFirstName_Pos);
    end;
  while not umlMatchChar(Result[umlMaskFirstName_Pos], @trim_s) do
    begin
      if umlMaskFirstName_Pos = Result.Len then
        begin
          Result := '';
          exit;
        end;
      inc(umlMaskFirstName_Pos);
    end;
  while umlMatchChar(Result[umlMaskFirstName_Pos], @trim_s) do
    begin
      if umlMaskFirstName_Pos = Result.Len then
        begin
          Result := '';
          exit;
        end;
      inc(umlMaskFirstName_Pos);
    end;
  Result := umlCopyStr(Result, umlMaskFirstName_Pos, Result.Len + 1);
end;

function umlDeleteLastStr(const sVal, trim_s: TPascalString): TPascalString;
var
  umlMaskLastName_Pos: Integer;
begin
  Result := sVal;
  umlMaskLastName_Pos := Result.Len;
  if umlMaskLastName_Pos <= 0 then
    begin
      Result := '';
      exit;
    end;
  while umlMatchChar(Result[umlMaskLastName_Pos], @trim_s) do
    begin
      if umlMaskLastName_Pos = 1 then
        begin
          Result := '';
          exit;
        end;
      dec(umlMaskLastName_Pos);
    end;
  while not umlMatchChar(Result[umlMaskLastName_Pos], @trim_s) do
    begin
      if umlMaskLastName_Pos = 1 then
        begin
          Result := '';
          exit;
        end;
      dec(umlMaskLastName_Pos);
    end;
  while umlMatchChar(Result[umlMaskLastName_Pos], @trim_s) do
    begin
      if umlMaskLastName_Pos = 1 then
        begin
          Result := '';
          exit;
        end;
      dec(umlMaskLastName_Pos);
    end;
  umlSetLength(Result, umlMaskLastName_Pos);
end;

function umlGetIndexStrCount(const sVal, trim_s: TPascalString): Integer;
var
  s: TPascalString;
  Pos_: Integer;
begin
  s := sVal;
  Result := 0;
  if s.Len = 0 then
      exit;
  Pos_ := 1;
  while True do
    begin
      while umlMatchChar(s[Pos_], @trim_s) do
        begin
          if Pos_ >= s.Len then
              exit;
          inc(Pos_);
        end;
      inc(Result);
      while not umlMatchChar(s[Pos_], @trim_s) do
        begin
          if Pos_ >= s.Len then
              exit;
          inc(Pos_);
        end;
    end;
end;

function umlGetIndexStr(const sVal: TPascalString; trim_s: TPascalString; index: Integer): TPascalString;
var
  umlGetIndexName_Repeat: Integer;
begin
  case index of
    - 1:
      begin
        Result := '';
        exit;
      end;
    0, 1:
      begin
        Result := umlGetFirstStr(sVal, trim_s);
        exit;
      end;
  end;
  if index >= umlGetIndexStrCount(sVal, trim_s) then
    begin
      Result := umlGetLastStr(sVal, trim_s);
      exit;
    end;
  Result := sVal;
  for umlGetIndexName_Repeat := 2 to index do
    begin
      Result := umlDeleteFirstStr(Result, trim_s);
    end;
  Result := umlGetFirstStr(Result, trim_s);
end;

procedure umlGetSplitArray(const sour: TPascalString; var dest: TArrayPascalString; const splitC: TPascalString);
var
  i, idxCount: Integer;
  SText: TPascalString;
begin
  SText := sour;
  idxCount := umlGetIndexStrCount(SText, splitC);
  if (idxCount = 0) and (sour.Len > 0) then
    begin
      SetLength(dest, 1);
      dest[0] := sour;
    end
  else
    begin
      SetLength(dest, idxCount);
      i := low(dest);
      while i < idxCount do
        begin
          dest[i] := umlGetFirstStr(SText, splitC);
          SText := umlDeleteFirstStr(SText, splitC);
          inc(i);
        end;
    end;
end;

procedure umlGetSplitArray(const sour: TPascalString; var dest: U_StringArray; const splitC: TPascalString);
var
  i, idxCount: Integer;
  SText: TPascalString;
begin
  SText := sour;
  idxCount := umlGetIndexStrCount(SText, splitC);
  if (idxCount = 0) and (sour.Len > 0) then
    begin
      SetLength(dest, 1);
      dest[0] := sour;
    end
  else
    begin
      SetLength(dest, idxCount);
      i := low(dest);
      while i < idxCount do
        begin
          dest[i] := umlGetFirstStr(SText, splitC);
          SText := umlDeleteFirstStr(SText, splitC);
          inc(i);
        end;
    end;
end;

function ArrayStringToText(var ary: TArrayPascalString; const splitC: TPascalString): TPascalString;
var
  i: Integer;
begin
  Result := '';
  for i := low(ary) to high(ary) do
    if i < high(ary) then
        Result := Result + ary[i] + splitC
    else
        Result := Result + ary[i];
end;

function umlStringsToSplitText(lst: TCoreClassStrings; const splitC: TPascalString): TPascalString;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to lst.Count - 1 do
    if i > 0 then
        Result.Append(splitC.text + lst[i])
    else
        Result := lst[i];
end;

function umlStringsToSplitText(lst: TListPascalString; const splitC: TPascalString): TPascalString;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to lst.Count - 1 do
    if i > 0 then
        Result.Append(splitC.text + lst[i])
    else
        Result := lst[i];
end;

function umlGetFirstStr_Discontinuity(const sVal, trim_s: TPascalString): TPascalString;
var
  umlGetFirstName_PrevPos, umlGetFirstName_Pos: Integer;
begin
  Result := sVal;
  if Result.Len <= 0 then
      exit;
  umlGetFirstName_Pos := 1;
  if umlMatchChar(Result[umlGetFirstName_Pos], @trim_s) then
    begin
      inc(umlGetFirstName_Pos);
      umlGetFirstName_PrevPos := umlGetFirstName_Pos;
    end
  else
    begin
      umlGetFirstName_PrevPos := umlGetFirstName_Pos;
      while not umlMatchChar(Result[umlGetFirstName_Pos], @trim_s) do
        begin
          if umlGetFirstName_Pos = Result.Len then
            begin
              Result := umlCopyStr(Result, umlGetFirstName_PrevPos, umlGetFirstName_Pos + 1);
              exit;
            end;
          inc(umlGetFirstName_Pos);
        end;
    end;
  Result := umlCopyStr(Result, umlGetFirstName_PrevPos, umlGetFirstName_Pos);
end;

function umlDeleteFirstStr_Discontinuity(const sVal, trim_s: TPascalString): TPascalString;
var
  umlMaskFirstName_Pos: Integer;
begin
  Result := sVal;
  if Result.Len <= 0 then
    begin
      Result := '';
      exit;
    end;
  umlMaskFirstName_Pos := 1;
  while not umlMatchChar(Result[umlMaskFirstName_Pos], @trim_s) do
    begin
      if umlMaskFirstName_Pos = Result.Len then
        begin
          Result := '';
          exit;
        end;
      inc(umlMaskFirstName_Pos);
    end;
  if umlMatchChar(Result[umlMaskFirstName_Pos], @trim_s) then
      inc(umlMaskFirstName_Pos);
  Result := umlCopyStr(Result, umlMaskFirstName_Pos, Result.Len + 1);
end;

function umlGetLastStr_Discontinuity(const sVal, trim_s: TPascalString): TPascalString;
var
  umlGetLastName_PrevPos, umlGetLastName_Pos: Integer;
begin
  Result := sVal;
  umlGetLastName_Pos := Result.Len;
  if umlGetLastName_Pos <= 0 then
      exit;
  if Result[umlGetLastName_Pos] = trim_s then
      dec(umlGetLastName_Pos);
  umlGetLastName_PrevPos := umlGetLastName_Pos;
  while not umlMatchChar(Result[umlGetLastName_Pos], @trim_s) do
    begin
      if umlGetLastName_Pos = 1 then
        begin
          Result := umlCopyStr(Result, umlGetLastName_Pos, umlGetLastName_PrevPos + 1);
          exit;
        end;
      dec(umlGetLastName_Pos);
    end;
  Result := umlCopyStr(Result, umlGetLastName_Pos + 1, umlGetLastName_PrevPos + 1);
end;

function umlDeleteLastStr_Discontinuity(const sVal, trim_s: TPascalString): TPascalString;
var
  umlMaskLastName_Pos: Integer;
begin
  Result := sVal;
  umlMaskLastName_Pos := Result.Len;
  if umlMaskLastName_Pos <= 0 then
    begin
      Result := '';
      exit;
    end;
  if umlMatchChar(Result[umlMaskLastName_Pos], @trim_s) then
      dec(umlMaskLastName_Pos);
  while not umlMatchChar(Result[umlMaskLastName_Pos], @trim_s) do
    begin
      if umlMaskLastName_Pos = 1 then
        begin
          Result := '';
          exit;
        end;
      dec(umlMaskLastName_Pos);
    end;
  umlSetLength(Result, umlMaskLastName_Pos);
end;

function umlGetIndexStrCount_Discontinuity(const sVal, trim_s: TPascalString): Integer;
var
  s: TPascalString;
  Pos_: Integer;
begin
  s := sVal;
  Result := 0;
  if s.Len = 0 then
      exit;
  Pos_ := 1;
  Result := 1;
  while True do
    begin
      while not umlMatchChar(s[Pos_], @trim_s) do
        begin
          if Pos_ = s.Len then
              exit;
          inc(Pos_);
        end;
      inc(Result);
      if Pos_ = s.Len then
          exit;
      inc(Pos_);
    end;
end;

function umlGetIndexStr_Discontinuity(const sVal: TPascalString; trim_s: TPascalString; index: Integer): TPascalString;
var
  umlGetIndexName_Repeat: Integer;
begin
  case index of
    - 1:
      begin
        Result := '';
        exit;
      end;
    0, 1:
      begin
        Result := umlGetFirstStr_Discontinuity(sVal, trim_s);
        exit;
      end;
  end;
  if index >= umlGetIndexStrCount_Discontinuity(sVal, trim_s) then
    begin
      Result := umlGetLastStr_Discontinuity(sVal, trim_s);
      exit;
    end;
  Result := sVal;
  for umlGetIndexName_Repeat := 2 to index do
      Result := umlDeleteFirstStr_Discontinuity(Result, trim_s);
  Result := umlGetFirstStr_Discontinuity(Result, trim_s);
end;

function umlGetFirstTextPos(const s: TPascalString; const TextArry: TArrayPascalString; var OutText: TPascalString): Integer;
var
  i, j: Integer;
begin
  Result := -1;
  for i := 1 to s.Len do
    begin
      for j := low(TextArry) to high(TextArry) do
        begin
          if s.ComparePos(i, @TextArry[j]) then
            begin
              OutText := TextArry[j];
              Result := i;
              exit;
            end;
        end;
    end;
end;

function umlDeleteText(const sour: TPascalString; const bToken, eToken: TArrayPascalString; ANeedBegin, ANeedEnd: Boolean): TPascalString;
var
  ABeginPos, AEndPos: Integer;
  ABeginText, AEndText, ANewStr: TPascalString;
begin
  Result := sour;
  if sour.Len > 0 then
    begin
      ABeginPos := umlGetFirstTextPos(sour, bToken, ABeginText);
      if ABeginPos > 0 then
          ANewStr := umlCopyStr(sour, ABeginPos + ABeginText.Len, sour.Len + 1)
      else if ANeedBegin then
          exit
      else
          ANewStr := sour;

      AEndPos := umlGetFirstTextPos(ANewStr, eToken, AEndText);
      if AEndPos > 0 then
          ANewStr := umlCopyStr(ANewStr, (AEndPos + AEndText.Len), ANewStr.Len + 1)
      else if ANeedEnd then
          exit
      else
          ANewStr := '';

      if ABeginPos > 0 then
        begin
          if AEndPos > 0 then
              Result := umlCopyStr(sour, 0, ABeginPos - 1) + umlDeleteText(ANewStr, bToken, eToken, ANeedBegin, ANeedEnd)
          else
              Result := umlCopyStr(sour, 0, ABeginPos - 1) + ANewStr;
        end
      else if AEndPos > 0 then
          Result := ANewStr;
    end;
end;

function umlGetTextContent(const sour: TPascalString; const bToken, eToken: TArrayPascalString): TPascalString;
var
  ABeginPos, AEndPos: Integer;
  ABeginText, AEndText, ANewStr: TPascalString;
begin
  Result := '';
  if sour.Len > 0 then
    begin
      ABeginPos := umlGetFirstTextPos(sour, bToken, ABeginText);
      if ABeginPos > 0 then
          ANewStr := umlCopyStr(sour, ABeginPos + ABeginText.Len, sour.Len + 1)
      else
          ANewStr := sour;

      AEndPos := umlGetFirstTextPos(ANewStr, eToken, AEndText);
      if AEndPos > 0 then
          Result := umlCopyStr(ANewStr, 0, AEndPos - 1)
      else
          Result := ANewStr;
    end;
end;

function umlGetNumTextType(const s: TPascalString): TTextType;
type
  TValSym = (vsSymSub, vsSymAdd, vsSymAddSub, vsSymDollar, vsDot, vsDotBeforNum, vsDotAfterNum, vsNum, vsAtoF, vsE, vsUnknow);
var
  cnt: array [TValSym] of Integer;
  n: TPascalString;
  v: TValSym;
  c: SystemChar;
  i: Integer;
begin
  n := umlTrimSpace(s);
  if n.Same('true') or n.Same('false') then
      exit(ntBool);

  for v := low(TValSym) to high(TValSym) do
      cnt[v] := 0;

  for i := 1 to n.Len do
    begin
      c := n[i];
      if CharIn(c, [c0to9]) then
        begin
          inc(cnt[vsNum]);
          if cnt[vsDot] > 0 then
              inc(cnt[vsDotAfterNum]);
        end
      else if CharIn(c, [cLoAtoF, cHiAtoF]) then
        begin
          inc(cnt[vsAtoF]);
          if CharIn(c, 'eE') then
              inc(cnt[vsE]);
        end
      else if c = '.' then
        begin
          inc(cnt[vsDot]);
          cnt[vsDotBeforNum] := cnt[vsNum];
        end
      else if CharIn(c, '-') then
        begin
          inc(cnt[vsSymSub]);
          inc(cnt[vsSymAddSub]);
        end
      else if CharIn(c, '+') then
        begin
          inc(cnt[vsSymAdd]);
          inc(cnt[vsSymAddSub]);
        end
      else if CharIn(c, '$') and (i = 1) then
        begin
          inc(cnt[vsSymDollar]);
          if i <> 1 then
              exit(ntUnknow);
        end
      else
          exit(ntUnknow);
    end;

  if cnt[vsDot] > 1 then
      exit(ntUnknow);
  if cnt[vsSymDollar] > 1 then
      exit(ntUnknow);
  if (cnt[vsSymDollar] = 0) and (cnt[vsNum] = 0) then
      exit(ntUnknow);
  if (cnt[vsSymAdd] > 1) and (cnt[vsE] = 0) and (cnt[vsSymDollar] = 0) then
      exit(ntUnknow);

  if (cnt[vsSymDollar] = 0) and
    ((cnt[vsDot] = 1) or ((cnt[vsE] = 1) and ((cnt[vsSymAddSub] >= 1) and (cnt[vsSymDollar] = 0)))) then
    begin
      if cnt[vsSymDollar] > 0 then
          exit(ntUnknow);
      if (cnt[vsAtoF] <> cnt[vsE]) then
          exit(ntUnknow);

      if cnt[vsE] = 1 then
        begin
          Result := ntDouble
        end
      else if ((cnt[vsDotBeforNum] > 0)) and (cnt[vsDotAfterNum] > 0) then
        begin
          if cnt[vsDotAfterNum] < 5 then
              Result := ntCurrency
          else if cnt[vsNum] > 7 then
              Result := ntDouble
          else
              Result := ntSingle;
        end
      else
          exit(ntUnknow);
    end
  else
    begin
      if cnt[vsSymDollar] = 1 then
        begin
          if cnt[vsSymSub] > 0 then
            begin
              if cnt[vsNum] + cnt[vsAtoF] = 0 then
                  Result := ntUnknow
              else if cnt[vsNum] + cnt[vsAtoF] < 2 then
                  Result := ntShortInt
              else if cnt[vsNum] + cnt[vsAtoF] < 4 then
                  Result := ntSmallInt
              else if cnt[vsNum] + cnt[vsAtoF] < 7 then
                  Result := ntInt
              else if cnt[vsNum] + cnt[vsAtoF] < 13 then
                  Result := ntInt64
              else
                  Result := ntUnknow;
            end
          else
            begin
              if cnt[vsNum] + cnt[vsAtoF] = 0 then
                  Result := ntUnknow
              else if cnt[vsNum] + cnt[vsAtoF] < 3 then
                  Result := ntByte
              else if cnt[vsNum] + cnt[vsAtoF] < 5 then
                  Result := ntWord
              else if cnt[vsNum] + cnt[vsAtoF] < 8 then
                  Result := ntUInt
              else if cnt[vsNum] + cnt[vsAtoF] < 14 then
                  Result := ntUInt64
              else
                  Result := ntUnknow;
            end;
        end
      else if cnt[vsAtoF] > 0 then
          exit(ntUnknow)
      else if cnt[vsSymSub] > 0 then
        begin
          if cnt[vsNum] = 0 then
              Result := ntUnknow
          else if cnt[vsNum] < 3 then
              Result := ntShortInt
          else if cnt[vsNum] < 5 then
              Result := ntSmallInt
          else if cnt[vsNum] < 8 then
              Result := ntInt
          else if cnt[vsNum] < 15 then
              Result := ntInt64
          else
              Result := ntUnknow;
        end
      else
        begin
          if cnt[vsNum] = 0 then
              Result := ntUnknow
          else if cnt[vsNum] < 3 then
              Result := ntByte
          else if cnt[vsNum] < 5 then
              Result := ntWord
          else if cnt[vsNum] < 8 then
              Result := ntUInt
          else if cnt[vsNum] < 16 then
              Result := ntUInt64
          else
              Result := ntUnknow;
        end;
    end;
end;

function umlIsHex(const sVal: TPascalString): Boolean;
begin
  Result := umlGetNumTextType(sVal) in
    [ntInt, ntInt64, ntUInt64, ntWord, ntByte, ntSmallInt, ntShortInt, ntUInt];
end;

function umlIsNumber(const sVal: TPascalString): Boolean;
begin
  Result := umlGetNumTextType(sVal) <> ntUnknow;
end;

function umlIsIntNumber(const sVal: TPascalString): Boolean;
begin
  Result := umlGetNumTextType(sVal) in
    [ntInt, ntInt64, ntUInt64, ntWord, ntByte, ntSmallInt, ntShortInt, ntUInt];
end;

function umlIsFloatNumber(const sVal: TPascalString): Boolean;
begin
  Result := umlGetNumTextType(sVal) in [ntSingle, ntDouble, ntCurrency];
end;

function umlIsBool(const sVal: TPascalString): Boolean;
begin
  Result := umlGetNumTextType(sVal) = ntBool;
end;

function umlNumberCount(const sVal: TPascalString): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 1 to sVal.Len do
    if CharIn(sVal[i], [c0to9]) then
        inc(Result);
end;

function umlPercentageToFloat(OriginMax, OriginMin, ProcressParameter: Double): Double;
begin
  Result := (ProcressParameter - OriginMin) * 100.0 / (OriginMax - OriginMin);
end;

function umlPercentageToInt64(OriginParameter, ProcressParameter: Int64): Integer;
begin
  if OriginParameter = 0 then
      Result := 0
  else
      Result := Round((ProcressParameter * 100.0) / OriginParameter);
end;

function umlPercentageToInt(OriginParameter, ProcressParameter: Integer): Integer;
begin
  if OriginParameter = 0 then
      Result := 0
  else
      Result := Round((ProcressParameter * 100.0) / OriginParameter);
end;

function umlPercentageToStr(OriginParameter, ProcressParameter: Integer): TPascalString;
begin
  Result := IntToStr(umlPercentageToInt(OriginParameter, ProcressParameter)) + '%';
end;

function umlSmartSizeToStr(Size: Int64): TPascalString;
begin
  if Size < 1 shl 10 then
      Result := Format('%d', [Size])
  else if Size < 1 shl 20 then
      Result := Format('%f Kb', [Size / (1 shl 10)])
  else if Size < 1 shl 30 then
      Result := Format('%f M', [Size / (1 shl 20)])
  else
      Result := Format('%f G', [Size / (1 shl 30)])
end;

function umlIntToStr(Parameter: Single): TPascalString;
begin
  Result := IntToStr(Round(Parameter));
end;

function umlIntToStr(Parameter: Double): TPascalString;
begin
  Result := IntToStr(Round(Parameter));
end;

function umlIntToStr(Parameter: Int64): TPascalString;
begin
  Result := IntToStr(Parameter);
end;

function umlPointerToStr(param: Pointer): TPascalString;
begin
  Result := '0x' + IntToHex(NativeUInt(param), SizeOf(Pointer) * 2);
end;

function umlMBPSToStr(Size: Int64): TPascalString;
begin
  if Size < 1 shl 10 then
      Result := Format('%d bps', [Size * 10])
  else if Size < 1 shl 20 then
      Result := Format('%f Kbps', [Size / (1 shl 10) * 10])
  else if Size < 1 shl 30 then
      Result := Format('%f Mbps', [Size / (1 shl 20) * 10])
  else
      Result := Format('%f Gbps', [Size / (1 shl 30) * 10])
end;

function umlSizeToStr(Parameter: Int64): TPascalString;
begin
  try
      Result := umlSmartSizeToStr(Parameter);
  except
      Result := IntToStr(Parameter) + ' B';
  end;
end;

function umlStrToDateTime(s: TPascalString): TDateTime;
begin
  Result := StrToDateTime(s.text, Lib_DateTimeFormatSettings);
end;

function umlDateTimeToStr(t: TDateTime): TPascalString;
begin
  Result := DateTimeToStr(t, Lib_DateTimeFormatSettings);
end;

function umlTimeTickToStr(const t: TTimeTick): TPascalString;
var
  tmp, d, h, m, s: TTimeTick;
begin
{$IFDEF FPC}
  d := t div C_Tick_Day;
  tmp := t mod C_Tick_Day;

  h := tmp div C_Tick_Hour;
  tmp := t mod C_Tick_Hour;

  m := tmp div C_Tick_Minute;
  tmp := t mod C_Tick_Minute;

  s := tmp div C_Tick_Second;
  tmp := t mod C_Tick_Second;
{$ELSE FPC}
  DivMod(t, C_Tick_Day, d, tmp);
  DivMod(tmp, C_Tick_Hour, h, tmp);
  DivMod(tmp, C_Tick_Minute, m, tmp);
  DivMod(tmp, C_Tick_Second, s, tmp);
{$ENDIF FPC}
  Result := '';
  if (d > 0) then
      Result.Append(IntToStr(d) + ' day ');
  if (Result.Len > 0) or (h > 0) then
      Result.Append(IntToStr(h) + ' hour ');
  if (Result.Len > 0) or (m > 0) then
      Result.Append(IntToStr(m) + ' minute ');

  if (Result.Len > 0) or (s > 0) then
      Result.Append(PFormat('%2.2f', [s + tmp / 1000]))
  else
      Result.Append('0');
end;

function umlTimeToStr(t: TDateTime): TPascalString;
begin
  Result := TimeToStr(t, Lib_DateTimeFormatSettings);
end;

function umlDateToStr(t: TDateTime): TPascalString;
begin
  Result := DateToStr(t, Lib_DateTimeFormatSettings);
end;

function umlFloatToStr(const f: Double): TPascalString;
begin
  Result := FloatToStr(f);
end;

function umlShortFloatToStr(const f: Double): TPascalString;
begin
  Result := Format('%f', [f]);
end;

function umlStrToInt(const V_: TPascalString): Integer;
begin
  Result := umlStrToInt(V_, 0);
end;

function umlStrToInt(const V_: TPascalString; _Def: Integer): Integer;
begin
  if umlIsNumber(V_) then
    begin
      try
          Result := StrToInt(V_.text);
      except
          Result := _Def;
      end;
    end
  else
      Result := _Def;
end;

function umlStrToInt64(const V_: TPascalString; _Def: Int64): Int64;
begin
  if umlIsNumber(V_) then
    begin
      try
          Result := StrToInt64(V_.text);
      except
          Result := _Def;
      end;
    end
  else
      Result := _Def;
end;

function umlStrToInt64(const V_: TPascalString): Int64;
begin
  Result := umlStrToInt64(V_, 0);
end;

function umlStrToFloat(const V_: TPascalString; _Def: Double): Double;
begin
  if umlIsNumber(V_) then
    begin
      try
          Result := StrToFloat(V_.text);
      except
          Result := _Def;
      end;
    end
  else
      Result := _Def;
end;

function umlStrToFloat(const V_: TPascalString): Double;
begin
  Result := umlStrToFloat(V_, 0);
end;

function umlMultipleMatch(IgnoreCase: Boolean; const SourceStr, TargetStr, umlMultipleString, umlMultipleCharacter: TPascalString): Boolean;
label Character_Label, MChar_Label, MString_Label;
var
  UpperCaseSourceStr, UpperCaseTargetStr, SwapStr: TPascalString;
  SourceChar, TargetChar, SwapChar: U_Char;
  SourceIndex, TargetIndex, SwapIndex, SourceLength, TargetLength, SwapLength: Integer;
begin
  SourceLength := SourceStr.Len;
  if SourceLength = 0 then
    begin
      Result := True;
      exit;
    end;

  TargetLength := TargetStr.Len;
  if TargetLength = 0 then
    begin
      Result := False;
      exit;
    end;

  if IgnoreCase then
    begin
      UpperCaseSourceStr := umlUpperCase(SourceStr);
      UpperCaseTargetStr := umlUpperCase(TargetStr);
    end
  else
    begin
      UpperCaseSourceStr := SourceStr;
      UpperCaseTargetStr := TargetStr;
    end;

  if (not umlExistsChar(SourceStr, umlMultipleCharacter)) and (not umlExistsChar(SourceStr, umlMultipleString)) then
    begin
      Result := (SourceLength = TargetLength) and (UpperCaseSourceStr = UpperCaseTargetStr);
      exit;
    end;
  if SourceLength = 1 then
    begin
      if umlMatchChar(UpperCaseSourceStr[1], @umlMultipleString) then
          Result := True
      else
          Result := False;
      exit;
    end;
  SourceIndex := 1;
  TargetIndex := 1;
  SourceChar := UpperCaseSourceStr[SourceIndex];
  TargetChar := UpperCaseTargetStr[TargetIndex];

Character_Label:
  while (SourceChar = TargetChar) and (not umlMatchChar(SourceChar, @umlMultipleCharacter)) and (not umlMatchChar(SourceChar, @umlMultipleString)) do
    begin
      if SourceIndex = SourceLength then
        begin
          if TargetIndex = TargetLength then
            begin
              Result := True;
              exit;
            end;
          Result := False;
          exit;
        end;
      if TargetIndex = TargetLength then
        begin
          SourceIndex := SourceIndex + 1;
          if SourceIndex = SourceLength then
            begin
              SourceChar := UpperCaseSourceStr[SourceIndex];
              Result := umlMatchChar(SourceChar, @umlMultipleString) or umlMatchChar(SourceChar, @umlMultipleCharacter);
              exit;
            end;
          Result := False;
          exit;
        end;
      SourceIndex := SourceIndex + 1;
      TargetIndex := TargetIndex + 1;
      SourceChar := UpperCaseSourceStr[SourceIndex];
      TargetChar := UpperCaseTargetStr[TargetIndex];
    end;

MChar_Label:
  while umlMatchChar(SourceChar, @umlMultipleCharacter) do
    begin
      if SourceIndex = SourceLength then
        begin
          if TargetIndex = TargetLength then
            begin
              Result := True;
              exit;
            end;
          Result := False;
          exit;
        end;
      if TargetIndex = TargetLength then
        begin
          SourceIndex := SourceIndex + 1;
          SourceChar := UpperCaseSourceStr[SourceIndex];
          if (SourceIndex = SourceLength) and ((umlMatchChar(SourceChar, @umlMultipleString)) or (umlMatchChar(SourceChar, @umlMultipleCharacter))) then
            begin
              Result := True;
              exit;
            end;
          Result := False;
          exit;
        end;
      SourceIndex := SourceIndex + 1;
      TargetIndex := TargetIndex + 1;
      SourceChar := UpperCaseSourceStr[SourceIndex];
      TargetChar := UpperCaseTargetStr[TargetIndex];
    end;

MString_Label:
  if umlMatchChar(SourceChar, @umlMultipleString) then
    begin
      if SourceIndex = SourceLength then
        begin
          Result := True;
          exit;
        end;
      SourceIndex := SourceIndex + 1;
      SourceChar := UpperCaseSourceStr[SourceIndex];

      while (umlMatchChar(SourceChar, @umlMultipleString)) or (umlMatchChar(SourceChar, @umlMultipleCharacter)) do
        begin
          if SourceIndex = SourceLength then
            begin
              Result := True;
              exit;
            end;
          SourceIndex := SourceIndex + 1;
          SourceChar := UpperCaseSourceStr[SourceIndex];
          while umlMatchChar(SourceChar, @umlMultipleCharacter) do
            begin
              if SourceIndex = SourceLength then
                begin
                  Result := True;
                  exit;
                end;
              SourceIndex := SourceIndex + 1;
              SourceChar := UpperCaseSourceStr[SourceIndex];
            end;
        end;
      SwapStr := umlCopyStr(UpperCaseSourceStr, SourceIndex, SourceLength + 1);
      SwapLength := SwapStr.Len;
      if SwapLength = 0 then
        begin
          Result := (UpperCaseSourceStr[SourceIndex] = umlMultipleString);
          exit;
        end;
      SwapIndex := 1;
      SwapChar := SwapStr[SwapIndex];
      while (not umlMatchChar(SwapChar, @umlMultipleCharacter)) and (not umlMatchChar(SwapChar, @umlMultipleString)) and (SwapIndex < SwapLength) do
        begin
          SwapIndex := SwapIndex + 1;
          SwapChar := SwapStr[SwapIndex];
        end;
      if (umlMatchChar(SwapChar, @umlMultipleCharacter)) or (umlMatchChar(SwapChar, @umlMultipleString)) then
          SwapStr := umlCopyStr(SwapStr, 1, SwapIndex)
      else
        begin
          SwapStr := umlCopyStr(SwapStr, 1, SwapIndex + 1);
          if SwapStr = '' then
            begin
              Result := False;
              exit;
            end;
          SwapLength := SwapStr.Len;
          SwapIndex := 1;
          SwapChar := SwapStr[SwapLength];
          TargetChar := UpperCaseTargetStr[TargetLength];
          while SwapChar = TargetChar do
            begin
              if SwapIndex = SwapLength then
                begin
                  Result := True;
                  exit;
                end;
              if SwapIndex = TargetLength then
                begin
                  Result := False;
                  exit;
                end;
              SwapChar := SwapStr[(SwapLength) - SwapIndex];
              TargetChar := UpperCaseTargetStr[(TargetLength) - SwapIndex];
              SwapIndex := SwapIndex + 1;
            end;
          Result := False;
          exit;
        end;
      SwapChar := SwapStr[1];
      SwapIndex := 1;
      SwapLength := SwapStr.Len;
      while SwapIndex <= SwapLength do
        begin
          if (TargetIndex - 1) + SwapIndex > TargetLength then
            begin
              Result := False;
              exit;
            end;
          SwapChar := SwapStr[SwapIndex];
          TargetChar := UpperCaseTargetStr[(TargetIndex - 1) + SwapIndex];
          while SwapChar <> TargetChar do
            begin
              if (TargetIndex + SwapLength) > TargetLength then
                begin
                  Result := False;
                  exit;
                end;
              TargetIndex := TargetIndex + 1;
              SwapIndex := 1;
              SwapChar := SwapStr[SwapIndex];
              TargetChar := UpperCaseTargetStr[(TargetIndex - 1) + SwapIndex];
            end;
          SwapIndex := SwapIndex + 1;
        end;
      TargetIndex := (TargetIndex - 1) + SwapLength;
      SourceIndex := (SourceIndex - 1) + SwapLength;
      TargetChar := SwapChar;
      SourceChar := SwapChar;
    end;
  if SourceChar = TargetChar then
      goto Character_Label
  else if umlMatchChar(SourceChar, @umlMultipleCharacter) then
      goto MChar_Label
  else if umlMatchChar(SourceChar, @umlMultipleString) then
      goto MString_Label
  else
      Result := False;
end;

function umlMultipleMatch(IgnoreCase: Boolean; const SourceStr, TargetStr: TPascalString): Boolean;
begin
  if (SourceStr.Len > 0) and (SourceStr.text <> '*') then
      Result := umlMultipleMatch(IgnoreCase, SourceStr, TargetStr, '*', '?')
  else
      Result := True;
end;

function umlMultipleMatch(const SourceStr, TargetStr: TPascalString): Boolean;
var
  fi: TArrayPascalString;
begin
  if (SourceStr.Len > 0) and (SourceStr.text <> '*') then
    begin
      umlGetSplitArray(SourceStr, fi, ';');
      Result := umlMultipleMatch(fi, TargetStr);
    end
  else
      Result := True;
end;

function umlMultipleMatch(const ValueCheck: array of TPascalString; const Value: TPascalString): Boolean;
var
  i: Integer;
begin
  Result := False;
  if Value.Len > 0 then
    begin
      if high(ValueCheck) >= 0 then
        begin
          Result := False;
          for i := low(ValueCheck) to high(ValueCheck) do
            begin
              Result := umlMultipleMatch(True, ValueCheck[i], Value);
              if Result then
                  exit;
            end;
        end
      else
          Result := True;
    end;
end;

function umlSearchMatch(const SourceStr, TargetStr: TPascalString): Boolean;
var
  fi: TArrayPascalString;
begin
  if (SourceStr.Len > 0) and (SourceStr.text <> '*') then
    begin
      umlGetSplitArray(SourceStr, fi, ';,');
      Result := umlSearchMatch(fi, TargetStr);
    end
  else
      Result := True;
end;

function umlSearchMatch(const ValueCheck: TArrayPascalString; Value: TPascalString): Boolean;
var
  i: Integer;
begin
  Result := False;
  if umlGetLength(Value) > 0 then
    begin
      if high(ValueCheck) >= 0 then
        begin
          Result := False;
          for i := low(ValueCheck) to high(ValueCheck) do
            begin
              Result := (Value.GetPos(ValueCheck[i]) > 0) or (umlMultipleMatch(True, ValueCheck[i], Value));
              if Result then
                  exit;
            end;
        end
      else
          Result := True;
    end;
end;

function umlMatchFileInfo(const exp_, sour_, dest_: TPascalString): Boolean;
const
  prefix = '<prefix>';
  postfix = '<postfix>';
var
  sour, dest, dest_prefix, dest_postfix, n: TPascalString;
begin
  sour := umlGetFileName(sour_);
  dest := umlGetFileName(dest_);
  dest_prefix := umlChangeFileExt(dest, '');
  dest_postfix := umlGetFileExt(dest);
  n := umlStringReplace(exp_, prefix, dest_prefix, True);
  n := umlStringReplace(n, postfix, dest_postfix, True);
  Result := umlMultipleMatch(n, sour);
  sour := '';
  dest := '';
  dest_prefix := '';
  dest_postfix := '';
  n := '';
end;

function umlGetDateTimeStr(NowDateTime: TDateTime): TPascalString;
var
  Year, Month, Day: Word;
  Hour, min_, Sec, MSec: Word;
begin
  DecodeDate(NowDateTime, Year, Month, Day);
  DecodeTime(NowDateTime, Hour, min_, Sec, MSec);
  Result := IntToStr(Year) + '-' + IntToStr(Month) + '-' + IntToStr(Day) + ' ' + IntToStr(Hour) + '-' + IntToStr(min_) + '-' + IntToStr(Sec) + '-' + IntToStr(MSec);
end;

function umlDecodeTimeToStr(NowDateTime: TDateTime): TPascalString;
var
  Year, Month, Day: Word;
  Hour, min_, Sec, MSec: Word;
begin
  DecodeDate(NowDateTime, Year, Month, Day);
  DecodeTime(NowDateTime, Hour, min_, Sec, MSec);
  Result := IntToHex(Year, 4) + IntToHex(Month, 2) +
    IntToHex(Day, 2) + IntToHex(Hour, 1) + IntToHex(min_, 2) +
    IntToHex(Sec, 2) + IntToHex(MSec, 3);
end;

function umlMakeRanName: TPascalString;
type
  TRanData = packed record
    Year, Month, Day: Word;
    Hour, min_, Sec, MSec: Word;
  end;
var
  d: TDateTime;
  r: TRanData;
begin
  d := umlNow();
  with r do
    begin
      DecodeDate(d, Year, Month, Day);
      DecodeTime(d, Hour, min_, Sec, MSec);
    end;
  Result := umlMD5String(@r, SizeOf(TRanData));
end;

function umlStringReplace(const s, OldPattern, NewPattern: TPascalString; IgnoreCase: Boolean): TPascalString;
var
  f: TReplaceFlags;
begin
  f := [rfReplaceAll];
  if IgnoreCase then
      f := f + [rfIgnoreCase];
  Result.text := StringReplace(s.text, OldPattern.text, NewPattern.text, f);
end;

function umlReplaceString(const s, OldPattern, NewPattern: TPascalString; IgnoreCase: Boolean): TPascalString;
begin
  Result := umlStringReplace(s, OldPattern, NewPattern, IgnoreCase);
end;

function umlCharReplace(const s: TPascalString; OldPattern, NewPattern: U_Char): TPascalString;
var
  i: Integer;
begin
  Result := s;
  if Result.Len > 0 then
    begin
      for i := 1 to umlGetLength(Result) do
        begin
          if Result[i] = OldPattern then
              Result[i] := NewPattern;
        end;
    end;
end;

function umlReplaceChar(const s: TPascalString; OldPattern, NewPattern: U_Char): TPascalString;
begin
  Result := umlCharReplace(s, OldPattern, NewPattern);
end;

function umlEncodeText2HTML(const psSrc: TPascalString): TPascalString;
var
  i: Integer;
begin
  Result := '';
  if psSrc.Len > 0 then
    begin
      i := 1;
      while i <= psSrc.Len do
        begin
          case psSrc[i] of
            ' ': Result.Append('&nbsp;');
            '<': Result.Append('&lt;');
            '>': Result.Append('&gt;');
            '&': Result.Append('&amp;');
            '"': Result.Append('&quot;');
            #9: Result.Append('&nbsp;&nbsp;&nbsp;&nbsp;');
            #13:
              begin
                if i + 1 <= psSrc.Len then
                  begin
                    if psSrc[i + 1] = #10 then
                        inc(i);
                    Result.Append('<br>');
                  end
                else
                  begin
                    Result.Append('<br>');
                  end;
              end;
            #10:
              begin
                if i + 1 <= psSrc.Len then
                  begin
                    if psSrc[i + 1] = #13 then
                        inc(i);
                    Result.Append('<br>');
                  end
                else
                  begin
                    Result.Append('<br>');
                  end;
              end;
            else
              Result.Append(psSrc[i]);
          end;
          inc(i);
        end;
    end;
end;

function umlURLEncode(const Data: TPascalString): TPascalString;
const
  EncodeSlash = False;
var
  UTF8Src: TBytes;
  i: Integer;
  b: Byte;
begin
  Result := '';
  try
    UTF8Src := Data.Bytes;
    for i := 0 to length(UTF8Src) - 1 do
      begin
        b := UTF8Src[i];
        if ((b >= $41) and (b <= $5A)) or ((b >= $61) and (b <= $7A)) or ((b >= $30) and (b <= $39)) or
          (b = $2D) or (b = $2E) or (b = $5F) or (b = $7E) or (b = $2F) or (b = $3A) then
            Result := Result + SystemChar(b)
        else
            Result := Result + '%' + IntToHex(b, 2);
      end;
  finally
      SetLength(UTF8Src, 0);
  end;
end;

function umlURLDecode(const Data: TPascalString; FormEncoded: Boolean): TPascalString;

  function CombineArry(const Buf1: TBytes; Buf2: Byte): TBytes;
  var
    L: Integer;
  begin
    L := length(Buf1);
    SetLength(Result, L + 1);

    if L > 0 then
        CopyPtr(@Buf1[0], @Result[0], L);

    Result[0 + L] := Buf2;
  end;

  procedure FreeArry(var a: TBytes);
  begin
    SetLength(a, 0);
  end;

var
  i: Integer;
  State: Byte;
  b, BV, B1: Byte;
  DataArry_, UTF8Str_: TBytes;
  tmpBytes: TBytes;
const
  STATE_READ_DATA = 0;
  STATE_READ_PERCENT_ENCODED_BYTE_1 = 1;
  STATE_READ_PERCENT_ENCODED_BYTE_2 = 2;
const
  HexCharsHigh: array [0 .. 15] of Byte = ($30, $31, $32, $33, $34, $35, $36, $37, $38, $39, 65, 66, 67, 68, 69, 70);
begin
  B1 := 0;
  State := STATE_READ_DATA;
  SetLength(UTF8Str_, 0);
  DataArry_ := Data.Bytes;
  for i := 0 to length(DataArry_) - 1 do
    begin
      b := DataArry_[i];
      if State = STATE_READ_DATA then
        begin
          if b = $25 then
              State := STATE_READ_PERCENT_ENCODED_BYTE_1
          else if FormEncoded and (b = $2B) then // + sign
            begin
              tmpBytes := UTF8Str_;
              UTF8Str_ := CombineArry(tmpBytes, Byte($20));
              FreeArry(tmpBytes);
            end
          else
            begin
              tmpBytes := UTF8Str_;
              UTF8Str_ := CombineArry(tmpBytes, Byte(Data[FirstCharPos + i]));
              FreeArry(tmpBytes);
            end;
        end
      else
        if (State = STATE_READ_PERCENT_ENCODED_BYTE_1) or (State = STATE_READ_PERCENT_ENCODED_BYTE_2) then
        begin
          if (b >= 65) and (b <= 70) then
              BV := b - 55
          else if (b >= 97) and (b <= 102) then
              BV := b - 87
          else if (b >= $30) and (b <= $39) then
              BV := b - $30
          else
              raiseInfo('Unexpected character: 0x' + IntToHex(b, 2));
          if State = STATE_READ_PERCENT_ENCODED_BYTE_1 then
            begin
              B1 := BV;
              State := STATE_READ_PERCENT_ENCODED_BYTE_2;
            end
          else
            begin
              b := (B1 shl 4) or BV;

              tmpBytes := UTF8Str_;
              UTF8Str_ := CombineArry(tmpBytes, b);
              FreeArry(tmpBytes);

              State := STATE_READ_DATA;
            end;
        end;
    end;
  Result.Bytes := UTF8Str_;
  FreeArry(UTF8Str_);
  FreeArry(DataArry_);
end;

function B64EstimateEncodedSize(Ctx: TBase64Context; InSize: Integer): Integer;
begin
  Result := ((InSize + 2) div 3) shl 2;

  if (Ctx.EOLSize > 0) and (Ctx.LineSize > 0) then
    begin
      Result := Result + ((Result + Ctx.LineSize - 1) div Ctx.LineSize) * Ctx.EOLSize;

      if not Ctx.TrailingEol then
          Result := Result - Ctx.EOLSize;
    end;
end;

function B64InitializeDecoding(var Ctx: TBase64Context; LiberalMode: Boolean): Boolean;
begin
  Ctx.TailBytes := 0;
  Ctx.EQUCount := 0;
  Ctx.LiberalMode := LiberalMode;

  Result := True;
end;

function B64InitializeEncoding(var Ctx: TBase64Context; LineSize: Integer; fEOL: TBase64EOLMarker; TrailingEol: Boolean): Boolean;
begin

  Result := False;
  Ctx.TailBytes := 0;
  Ctx.LineSize := LineSize;
  Ctx.LineWritten := 0;
  Ctx.EQUCount := 0;
  Ctx.TrailingEol := TrailingEol;
  Ctx.PutFirstEol := False;

  if LineSize < 4 then
      exit;

  case fEOL of
    emCRLF:
      begin
        Ctx.fEOL[0] := $0D;
        Ctx.fEOL[1] := $0A;
        Ctx.EOLSize := 2;
      end;
    emCR:
      begin
        Ctx.fEOL[0] := $0D;
        Ctx.EOLSize := 1;
      end;
    emLF:
      begin
        Ctx.fEOL[0] := $0A;
        Ctx.EOLSize := 1;
      end;
    else
      Ctx.EOLSize := 0;
  end;

  Result := True;
end;

function B64Encode(var Ctx: TBase64Context; buffer: PByte; Size: Integer; OutBuffer: PByte; var OutSize: Integer): Boolean;
var
  EstSize, i, Chunks: Integer;
  PreserveLastEol: Boolean;
begin
  PreserveLastEol := False;

  EstSize := ((Size + Ctx.TailBytes) div 3) shl 2;
  if (Ctx.LineSize > 0) and (Ctx.EOLSize > 0) then
    begin
      if (EstSize > 0) and ((Ctx.LineWritten + EstSize) mod Ctx.LineSize = 0) and
        ((Ctx.TailBytes + Size) mod 3 = 0) then
          PreserveLastEol := True;
      EstSize := EstSize + ((EstSize + Ctx.LineWritten) div Ctx.LineSize) * Ctx.EOLSize;
      if PreserveLastEol then
          EstSize := EstSize - Ctx.EOLSize;
    end;
  if Ctx.PutFirstEol then
      EstSize := EstSize + Ctx.EOLSize;

  if OutSize < EstSize then
    begin
      OutSize := EstSize;
      Result := False;
      exit;
    end;

  OutSize := EstSize;

  if Ctx.PutFirstEol then
    begin
      CopyPtr(@Ctx.fEOL[0], OutBuffer, Ctx.EOLSize);
      inc(OutBuffer, Ctx.EOLSize);
      Ctx.PutFirstEol := False;
    end;

  if Size + Ctx.TailBytes < 3 then
    begin
      for i := 0 to Size - 1 do
          Ctx.Tail[Ctx.TailBytes + i] := PBase64ByteArray(buffer)^[i];
      inc(Ctx.TailBytes, Size);
      Result := True;
      exit;
    end;

  if Ctx.TailBytes > 0 then
    begin
      for i := 0 to 2 - Ctx.TailBytes do
          Ctx.Tail[Ctx.TailBytes + i] := PBase64ByteArray(buffer)^[i];

      inc(buffer, 3 - Ctx.TailBytes);
      dec(Size, 3 - Ctx.TailBytes);

      Ctx.TailBytes := 0;

      Ctx.OutBuf[0] := Base64Symbols[Ctx.Tail[0] shr 2];
      Ctx.OutBuf[1] := Base64Symbols[((Ctx.Tail[0] and 3) shl 4) or (Ctx.Tail[1] shr 4)];
      Ctx.OutBuf[2] := Base64Symbols[((Ctx.Tail[1] and $F) shl 2) or (Ctx.Tail[2] shr 6)];
      Ctx.OutBuf[3] := Base64Symbols[Ctx.Tail[2] and $3F];

      if (Ctx.LineSize = 0) or (Ctx.LineWritten + 4 < Ctx.LineSize) then
        begin
          CopyPtr(@Ctx.OutBuf[0], OutBuffer, 4);
          inc(OutBuffer, 4);
          inc(Ctx.LineWritten, 4);
        end
      else
        begin
          i := Ctx.LineSize - Ctx.LineWritten;
          CopyPtr(@Ctx.OutBuf[0], OutBuffer, i);
          inc(OutBuffer, i);
          if (Size > 0) or (i < 4) or (not PreserveLastEol) then
            begin
              CopyPtr(@Ctx.fEOL[0], OutBuffer, Ctx.EOLSize);
              inc(OutBuffer, Ctx.EOLSize);
            end;
          CopyPtr(@Ctx.OutBuf[i], OutBuffer, 4 - i);
          inc(OutBuffer, 4 - i);
          Ctx.LineWritten := 4 - i;
        end;
    end;

  while Size >= 3 do
    begin
      if Ctx.LineSize > 0 then
        begin
          Chunks := (Ctx.LineSize - Ctx.LineWritten) shr 2;
          if Chunks > Size div 3 then
              Chunks := Size div 3;
        end
      else
          Chunks := Size div 3;

      for i := 0 to Chunks - 1 do
        begin
          OutBuffer^ := Base64Symbols[PBase64ByteArray(buffer)^[0] shr 2];
          inc(OutBuffer);
          PByte(OutBuffer)^ := Base64Symbols[((PBase64ByteArray(buffer)^[0] and 3) shl 4) or (PBase64ByteArray(buffer)^[1] shr 4)];
          inc(OutBuffer);
          PByte(OutBuffer)^ := Base64Symbols[((PBase64ByteArray(buffer)^[1] and $F) shl 2) or (PBase64ByteArray(buffer)^[2] shr 6)];
          inc(OutBuffer);
          PByte(OutBuffer)^ := Base64Symbols[PBase64ByteArray(buffer)^[2] and $3F];
          inc(OutBuffer);
          inc(buffer, 3);
        end;

      dec(Size, 3 * Chunks);

      if Ctx.LineSize > 0 then
        begin
          inc(Ctx.LineWritten, Chunks shl 2);

          if (Size >= 3) and (Ctx.LineSize - Ctx.LineWritten > 0) then
            begin
              Ctx.OutBuf[0] := Base64Symbols[PBase64ByteArray(buffer)^[0] shr 2];
              Ctx.OutBuf[1] := Base64Symbols[((PBase64ByteArray(buffer)^[0] and 3) shl 4) or (PBase64ByteArray(buffer)^[1] shr 4)];
              Ctx.OutBuf[2] := Base64Symbols[((PBase64ByteArray(buffer)^[1] and $F) shl 2) or (PBase64ByteArray(buffer)^[2] shr 6)];
              Ctx.OutBuf[3] := Base64Symbols[PBase64ByteArray(buffer)^[2] and $3F];
              inc(buffer, 3);

              dec(Size, 3);

              i := Ctx.LineSize - Ctx.LineWritten;

              CopyPtr(@Ctx.OutBuf[0], OutBuffer, i);
              inc(OutBuffer, i);
              if (Ctx.EOLSize > 0) and ((i < 4) or (Size > 0) or (not PreserveLastEol)) then
                begin
                  CopyPtr(@Ctx.fEOL[0], OutBuffer, Ctx.EOLSize);
                  inc(OutBuffer, Ctx.EOLSize);
                end;

              CopyPtr(@Ctx.OutBuf[i], OutBuffer, 4 - i);
              inc(OutBuffer, 4 - i);

              Ctx.LineWritten := 4 - i;
            end
          else
            if Ctx.LineWritten = Ctx.LineSize then
            begin
              Ctx.LineWritten := 0;
              if (Ctx.EOLSize > 0) and ((Size > 0) or (not PreserveLastEol)) then
                begin
                  CopyPtr(@Ctx.fEOL[0], OutBuffer, Ctx.EOLSize);
                  inc(OutBuffer, Ctx.EOLSize);
                end;
            end;
        end;
    end;

  if Size > 0 then
    begin
      CopyPtr(buffer, @Ctx.Tail[0], Size);
      Ctx.TailBytes := Size;
    end
  else
    if PreserveLastEol then
      Ctx.PutFirstEol := True;

  Result := True;
end;

function B64Decode(var Ctx: TBase64Context; buffer: PByte; Size: Integer; OutBuffer: PByte; var OutSize: Integer): Boolean;
var
  i, EstSize, EQUCount: Integer;
  BufPtr: PByte;
  c: Byte;
begin
  if Size = 0 then
    begin
      Result := True;
      OutSize := 0;
      exit;
    end;

  EQUCount := Ctx.EQUCount;
  EstSize := Ctx.TailBytes;
  BufPtr := buffer;

  for i := 0 to Size - 1 do
    begin
      c := Base64Values[PByte(BufPtr)^];
      if c < 64 then
          inc(EstSize)
      else
        if c = $FF then
        begin
          if not Ctx.LiberalMode then
            begin
              Result := False;
              OutSize := 0;
              exit;
            end;
        end
      else
        if c = $FD then
        begin
          if EQUCount > 1 then
            begin
              Result := False;
              OutSize := 0;
              exit;
            end;
          inc(EQUCount);
        end;
      inc(BufPtr);
    end;

  EstSize := (EstSize shr 2) * 3;
  if OutSize < EstSize then
    begin
      OutSize := EstSize;
      Result := False;
      exit;
    end;

  Ctx.EQUCount := EQUCount;
  OutSize := EstSize;

  while Size > 0 do
    begin
      c := Base64Values[PByte(buffer)^];
      if c < 64 then
        begin
          Ctx.Tail[Ctx.TailBytes] := c;
          inc(Ctx.TailBytes);

          if Ctx.TailBytes = 4 then
            begin
              PByte(OutBuffer)^ := (Ctx.Tail[0] shl 2) or (Ctx.Tail[1] shr 4);
              inc(OutBuffer);

              PByte(OutBuffer)^ := ((Ctx.Tail[1] and $F) shl 4) or (Ctx.Tail[2] shr 2);
              inc(OutBuffer);

              PByte(OutBuffer)^ := ((Ctx.Tail[2] and $3) shl 6) or Ctx.Tail[3];
              inc(OutBuffer);

              Ctx.TailBytes := 0;
            end;
        end;
      inc(buffer);
      dec(Size);
    end;
  Result := True;
end;

function B64FinalizeEncoding(var Ctx: TBase64Context; OutBuffer: PByte; var OutSize: Integer): Boolean;
var
  EstSize: Integer;
begin
  if Ctx.TailBytes > 0 then
      EstSize := 4
  else
      EstSize := 0;

  if Ctx.TrailingEol then
      EstSize := EstSize + Ctx.EOLSize;

  if OutSize < EstSize then
    begin
      OutSize := EstSize;
      Result := False;
      exit;
    end;

  OutSize := EstSize;

  if Ctx.TailBytes = 0 then
    begin
      { writing trailing EOL }
      Result := True;
      if (Ctx.EOLSize > 0) and Ctx.TrailingEol then
        begin
          OutSize := Ctx.EOLSize;
          CopyPtr(@Ctx.fEOL[0], OutBuffer, Ctx.EOLSize);
        end;
      exit;
    end;

  if Ctx.TailBytes = 1 then
    begin
      PBase64ByteArray(OutBuffer)^[0] := Base64Symbols[Ctx.Tail[0] shr 2];
      PBase64ByteArray(OutBuffer)^[1] := Base64Symbols[((Ctx.Tail[0] and 3) shl 4)];
      PBase64ByteArray(OutBuffer)^[2] := $3D; // '='
      PBase64ByteArray(OutBuffer)^[3] := $3D; // '='
    end
  else if Ctx.TailBytes = 2 then
    begin
      PBase64ByteArray(OutBuffer)^[0] := Base64Symbols[Ctx.Tail[0] shr 2];
      PBase64ByteArray(OutBuffer)^[1] := Base64Symbols[((Ctx.Tail[0] and 3) shl 4) or (Ctx.Tail[1] shr 4)];
      PBase64ByteArray(OutBuffer)^[2] := Base64Symbols[((Ctx.Tail[1] and $F) shl 2)];
      PBase64ByteArray(OutBuffer)^[3] := $3D; // '='
    end;

  if (Ctx.EOLSize > 0) and (Ctx.TrailingEol) then
      CopyPtr(@Ctx.fEOL[0], @PBase64ByteArray(OutBuffer)^[4], Ctx.EOLSize);

  Result := True;
end;

function B64FinalizeDecoding(var Ctx: TBase64Context; OutBuffer: PByte; var OutSize: Integer): Boolean;
begin
  if (Ctx.EQUCount = 0) then
    begin
      OutSize := 0;
      Result := Ctx.TailBytes = 0;
      exit;
    end
  else
    if (Ctx.EQUCount = 1) then
    begin
      if Ctx.TailBytes <> 3 then
        begin
          Result := False;
          OutSize := 0;
          exit;
        end;

      if OutSize < 2 then
        begin
          OutSize := 2;
          Result := False;
          exit;
        end;

      PByte(OutBuffer)^ := (Ctx.Tail[0] shl 2) or (Ctx.Tail[1] shr 4);
      inc(OutBuffer);
      PByte(OutBuffer)^ := ((Ctx.Tail[1] and $F) shl 4) or (Ctx.Tail[2] shr 2);
      OutSize := 2;
      Result := True;
    end
  else if (Ctx.EQUCount = 2) then
    begin
      if Ctx.TailBytes <> 2 then
        begin
          Result := False;
          OutSize := 0;
          exit;
        end;

      if OutSize < 1 then
        begin
          OutSize := 1;
          Result := False;
          exit;
        end;

      PByte(OutBuffer)^ := (Ctx.Tail[0] shl 2) or (Ctx.Tail[1] shr 4);

      OutSize := 1;
      Result := True;
    end
  else
    begin
      Result := False;
      OutSize := 0;
    end;
end;

function umlBase64Encode(InBuffer: PByte; InSize: Integer; OutBuffer: PByte; var OutSize: Integer; WrapLines: Boolean): Boolean;
var
  Ctx: TBase64Context;
  TmpSize: Integer;
begin
  if WrapLines then
      B64InitializeEncoding(Ctx, 64, emCRLF, False)
  else
      B64InitializeEncoding(Ctx, 0, emNone, False);

  TmpSize := B64EstimateEncodedSize(Ctx, InSize);

  if (OutSize < TmpSize) then
    begin
      OutSize := TmpSize;
      Result := False;
      exit;
    end;

  TmpSize := OutSize;
  B64Encode(Ctx, InBuffer, InSize, OutBuffer, TmpSize);
  OutSize := OutSize - TmpSize;
  B64FinalizeEncoding(Ctx, PByte(NativeUInt(OutBuffer) + UInt32(TmpSize)), OutSize);
  OutSize := OutSize + TmpSize;

  Result := True;
end;

function umlBase64Decode(InBuffer: PByte; InSize: Integer; OutBuffer: PByte; var OutSize: Integer; LiberalMode: Boolean): Integer;
var
  i, TmpSize: Integer;
  ExtraSyms: Integer;
  Ctx: TBase64Context;
begin
  ExtraSyms := 0;
  try
    for i := 0 to InSize - 1 do
      if (PBase64ByteArray(InBuffer)^[i] in [$0D, $0A, $0]) then // some buggy software products insert 0x00 characters to BASE64 they produce
          inc(ExtraSyms);
  except
  end;

  if not LiberalMode then
    begin
      if ((InSize - ExtraSyms) and $3) <> 0 then
        begin
          Result := BASE64_DECODE_WRONG_DATA_SIZE;
          OutSize := 0;
          exit;
        end;
    end;

  TmpSize := ((InSize - ExtraSyms) shr 2) * 3;
  if OutSize < TmpSize then
    begin
      Result := BASE64_DECODE_NOT_ENOUGH_SPACE;
      OutSize := TmpSize;
      exit;
    end;

  B64InitializeDecoding(Ctx, LiberalMode);
  TmpSize := OutSize;
  if not B64Decode(Ctx, InBuffer, InSize, OutBuffer, TmpSize) then
    begin
      Result := BASE64_DECODE_INVALID_CHARACTER;
      OutSize := 0;
      exit;
    end;
  OutSize := OutSize - TmpSize;
  if not B64FinalizeDecoding(Ctx, @PBase64ByteArray(OutBuffer)^[TmpSize], OutSize) then
    begin
      Result := BASE64_DECODE_INVALID_CHARACTER;
      OutSize := 0;
      exit;
    end;
  OutSize := OutSize + TmpSize;
  Result := BASE64_DECODE_OK;
end;

procedure umlBase64EncodeBytes(var sour, dest: TBytes);
var
  Size: Integer;
begin
  if length(sour) = 0 then
      exit;

  Size := 0;
  SetLength(dest, 0);
  umlBase64Encode(@sour[0], length(sour), nil, Size, False);
  SetLength(dest, Size);
  umlBase64Encode(@sour[0], length(sour), @dest[0], Size, False);
  SetLength(dest, Size);
end;

procedure umlBase64DecodeBytes(var sour, dest: TBytes);
var
  Size: Integer;
begin
  if length(sour) = 0 then
    begin
      SetLength(dest, 0);
      exit;
    end;

  Size := 0;
  umlBase64Decode(@sour[0], length(sour), nil, Size, True);
  SetLength(dest, Size);
  umlBase64Decode(@sour[0], length(sour), @dest[0], Size, True);
  SetLength(dest, Size);
end;

procedure umlBase64EncodeBytes(var sour: TBytes; var dest: TPascalString);
var
  buff: TBytes;
begin
  umlBase64EncodeBytes(sour, buff);
  dest.Bytes := buff;
end;

procedure umlBase64DecodeBytes(const sour: TPascalString; var dest: TBytes);
var
  buff: TBytes;
begin
  buff := sour.Bytes;
  umlBase64DecodeBytes(buff, dest);
end;

procedure umlDecodeLineBASE64(const buffer: TPascalString; var output: TPascalString);
var
  b, nb: TBytes;
begin
  b := umlBytesOf(buffer);
  umlBase64DecodeBytes(b, nb);
  output := umlStringOf(nb);
end;

procedure umlEncodeLineBASE64(const buffer: TPascalString; var output: TPascalString);
var
  b, nb: TBytes;
begin
  b := umlBytesOf(buffer);
  umlBase64EncodeBytes(b, nb);
  output := umlStringOf(nb);
end;

procedure umlDecodeStreamBASE64(const buffer: TPascalString; output: TCoreClassStream);
var
  b, nb: TBytes;
  bak: Int64;
begin
  b := umlBytesOf(buffer);
  umlBase64DecodeBytes(b, nb);
  bak := output.Position;
  output.WriteBuffer(nb[0], length(nb));
  output.Position := bak;
end;

procedure umlEncodeStreamBASE64(buffer: TCoreClassStream; var output: TPascalString);
var
  b, nb: TBytes;
  bak: Int64;
begin
  bak := buffer.Position;

  buffer.Position := 0;
  SetLength(b, buffer.Size);
  buffer.ReadBuffer(b[0], buffer.Size);
  umlBase64EncodeBytes(b, nb);
  output := umlStringOf(nb);

  buffer.Position := bak;
end;

function umlDivisionBase64Text(const buffer: TPascalString; width: Integer; DivisionAsPascalString: Boolean): TPascalString;
var
  i, n: Integer;
begin
  Result := '';
  n := 0;
  for i := 1 to buffer.Len do
    begin
      if (DivisionAsPascalString) and (n = 0) then
          Result.Append(#39);

      Result.Append(buffer[i]);
      inc(n);
      if n = width then
        begin
          if DivisionAsPascalString then
              Result.Append(#39 + '+' + #13#10)
          else
              Result.Append(#13#10);
          n := 0;
        end;
    end;
  if DivisionAsPascalString then
      Result.Append(#39);
end;

function umlTestBase64(const text: TPascalString): Boolean;
var
  sour, dest: TBytes;
begin
  sour := text.Bytes;
  SetLength(dest, 0);
  try
      umlBase64DecodeBytes(sour, dest);
  except
  end;
  Result := length(dest) > 0;
  if Result then
      SetLength(dest, 0);
end;

procedure umlTransformMD5(var Accu; const Buf); inline;
{$IF Defined(FastMD5) and Defined(Delphi) and (Defined(WIN32) or Defined(WIN64))}
begin
  MD5_Transform(Accu, Buf);
end;
{$ELSE}
  function ROL(const x: Cardinal; const n: Byte): Cardinal; inline;
  begin
    Result := (x shl n) or (x shr (32 - n))
  end;

  function FF(const a, b, c, d, x: Cardinal; const s: Byte; const AC: Cardinal): Cardinal; inline;
  begin
    Result := ROL(a + x + AC + (b and c or not b and d), s) + b
  end;

  function GG(const a, b, c, d, x: Cardinal; const s: Byte; const AC: Cardinal): Cardinal; inline;
  begin
    Result := ROL(a + x + AC + (b and d or c and not d), s) + b
  end;

  function HH(const a, b, c, d, x: Cardinal; const s: Byte; const AC: Cardinal): Cardinal; inline;
  begin
    Result := ROL(a + x + AC + (b xor c xor d), s) + b
  end;

  function II(const a, b, c, d, x: Cardinal; const s: Byte; const AC: Cardinal): Cardinal; inline;
  begin
    Result := ROL(a + x + AC + (c xor (b or not d)), s) + b
  end;

type
  TDigestCardinal = array [0 .. 3] of Cardinal;
  TCardinalBuf = array [0 .. 15] of Cardinal;
var
  a, b, c, d: Cardinal;
begin
  a := TDigestCardinal(Accu)[0];
  b := TDigestCardinal(Accu)[1];
  c := TDigestCardinal(Accu)[2];
  d := TDigestCardinal(Accu)[3];

  a := FF(a, b, c, d, TCardinalBuf(Buf)[0], 7, $D76AA478);   { 1 }
  d := FF(d, a, b, c, TCardinalBuf(Buf)[1], 12, $E8C7B756);  { 2 }
  c := FF(c, d, a, b, TCardinalBuf(Buf)[2], 17, $242070DB);  { 3 }
  b := FF(b, c, d, a, TCardinalBuf(Buf)[3], 22, $C1BDCEEE);  { 4 }
  a := FF(a, b, c, d, TCardinalBuf(Buf)[4], 7, $F57C0FAF);   { 5 }
  d := FF(d, a, b, c, TCardinalBuf(Buf)[5], 12, $4787C62A);  { 6 }
  c := FF(c, d, a, b, TCardinalBuf(Buf)[6], 17, $A8304613);  { 7 }
  b := FF(b, c, d, a, TCardinalBuf(Buf)[7], 22, $FD469501);  { 8 }
  a := FF(a, b, c, d, TCardinalBuf(Buf)[8], 7, $698098D8);   { 9 }
  d := FF(d, a, b, c, TCardinalBuf(Buf)[9], 12, $8B44F7AF);  { 10 }
  c := FF(c, d, a, b, TCardinalBuf(Buf)[10], 17, $FFFF5BB1); { 11 }
  b := FF(b, c, d, a, TCardinalBuf(Buf)[11], 22, $895CD7BE); { 12 }
  a := FF(a, b, c, d, TCardinalBuf(Buf)[12], 7, $6B901122);  { 13 }
  d := FF(d, a, b, c, TCardinalBuf(Buf)[13], 12, $FD987193); { 14 }
  c := FF(c, d, a, b, TCardinalBuf(Buf)[14], 17, $A679438E); { 15 }
  b := FF(b, c, d, a, TCardinalBuf(Buf)[15], 22, $49B40821); { 16 }
  a := GG(a, b, c, d, TCardinalBuf(Buf)[1], 5, $F61E2562);   { 17 }
  d := GG(d, a, b, c, TCardinalBuf(Buf)[6], 9, $C040B340);   { 18 }
  c := GG(c, d, a, b, TCardinalBuf(Buf)[11], 14, $265E5A51); { 19 }
  b := GG(b, c, d, a, TCardinalBuf(Buf)[0], 20, $E9B6C7AA);  { 20 }
  a := GG(a, b, c, d, TCardinalBuf(Buf)[5], 5, $D62F105D);   { 21 }
  d := GG(d, a, b, c, TCardinalBuf(Buf)[10], 9, $02441453);  { 22 }
  c := GG(c, d, a, b, TCardinalBuf(Buf)[15], 14, $D8A1E681); { 23 }
  b := GG(b, c, d, a, TCardinalBuf(Buf)[4], 20, $E7D3FBC8);  { 24 }
  a := GG(a, b, c, d, TCardinalBuf(Buf)[9], 5, $21E1CDE6);   { 25 }
  d := GG(d, a, b, c, TCardinalBuf(Buf)[14], 9, $C33707D6);  { 26 }
  c := GG(c, d, a, b, TCardinalBuf(Buf)[3], 14, $F4D50D87);  { 27 }
  b := GG(b, c, d, a, TCardinalBuf(Buf)[8], 20, $455A14ED);  { 28 }
  a := GG(a, b, c, d, TCardinalBuf(Buf)[13], 5, $A9E3E905);  { 29 }
  d := GG(d, a, b, c, TCardinalBuf(Buf)[2], 9, $FCEFA3F8);   { 30 }
  c := GG(c, d, a, b, TCardinalBuf(Buf)[7], 14, $676F02D9);  { 31 }
  b := GG(b, c, d, a, TCardinalBuf(Buf)[12], 20, $8D2A4C8A); { 32 }
  a := HH(a, b, c, d, TCardinalBuf(Buf)[5], 4, $FFFA3942);   { 33 }
  d := HH(d, a, b, c, TCardinalBuf(Buf)[8], 11, $8771F681);  { 34 }
  c := HH(c, d, a, b, TCardinalBuf(Buf)[11], 16, $6D9D6122); { 35 }
  b := HH(b, c, d, a, TCardinalBuf(Buf)[14], 23, $FDE5380C); { 36 }
  a := HH(a, b, c, d, TCardinalBuf(Buf)[1], 4, $A4BEEA44);   { 37 }
  d := HH(d, a, b, c, TCardinalBuf(Buf)[4], 11, $4BDECFA9);  { 38 }
  c := HH(c, d, a, b, TCardinalBuf(Buf)[7], 16, $F6BB4B60);  { 39 }
  b := HH(b, c, d, a, TCardinalBuf(Buf)[10], 23, $BEBFBC70); { 40 }
  a := HH(a, b, c, d, TCardinalBuf(Buf)[13], 4, $289B7EC6);  { 41 }
  d := HH(d, a, b, c, TCardinalBuf(Buf)[0], 11, $EAA127FA);  { 42 }
  c := HH(c, d, a, b, TCardinalBuf(Buf)[3], 16, $D4EF3085);  { 43 }
  b := HH(b, c, d, a, TCardinalBuf(Buf)[6], 23, $04881D05);  { 44 }
  a := HH(a, b, c, d, TCardinalBuf(Buf)[9], 4, $D9D4D039);   { 45 }
  d := HH(d, a, b, c, TCardinalBuf(Buf)[12], 11, $E6DB99E5); { 46 }
  c := HH(c, d, a, b, TCardinalBuf(Buf)[15], 16, $1FA27CF8); { 47 }
  b := HH(b, c, d, a, TCardinalBuf(Buf)[2], 23, $C4AC5665);  { 48 }
  a := II(a, b, c, d, TCardinalBuf(Buf)[0], 6, $F4292244);   { 49 }
  d := II(d, a, b, c, TCardinalBuf(Buf)[7], 10, $432AFF97);  { 50 }
  c := II(c, d, a, b, TCardinalBuf(Buf)[14], 15, $AB9423A7); { 51 }
  b := II(b, c, d, a, TCardinalBuf(Buf)[5], 21, $FC93A039);  { 52 }
  a := II(a, b, c, d, TCardinalBuf(Buf)[12], 6, $655B59C3);  { 53 }
  d := II(d, a, b, c, TCardinalBuf(Buf)[3], 10, $8F0CCC92);  { 54 }
  c := II(c, d, a, b, TCardinalBuf(Buf)[10], 15, $FFEFF47D); { 55 }
  b := II(b, c, d, a, TCardinalBuf(Buf)[1], 21, $85845DD1);  { 56 }
  a := II(a, b, c, d, TCardinalBuf(Buf)[8], 6, $6FA87E4F);   { 57 }
  d := II(d, a, b, c, TCardinalBuf(Buf)[15], 10, $FE2CE6E0); { 58 }
  c := II(c, d, a, b, TCardinalBuf(Buf)[6], 15, $A3014314);  { 59 }
  b := II(b, c, d, a, TCardinalBuf(Buf)[13], 21, $4E0811A1); { 60 }
  a := II(a, b, c, d, TCardinalBuf(Buf)[4], 6, $F7537E82);   { 61 }
  d := II(d, a, b, c, TCardinalBuf(Buf)[11], 10, $BD3AF235); { 62 }
  c := II(c, d, a, b, TCardinalBuf(Buf)[2], 15, $2AD7D2BB);  { 63 }
  b := II(b, c, d, a, TCardinalBuf(Buf)[9], 21, $EB86D391);  { 64 }

  inc(TDigestCardinal(Accu)[0], a);
  inc(TDigestCardinal(Accu)[1], b);
  inc(TDigestCardinal(Accu)[2], c);
  inc(TDigestCardinal(Accu)[3], d)
end;
{$IFEND}


function umlMD5(const buffPtr: PByte; bufSiz: NativeUInt): TMD5;
{$IF Defined(FastMD5) and Defined(Delphi) and (Defined(WIN32) or Defined(WIN64))}
begin
  Result := FastMD5(buffPtr, bufSiz);
end;
{$ELSE}


var
  Digest: TMD5;
  Lo, Hi: Cardinal;
  p: PByte;
  ChunkIndex: Byte;
  ChunkBuff: array [0 .. 63] of Byte;
begin
  Lo := 0;
  Hi := 0;
  PCardinal(@Digest[0])^ := $67452301;
  PCardinal(@Digest[4])^ := $EFCDAB89;
  PCardinal(@Digest[8])^ := $98BADCFE;
  PCardinal(@Digest[12])^ := $10325476;

  inc(Lo, bufSiz shl 3);
  inc(Hi, bufSiz shr 29);

  p := buffPtr;

  while bufSiz >= $40 do
    begin
      umlTransformMD5(Digest, p^);
      inc(p, $40);
      dec(bufSiz, $40);
    end;
  if bufSiz > 0 then
      CopyPtr(p, @ChunkBuff[0], bufSiz);

  Result := PMD5(@Digest[0])^;
  ChunkBuff[bufSiz] := $80;
  ChunkIndex := bufSiz + 1;
  if ChunkIndex > $38 then
    begin
      if ChunkIndex < $40 then
          FillPtrByte(@ChunkBuff[ChunkIndex], $40 - ChunkIndex, 0);
      umlTransformMD5(Result, ChunkBuff);
      ChunkIndex := 0
    end;
  FillPtrByte(@ChunkBuff[ChunkIndex], $38 - ChunkIndex, 0);
  PCardinal(@ChunkBuff[$38])^ := Lo;
  PCardinal(@ChunkBuff[$3C])^ := Hi;
  umlTransformMD5(Result, ChunkBuff);
end;
{$IFEND}


function umlMD5Char(const buffPtr: PByte; const BuffSize: NativeUInt): TPascalString;
begin
  Result := umlMD5ToStr(umlMD5(buffPtr, BuffSize));
end;

function umlMD5String(const buffPtr: PByte; const BuffSize: NativeUInt): TPascalString;
begin
  Result := umlMD5ToStr(umlMD5(buffPtr, BuffSize));
end;

function umlStreamMD5(stream: TCoreClassStream; StartPos, EndPos: Int64): TMD5;
{$IF Defined(FastMD5) and Defined(Delphi) and (Defined(WIN32) or Defined(WIN64))}
begin
  Result := FastMD5(stream, StartPos, EndPos);
end;
{$ELSE}


const
  deltaSize: Cardinal = $40 * $FFFF;

var
  Digest: TMD5;
  Lo, Hi: Cardinal;
  DeltaBuf: Pointer;
  bufSiz: Int64;
  Rest: Cardinal;
  p: PByte;
  ChunkIndex: Byte;
  ChunkBuff: array [0 .. 63] of Byte;
begin
  if StartPos > EndPos then
      Swap(StartPos, EndPos);
  StartPos := umlClamp(StartPos, 0, stream.Size);
  EndPos := umlClamp(EndPos, 0, stream.Size);
  if EndPos - StartPos <= 0 then
    begin
      Result := umlMD5(nil, 0);
      exit;
    end;
{$IFDEF OptimizationMemoryStreamMD5}
  if stream is TCoreClassMemoryStream then
    begin
      Result := umlMD5(Pointer(NativeUInt(TCoreClassMemoryStream(stream).Memory) + StartPos), EndPos - StartPos);
      exit;
    end;
  if stream is TMemoryStream64 then
    begin
      Result := umlMD5(TMemoryStream64(stream).PositionAsPtr(StartPos), EndPos - StartPos);
      exit;
    end;
{$IFEND}
  //

  Lo := 0;
  Hi := 0;
  PCardinal(@Digest[0])^ := $67452301;
  PCardinal(@Digest[4])^ := $EFCDAB89;
  PCardinal(@Digest[8])^ := $98BADCFE;
  PCardinal(@Digest[12])^ := $10325476;

  bufSiz := EndPos - StartPos;
  Rest := 0;

  inc(Lo, bufSiz shl 3);
  inc(Hi, bufSiz shr 29);

  DeltaBuf := GetMemory(deltaSize);
  stream.Position := StartPos;

  if bufSiz < $40 then
    begin
      stream.read(DeltaBuf^, bufSiz);
      p := DeltaBuf;
    end
  else
    while bufSiz >= $40 do
      begin
        if Rest = 0 then
          begin
            if bufSiz >= deltaSize then
                Rest := deltaSize
            else
                Rest := bufSiz;
            stream.ReadBuffer(DeltaBuf^, Rest);

            p := DeltaBuf;
          end;
        umlTransformMD5(Digest, p^);
        inc(p, $40);
        dec(bufSiz, $40);
        dec(Rest, $40);
      end;

  if bufSiz > 0 then
      CopyPtr(p, @ChunkBuff[0], bufSiz);

  FreeMemory(DeltaBuf);

  Result := PMD5(@Digest[0])^;
  ChunkBuff[bufSiz] := $80;
  ChunkIndex := bufSiz + 1;
  if ChunkIndex > $38 then
    begin
      if ChunkIndex < $40 then
          FillPtrByte(@ChunkBuff[ChunkIndex], $40 - ChunkIndex, 0);
      umlTransformMD5(Result, ChunkBuff);
      ChunkIndex := 0
    end;
  FillPtrByte(@ChunkBuff[ChunkIndex], $38 - ChunkIndex, 0);
  PCardinal(@ChunkBuff[$38])^ := Lo;
  PCardinal(@ChunkBuff[$3C])^ := Hi;
  umlTransformMD5(Result, ChunkBuff);
end;
{$IFEND}


function umlStreamMD5(stream: TCoreClassStream): TMD5;
begin
  if stream.Size <= 0 then
    begin
      Result := NullMD5;
      exit;
    end;
  stream.Position := 0;
  Result := umlStreamMD5(stream, 0, stream.Size);
  stream.Position := 0;
end;

function umlStreamMD5Char(stream: TCoreClassStream): TPascalString;
begin
  Result := umlMD5ToStr(umlStreamMD5(stream));
end;

function umlStreamMD5String(stream: TCoreClassStream): TPascalString;
begin
  Result := umlMD5ToStr(umlStreamMD5(stream));
end;

function umlStreamMD5Str(stream: TCoreClassStream): TPascalString;
begin
  Result := umlMD5ToStr(umlStreamMD5(stream));
end;

function umlStringMD5(const Value: TPascalString): TPascalString;
var
  b: TBytes;
begin
  b := umlBytesOf(Value);
  Result := umlMD5ToStr(umlMD5(@b[0], length(b)));
end;

function umlFileMD5___(FileName: TPascalString): TMD5;
var
  fs: TCoreClassFileStream;
begin
  try
      fs := TCoreClassFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
  except
    Result := NullMD5;
    exit;
  end;
  try
      Result := umlStreamMD5(fs);
  finally
      DisposeObject(fs);
  end;
end;

function umlFileMD5(FileName: TPascalString; StartPos, EndPos: Int64): TMD5;
var
  fs: TCoreClassFileStream;
begin
  try
      fs := TCoreClassFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
  except
    Result := NullMD5;
    exit;
  end;
  try
      Result := umlStreamMD5(fs, StartPos, EndPos);
  finally
      DisposeObject(fs);
  end;
end;

function umlCombineMD5(const m1: TMD5): TMD5;
begin
  Result := umlMD5(@m1, SizeOf(TMD5));
end;

function umlCombineMD5(const m1, m2: TMD5): TMD5;
var
  buff: array [0 .. 1] of TMD5;
begin
  buff[0] := m1;
  buff[1] := m2;
  Result := umlMD5(@buff[0], SizeOf(TMD5) * 2);
end;

function umlCombineMD5(const m1, m2, m3: TMD5): TMD5;
var
  buff: array [0 .. 2] of TMD5;
begin
  buff[0] := m1;
  buff[1] := m2;
  buff[2] := m3;
  Result := umlMD5(@buff[0], SizeOf(TMD5) * 3);
end;

function umlCombineMD5(const m1, m2, m3, m4: TMD5): TMD5;
var
  buff: array [0 .. 3] of TMD5;
begin
  buff[0] := m1;
  buff[1] := m2;
  buff[2] := m3;
  buff[3] := m4;
  Result := umlMD5(@buff[0], SizeOf(TMD5) * 4);
end;

function umlCombineMD5(const buff: array of TMD5): TMD5;
begin
  Result := umlMD5(@buff[0], length(buff) * SizeOf(TMD5));
end;

function umlMD5ToStr(md5: TMD5): TPascalString;
const
  HexArr: array [0 .. 15] of U_Char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
var
  i: Integer;
begin
  Result.Len := 32;
  for i := 0 to 15 do
    begin
      Result.buff[i * 2] := HexArr[(md5[i] shr 4) and $0F];
      Result.buff[i * 2 + 1] := HexArr[md5[i] and $0F];
    end;
end;

function umlMD5ToString(md5: TMD5): TPascalString;
const
  HexArr: array [0 .. 15] of U_Char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
var
  i: Integer;
begin
  Result.Len := 32;
  for i := 0 to 15 do
    begin
      Result.buff[i * 2] := HexArr[(md5[i] shr 4) and $0F];
      Result.buff[i * 2 + 1] := HexArr[md5[i] and $0F];
    end;
end;

function umlMD52String(md5: TMD5): TPascalString;
const
  HexArr: array [0 .. 15] of U_Char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
var
  i: Integer;
begin
  Result.Len := 32;
  for i := 0 to 15 do
    begin
      Result.buff[i * 2] := HexArr[(md5[i] shr 4) and $0F];
      Result.buff[i * 2 + 1] := HexArr[md5[i] and $0F];
    end;
end;

function umlMD5Compare(const m1, m2: TMD5): Boolean;
begin
  Result := (PUInt64(@m1[0])^ = PUInt64(@m2[0])^) and (PUInt64(@m1[8])^ = PUInt64(@m2[8])^);
end;

function umlCompareMD5(const m1, m2: TMD5): Boolean;
begin
  Result := (PUInt64(@m1[0])^ = PUInt64(@m2[0])^) and (PUInt64(@m1[8])^ = PUInt64(@m2[8])^);
end;

function umlIsNullMD5(m: TMD5): Boolean;
begin
  Result := umlCompareMD5(m, NullMD5);
end;

function umlWasNullMD5(m: TMD5): Boolean;
begin
  Result := umlCompareMD5(m, NullMD5);
end;

function umlCRC16(const Value: PByte; const Count: NativeUInt): Word;
var
  i: NativeUInt;
  p: PByte;
begin
  p := Value;
  Result := 0;
  i := 0;
  while i < Count do
    begin
      Result := (Result shr 8) xor CRC16Table[p^ xor (Result and $00FF)];
      inc(i);
      inc(p);
    end;
end;

function umlStringCRC16(const Value: TPascalString): Word;
var
  b: TBytes;
begin
  b := umlBytesOf(Value);
  Result := umlCRC16(@b[0], length(b));
end;

function umlStreamCRC16(stream: U_Stream; StartPos, EndPos: Int64): Word;
const
  ChunkSize = 1024 * 1024;
  procedure CRC16BUpdate(var crc: Word; const Buf: Pointer; Len: NativeUInt);
  var
    p: PByte;
    i: Integer;
  begin
    p := Buf;
    i := 0;
    while i < Len do
      begin
        crc := (crc shr 8) xor CRC16Table[p^ xor (crc and $00FF)];
        inc(p);
        inc(i);
      end;
  end;

var
  j: NativeUInt;
  Num: NativeUInt;
  Rest: NativeUInt;
  Buf: Pointer;
  FSize: Int64;
begin
  if stream is TCoreClassMemoryStream then
    begin
      Result := umlCRC16(Pointer(NativeUInt(TCoreClassMemoryStream(stream).Memory) + StartPos), EndPos - StartPos);
      exit;
    end;
  if stream is TMemoryStream64 then
    begin
      Result := umlCRC16(TMemoryStream64(stream).PositionAsPtr(StartPos), EndPos - StartPos);
      exit;
    end;
  { Allocate buffer to read file }
  Buf := GetMemory(ChunkSize);
  { Initialize CRC }
  Result := 0;

  { V1.03 calculate how much of the file we are processing }
  FSize := stream.Size;
  if (StartPos >= FSize) then
      StartPos := 0;
  if (EndPos > FSize) or (EndPos = 0) then
      EndPos := FSize;

  { Calculate number of full chunks that will fit into the buffer }
  Num := EndPos div ChunkSize;
  { Calculate remaining bytes }
  Rest := EndPos mod ChunkSize;

  { Set the stream to the beginning of the file }
  stream.Position := StartPos;

  { Process full chunks }
  for j := 0 to Num - 1 do begin
      stream.read(Buf^, ChunkSize);
      CRC16BUpdate(Result, Buf, ChunkSize);
    end;

  { Process remaining bytes }
  if Rest > 0 then begin
      stream.read(Buf^, Rest);
      CRC16BUpdate(Result, Buf, Rest);
    end;

  FreeMem(Buf, ChunkSize);
end;

function umlStreamCRC16(stream: U_Stream): Word;
begin
  stream.Position := 0;
  Result := umlStreamCRC16(stream, 0, stream.Size);
  stream.Position := 0;
end;

function umlCRC32(const Value: PByte; const Count: NativeUInt): Cardinal;
var
  i: NativeUInt;
  p: PByte;
begin
  p := Value;
  Result := $FFFFFFFF;
  i := 0;
  while i < Count do
    begin
      Result := ((Result shr 8) and $00FFFFFF) xor CRC32Table[(Result xor p^) and $000000FF];
      inc(i);
      inc(p);
    end;
  Result := Result xor $FFFFFFFF;
end;

function umlString2CRC32(const Value: TPascalString): Cardinal;
var
  b: TBytes;
begin
  b := umlBytesOf(Value);
  Result := umlCRC32(@b[0], length(b));
end;

function umlStreamCRC32(stream: U_Stream; StartPos, EndPos: Int64): Cardinal;
const
  ChunkSize = 1024 * 1024;

  procedure CRC32BUpdate(var crc: Cardinal; const Buf: Pointer; Len: NativeUInt);
  var
    p: PByte;
    i: Integer;
  begin
    p := Buf;
    i := 0;
    while i < Len do
      begin
        crc := ((crc shr 8) and $00FFFFFF) xor CRC32Table[(crc xor p^) and $000000FF];
        inc(p);
        inc(i);
      end;
  end;

var
  j: NativeUInt;
  Num: NativeUInt;
  Rest: NativeUInt;
  Buf: Pointer;
  FSize: Int64;
begin
  if stream is TCoreClassMemoryStream then
    begin
      Result := umlCRC32(Pointer(NativeUInt(TCoreClassMemoryStream(stream).Memory) + StartPos), EndPos - StartPos);
      exit;
    end;
  if stream is TMemoryStream64 then
    begin
      Result := umlCRC32(TMemoryStream64(stream).PositionAsPtr(StartPos), EndPos - StartPos);
      exit;
    end;

  { Allocate buffer to read file }
  Buf := GetMemory(ChunkSize);

  { Initialize CRC }
  Result := $FFFFFFFF;

  { V1.03 calculate how much of the file we are processing }
  FSize := stream.Size;
  if (StartPos >= FSize) then
      StartPos := 0;
  if (EndPos > FSize) or (EndPos = 0) then
      EndPos := FSize;

  { Calculate number of full chunks that will fit into the buffer }
  Num := EndPos div ChunkSize;
  { Calculate remaining bytes }
  Rest := EndPos mod ChunkSize;

  { Set the stream to the beginning of the file }
  stream.Position := StartPos;

  { Process full chunks }
  for j := 0 to Num - 1 do begin
      stream.read(Buf^, ChunkSize);
      CRC32BUpdate(Result, Buf, ChunkSize);
    end;

  { Process remaining bytes }
  if Rest > 0 then begin
      stream.read(Buf^, Rest);
      CRC32BUpdate(Result, Buf, Rest);
    end;

  FreeMem(Buf, ChunkSize);

  Result := Result xor $FFFFFFFF;
end;

function umlStreamCRC32(stream: U_Stream): Cardinal;
begin
  stream.Position := 0;
  Result := umlStreamCRC32(stream, 0, stream.Size);
  stream.Position := 0;
end;

function umlTrimSpace(const s: TPascalString): TPascalString;
var
  L, bp, EP: Integer;
begin
  Result := '';
  L := s.Len;
  if L > 0 then
    begin
      bp := 1;
      while CharIn(s[bp], [#32, #0]) do
        begin
          inc(bp);
          if (bp > L) then
            begin
              Result := '';
              exit;
            end;
        end;
      if bp > L then
          Result := ''
      else
        begin
          EP := L;

          while CharIn(s[EP], [#32, #0]) do
            begin
              dec(EP);
              if (EP < 1) then
                begin
                  Result := '';
                  exit;
                end;
            end;
          Result := s.GetString(bp, EP + 1);
        end;
    end;
end;

function umlSeparatorText(Text_: TPascalString; dest: TCoreClassStrings; SeparatorChar: TPascalString): Integer;
var
  NewText_, SeparatorText_: TPascalString;
begin
  Result := 0;
  if Assigned(dest) then
    begin
      NewText_ := Text_;
      SeparatorText_ := umlGetFirstStr(NewText_, SeparatorChar);
      while (SeparatorText_.Len > 0) and (NewText_.Len > 0) do
        begin
          dest.Add(SeparatorText_.text);
          inc(Result);
          NewText_ := umlDeleteFirstStr(NewText_, SeparatorChar);
          SeparatorText_ := umlGetFirstStr(NewText_, SeparatorChar);
        end;
    end;
end;

function umlSeparatorText(Text_: TPascalString; dest: THashVariantList; SeparatorChar: TPascalString): Integer;
var
  NewText_, SeparatorText_: TPascalString;
begin
  Result := 0;
  if Assigned(dest) then
    begin
      NewText_ := Text_;
      SeparatorText_ := umlGetFirstStr(NewText_, SeparatorChar);
      while (SeparatorText_.Len > 0) and (NewText_.Len > 0) do
        begin
          dest.IncValue(SeparatorText_.text, 1);
          inc(Result);
          NewText_ := umlDeleteFirstStr(NewText_, SeparatorChar);
          SeparatorText_ := umlGetFirstStr(NewText_, SeparatorChar);
        end;
    end;
end;

function umlSeparatorText(Text_: TPascalString; dest: TListPascalString; SeparatorChar: TPascalString): Integer;
var
  NewText_, SeparatorText_: TPascalString;
begin
  Result := 0;
  if Assigned(dest) then
    begin
      NewText_ := Text_;
      SeparatorText_ := umlGetFirstStr(NewText_, SeparatorChar);
      while (SeparatorText_.Len > 0) and (NewText_.Len > 0) do
        begin
          dest.Add(SeparatorText_);
          inc(Result);
          NewText_ := umlDeleteFirstStr(NewText_, SeparatorChar);
          SeparatorText_ := umlGetFirstStr(NewText_, SeparatorChar);
        end;
    end;
end;

function umlStringsMatchText(OriginValue: TCoreClassStrings; DestValue: TPascalString; IgnoreCase: Boolean): Boolean;
var
  i: Integer;
begin
  Result := False;
  if not Assigned(OriginValue) then
      exit;
  if OriginValue.Count > 0 then
    begin
      for i := 0 to OriginValue.Count - 1 do
        begin
          if umlMultipleMatch(IgnoreCase, OriginValue[i], DestValue) then
            begin
              Result := True;
              exit;
            end;
        end;
    end;
end;

function umlStringsInExists(dest: TListPascalString; SText: TPascalString; IgnoreCase: Boolean): Boolean;
var
  i: Integer;
  ns: TPascalString;
begin
  Result := False;
  if IgnoreCase then
      ns := umlUpperCase(SText)
  else
      ns := SText;
  if Assigned(dest) then
    begin
      if dest.Count > 0 then
        begin
          for i := 0 to dest.Count - 1 do
            begin
              if ((not IgnoreCase) and (SText = dest[i])) or ((IgnoreCase) and (umlSameText(SText, dest[i]))) then
                begin
                  Result := True;
                  exit;
                end;
            end;
        end;
    end;
end;

function umlStringsInExists(dest: TCoreClassStrings; SText: TPascalString; IgnoreCase: Boolean): Boolean;
var
  i: Integer;
  ns: TPascalString;
begin
  Result := False;
  if IgnoreCase then
      ns := umlUpperCase(SText)
  else
      ns := SText;
  if Assigned(dest) then
    begin
      if dest.Count > 0 then
        begin
          for i := 0 to dest.Count - 1 do
            begin
              if ((not IgnoreCase) and (SText = dest[i])) or ((IgnoreCase) and (umlSameText(SText, dest[i]))) then
                begin
                  Result := True;
                  exit;
                end;
            end;
        end;
    end;
end;

function umlStringsInExists(dest: TCoreClassStrings; SText: TPascalString): Boolean;
begin
  Result := umlStringsInExists(dest, SText, True);
end;

function umlTextInStrings(const SText: TPascalString; dest: TListPascalString; IgnoreCase: Boolean): Boolean;
begin
  Result := umlStringsInExists(dest, SText, IgnoreCase);
end;

function umlTextInStrings(const SText: TPascalString; dest: TCoreClassStrings; IgnoreCase: Boolean): Boolean;
begin
  Result := umlStringsInExists(dest, SText, IgnoreCase);
end;

function umlTextInStrings(const SText: TPascalString; dest: TCoreClassStrings): Boolean;
begin
  Result := umlStringsInExists(dest, SText);
end;

function umlAddNewStrTo(SourceStr: TPascalString; dest: TListPascalString; IgnoreCase: Boolean): Boolean;
begin
  Result := not umlStringsInExists(dest, SourceStr, IgnoreCase);
  if Result then
      dest.Append(SourceStr.text);
end;

function umlAddNewStrTo(SourceStr: TPascalString; dest: TCoreClassStrings; IgnoreCase: Boolean): Boolean;
begin
  Result := not umlStringsInExists(dest, SourceStr, IgnoreCase);
  if Result then
      dest.Append(SourceStr.text);
end;

function umlAddNewStrTo(SourceStr: TPascalString; dest: TCoreClassStrings): Boolean;
begin
  Result := not umlStringsInExists(dest, SourceStr, True);
  if Result then
      dest.Append(SourceStr.text);
end;

function umlAddNewStrTo(SourceStr, dest: TCoreClassStrings): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to SourceStr.Count - 1 do
    if umlAddNewStrTo(SourceStr[i], dest) then
        inc(Result);
end;

function umlDeleteStrings(const SText: TPascalString; dest: TCoreClassStrings; IgnoreCase: Boolean): Integer;
var
  i: Integer;
begin
  Result := 0;
  if Assigned(dest) then
    begin
      if dest.Count > 0 then
        begin
          i := 0;
          while i < dest.Count do
            begin
              if ((not IgnoreCase) and (SText = dest[i])) or ((IgnoreCase) and (umlMultipleMatch(IgnoreCase, SText, dest[i]))) then
                begin
                  dest.Delete(i);
                  inc(Result);
                end
              else
                  inc(i);
            end;
        end;
    end;
end;

function umlDeleteStringsNot(const SText: TPascalString; dest: TCoreClassStrings; IgnoreCase: Boolean): Integer;
var
  i: Integer;
begin
  Result := 0;
  if Assigned(dest) then
    begin
      if dest.Count > 0 then
        begin
          i := 0;
          while i < dest.Count do
            begin
              if ((not IgnoreCase) and (SText <> dest[i])) or ((IgnoreCase) and (not umlMultipleMatch(IgnoreCase, SText, dest[i]))) then
                begin
                  dest.Delete(i);
                  inc(Result);
                end
              else
                  inc(i);
            end;
        end;
    end;
end;

function umlMergeStrings(Source, dest: TCoreClassStrings; IgnoreCase: Boolean): Integer;
var
  i: Integer;
begin
  Result := 0;
  if (Source = nil) or (dest = nil) then
      exit;
  if Source.Count > 0 then
    begin
      for i := 0 to Source.Count - 1 do
        begin
          umlAddNewStrTo(Source[i], dest, IgnoreCase);
          inc(Result);
        end;
    end;
end;

function umlMergeStrings(Source, dest: TListPascalString; IgnoreCase: Boolean): Integer;
var
  i: Integer;
begin
  Result := 0;
  if (Source = nil) or (dest = nil) then
      exit;
  if Source.Count > 0 then
    begin
      for i := 0 to Source.Count - 1 do
        begin
          umlAddNewStrTo(Source[i], dest, IgnoreCase);
          inc(Result);
        end;
    end;
end;

function umlConverStrToFileName(const Value: TPascalString): TPascalString;
var
  i: Integer;
begin
  Result := Value;
  for i := 1 to umlGetLength(Result) do
    begin
      if CharIn(Result[i], '":;/\|<>?*%') then
          Result[i] := ' ';
    end;
end;

function umlSplitTextMatch(const SText, Limit, MatchText: TPascalString; IgnoreCase: Boolean): Boolean;
var
  n, t: TPascalString;
begin
  Result := True;
  if MatchText = '' then
      exit;
  n := SText;
  //
  if umlExistsChar(n, Limit) then
    begin
      repeat
        t := umlGetFirstStr(n, Limit);
        if umlMultipleMatch(IgnoreCase, MatchText, t) then
            exit;
        n := umlDeleteFirstStr(n, Limit);
      until n = '';
    end
  else
    begin
      t := n;
      if umlMultipleMatch(IgnoreCase, MatchText, t) then
          exit;
    end;
  //
  Result := False;
end;

function umlSplitTextTrimSpaceMatch(const SText, Limit, MatchText: TPascalString; IgnoreCase: Boolean): Boolean;
var
  n, t: TPascalString;
begin
  Result := True;
  if MatchText = '' then
      exit;
  n := SText;

  if umlExistsChar(n, Limit) then
    begin
      repeat
        t := umlTrimSpace(umlGetFirstStr(n, Limit));
        if umlMultipleMatch(IgnoreCase, MatchText, t) then
            exit;
        n := umlDeleteFirstStr(n, Limit);
      until n = '';
    end
  else
    begin
      t := umlTrimSpace(n);
      if umlMultipleMatch(IgnoreCase, MatchText, t) then
          exit;
    end;

  Result := False;
end;

function umlSplitDeleteText(const SText, Limit, MatchText: TPascalString; IgnoreCase: Boolean): TPascalString;
var
  n, t: TPascalString;
begin
  if (MatchText = '') or (Limit = '') then
    begin
      Result := SText;
      exit;
    end;
  Result := '';
  n := SText;
  //
  if umlExistsChar(n, Limit) then
    begin
      repeat
        t := umlGetFirstStr(n, Limit);
        if not umlMultipleMatch(IgnoreCase, MatchText, t) then
          begin
            if Result <> '' then
                Result := Result + Limit[1] + t
            else
                Result := t;
          end;
        n := umlDeleteFirstStr(n, Limit);
      until n = '';
    end
  else
    begin
      t := n;
      if not umlMultipleMatch(IgnoreCase, MatchText, t) then
          Result := SText;
    end;
end;

function umlSplitTextAsList(const SText, Limit: TPascalString; AsLst: TCoreClassStrings): Boolean;
var
  n, t: TPascalString;
begin
  AsLst.Clear;
  n := SText;
  //
  if umlExistsChar(n, Limit) then
    begin
      repeat
        t := umlGetFirstStr(n, Limit);
        AsLst.Append(t.text);
        n := umlDeleteFirstStr(n, Limit);
      until n = '';
    end
  else
    begin
      t := n;
      if umlGetLength(t) > 0 then
          AsLst.Append(t.text);
    end;
  //
  Result := AsLst.Count > 0;
end;

function umlSplitTextAsListAndTrimSpace(const SText, Limit: TPascalString; AsLst: TCoreClassStrings): Boolean;
var
  n, t: TPascalString;
begin
  AsLst.Clear;
  n := SText;
  //
  if umlExistsChar(n, Limit) then
    begin
      repeat
        t := umlGetFirstStr(n, Limit);
        AsLst.Append(umlTrimSpace(t).text);
        n := umlDeleteFirstStr(n, Limit);
      until n = '';
    end
  else
    begin
      t := n;
      if umlGetLength(t) > 0 then
          AsLst.Append(umlTrimSpace(t).text);
    end;
  //
  Result := AsLst.Count > 0;
end;

function umlListAsSplitText(const List: TCoreClassStrings; Limit: TPascalString): TPascalString;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to List.Count - 1 do
    if Result = '' then
        Result := List[i]
    else
        Result := Result + Limit + List[i];
end;

function umlListAsSplitText(const List: TListPascalString; Limit: TPascalString): TPascalString;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to List.Count - 1 do
    if Result = '' then
        Result := List[i]
    else
        Result.Append(Limit + List[i]);
end;

function umlDivisionText(const buffer: TPascalString; width: Integer; DivisionAsPascalString: Boolean): TPascalString;
var
  i, n: Integer;
begin
  Result := '';
  n := 0;
  for i := 1 to buffer.Len do
    begin
      if (DivisionAsPascalString) and (n = 0) then
          Result.Append(#39);

      Result.Append(buffer[i]);
      inc(n);
      if n = width then
        begin
          if DivisionAsPascalString then
              Result.Append(#39 + '+' + #13#10)
          else
              Result.Append(#13#10);
          n := 0;
        end;
    end;
  if DivisionAsPascalString then
      Result.Append(#39);
end;

function umlUpdateComponentName(const Name: TPascalString): TPascalString;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to umlGetLength(name) do
    if umlGetLength(Result) > 0 then
      begin
        if CharIn(name[i], [c0to9, cLoAtoZ, cHiAtoZ], '-') then
            Result := Result + name[i];
      end
    else if CharIn(name[i], [cLoAtoZ, cHiAtoZ]) then
        Result := Result + name[i];
end;

function umlMakeComponentName(Owner: TCoreClassComponent; RefrenceName: TPascalString): TPascalString;
var
  c: Cardinal;
begin
  c := 1;
  RefrenceName := umlUpdateComponentName(RefrenceName);
  Result := RefrenceName;
  while Owner.FindComponent(Result.text) <> nil do
    begin
      Result := RefrenceName + IntToStr(c);
      inc(c);
    end;
end;

procedure umlReadComponent(stream: TCoreClassStream; comp: TCoreClassComponent);
var
  r: TCoreClassReader;
  needClearName: Boolean;
begin
  r := TCoreClassReader.Create(stream, 4096);
  r.IgnoreChildren := True;
  try
    needClearName := (comp.Name = '');
    r.ReadRootComponent(comp);
    if needClearName then
        comp.Name := '';
  except
  end;
  DisposeObject(r);
end;

procedure umlWriteComponent(stream: TCoreClassStream; comp: TCoreClassComponent);
var
  w: TCoreClassWriter;
begin
  w := TCoreClassWriter.Create(stream, 4096);
  w.IgnoreChildren := True;
  w.WriteDescendent(comp, nil);
  DisposeObject(w);
end;

procedure umlCopyComponentDataTo(comp, copyto: TCoreClassComponent);
var
  ms: TCoreClassMemoryStream;
begin
  if comp.ClassType <> copyto.ClassType then
      exit;
  ms := TCoreClassMemoryStream.Create;
  try
    umlWriteComponent(ms, comp);
    ms.Position := 0;
    umlReadComponent(ms, copyto);
  except
  end;
  DisposeObject(ms);
end;

function umlProcessCycleValue(CurrentVal, DeltaVal, StartVal, OverVal: Single; var EndFlag: Boolean): Single;
  function IfOut(Cur, Delta, dest: Single): Boolean;
  begin
    if Cur > dest then
        Result := Cur - Delta < dest
    else
        Result := Cur + Delta > dest;
  end;

  function GetOutValue(Cur, Delta, dest: Single): Single;
  begin
    if IfOut(Cur, Delta, dest) then
      begin
        if Cur > dest then
            Result := dest - (Cur - Delta)
        else
            Result := Cur + Delta - dest;
      end
    else
        Result := 0;
  end;

  function GetDeltaValue(Cur, Delta, dest: Single): Single;
  begin
    if Cur > dest then
        Result := Cur - Delta
    else
        Result := Cur + Delta;
  end;

begin
  if (DeltaVal > 0) and (StartVal <> OverVal) then
    begin
      if EndFlag then
        begin
          if IfOut(CurrentVal, DeltaVal, OverVal) then
            begin
              EndFlag := False;
              Result := umlProcessCycleValue(OverVal, GetOutValue(CurrentVal, DeltaVal, OverVal), StartVal, OverVal, EndFlag);
            end
          else
              Result := GetDeltaValue(CurrentVal, DeltaVal, OverVal);
        end
      else
        begin
          if IfOut(CurrentVal, DeltaVal, StartVal) then
            begin
              EndFlag := True;
              Result := umlProcessCycleValue(StartVal, GetOutValue(CurrentVal, DeltaVal, StartVal), StartVal, OverVal, EndFlag);
            end
          else
              Result := GetDeltaValue(CurrentVal, DeltaVal, StartVal);
        end
    end
  else
      Result := CurrentVal;
end;

procedure ImportCSV_C(const sour: TArrayPascalString; OnNotify: TCSVSaveCall);
var
  i, j, bp, hc: NativeInt;
  n: TPascalString;
  king, buff: TArrayPascalString;
begin
  // csv head
  bp := -1;
  for i := low(sour) to high(sour) do
    begin
      n := sour[i];
      if n.Len <> 0 then
        begin
          bp := i + 1;
          hc := n.GetCharCount(',') + 1;
          SetLength(buff, hc);
          SetLength(king, hc);

          for j := low(king) to high(king) do
              king[j] := '';
          j := 0;
          while (j < length(king)) and (n.Len > 0) do
            begin
              king[j] := umlGetFirstStr_Discontinuity(n, ',');
              n := umlDeleteFirstStr_Discontinuity(n, ',');
              inc(j);
            end;

          break;
        end;
    end;

  // csv body
  if bp > 0 then
    for i := bp to high(sour) do
      begin
        n := sour[i];
        if n.Len > 0 then
          begin
            for j := low(buff) to high(buff) do
                buff[j] := '';
            j := 0;
            while (j < length(buff)) and (n.Len > 0) do
              begin
                buff[j] := umlGetFirstStr_Discontinuity(n, ',');
                n := umlDeleteFirstStr_Discontinuity(n, ',');
                inc(j);
              end;
            OnNotify(sour[i], king, buff);
          end;
      end;

  SetLength(buff, 0);
  SetLength(king, 0);
  n := '';
end;

procedure CustomImportCSV_C(const OnGetLine: TCSVGetLineCall; OnNotify: TCSVSaveCall);
var
  IsEnd: Boolean;
  i, j, hc: NativeInt;
  n, s: TPascalString;
  king, buff: TArrayPascalString;
begin
  // csv head
  while True do
    begin
      IsEnd := False;
      n := '';
      OnGetLine(n, IsEnd);
      if IsEnd then
          exit;
      if n.L <> 0 then
        begin
          hc := n.GetCharCount(',') + 1;
          SetLength(buff, hc);
          SetLength(king, hc);

          for j := low(king) to high(king) do
              king[j] := '';
          j := 0;
          while (j < length(king)) and (n.Len > 0) do
            begin
              king[j] := umlGetFirstStr_Discontinuity(n, ',');
              n := umlDeleteFirstStr_Discontinuity(n, ',');
              inc(j);
            end;

          break;
        end;
    end;

  // csv body
  while True do
    begin
      IsEnd := False;
      n := '';
      OnGetLine(n, IsEnd);
      if IsEnd then
          exit;
      if n.Len > 0 then
        begin
          s := n;
          for j := low(buff) to high(buff) do
              buff[j] := '';
          j := 0;
          while (j < length(buff)) and (n.Len > 0) do
            begin
              buff[j] := umlGetFirstStr_Discontinuity(n, ',');
              n := umlDeleteFirstStr_Discontinuity(n, ',');
              inc(j);
            end;
          OnNotify(s, king, buff);
        end;
    end;

  SetLength(buff, 0);
  SetLength(king, 0);
  n := '';
end;

procedure ImportCSV_M(const sour: TArrayPascalString; OnNotify: TCSVSaveMethod);
var
  i, j, bp, hc: NativeInt;
  n: TPascalString;
  king, buff: TArrayPascalString;
begin
  // csv head
  bp := -1;
  for i := low(sour) to high(sour) do
    begin
      n := sour[i];
      if n.Len <> 0 then
        begin
          bp := i + 1;
          hc := n.GetCharCount(',') + 1;
          SetLength(buff, hc);
          SetLength(king, hc);

          for j := low(king) to high(king) do
              king[j] := '';
          j := 0;
          while (j < length(king)) and (n.Len > 0) do
            begin
              king[j] := umlGetFirstStr_Discontinuity(n, ',');
              n := umlDeleteFirstStr_Discontinuity(n, ',');
              inc(j);
            end;

          break;
        end;
    end;

  // csv body
  if bp > 0 then
    for i := bp to high(sour) do
      begin
        n := sour[i];
        if n.Len > 0 then
          begin
            for j := low(buff) to high(buff) do
                buff[j] := '';
            j := 0;
            while (j < length(buff)) and (n.Len > 0) do
              begin
                buff[j] := umlGetFirstStr_Discontinuity(n, ',');
                n := umlDeleteFirstStr_Discontinuity(n, ',');
                inc(j);
              end;
            OnNotify(sour[i], king, buff);
          end;
      end;

  SetLength(buff, 0);
  SetLength(king, 0);
  n := '';
end;

procedure CustomImportCSV_M(const OnGetLine: TCSVGetLineMethod; OnNotify: TCSVSaveMethod);
var
  IsEnd: Boolean;
  i, j, hc: NativeInt;
  n, s: TPascalString;
  king, buff: TArrayPascalString;
begin
  // csv head
  while True do
    begin
      IsEnd := False;
      n := '';
      OnGetLine(n, IsEnd);
      if IsEnd then
          exit;
      if n.L <> 0 then
        begin
          hc := n.GetCharCount(',') + 1;
          SetLength(buff, hc);
          SetLength(king, hc);

          for j := low(king) to high(king) do
              king[j] := '';
          j := 0;
          while (j < length(king)) and (n.Len > 0) do
            begin
              king[j] := umlGetFirstStr_Discontinuity(n, ',');
              n := umlDeleteFirstStr_Discontinuity(n, ',');
              inc(j);
            end;

          break;
        end;
    end;

  // csv body
  while True do
    begin
      IsEnd := False;
      n := '';
      OnGetLine(n, IsEnd);
      if IsEnd then
          exit;
      if n.Len > 0 then
        begin
          s := n;
          for j := low(buff) to high(buff) do
              buff[j] := '';
          j := 0;
          while (j < length(buff)) and (n.Len > 0) do
            begin
              buff[j] := umlGetFirstStr_Discontinuity(n, ',');
              n := umlDeleteFirstStr_Discontinuity(n, ',');
              inc(j);
            end;
          OnNotify(s, king, buff);
        end;
    end;

  SetLength(buff, 0);
  SetLength(king, 0);
  n := '';
end;

procedure ImportCSV_P(const sour: TArrayPascalString; OnNotify: TCSVSaveProc);
var
  i, j, bp, hc: NativeInt;
  n: TPascalString;
  king, buff: TArrayPascalString;
begin
  // csv head
  bp := -1;
  for i := low(sour) to high(sour) do
    begin
      n := sour[i];
      if n.Len <> 0 then
        begin
          bp := i + 1;
          hc := n.GetCharCount(',') + 1;
          SetLength(buff, hc);
          SetLength(king, hc);

          for j := low(king) to high(king) do
              king[j] := '';
          j := 0;
          while (j < length(king)) and (n.Len > 0) do
            begin
              king[j] := umlGetFirstStr_Discontinuity(n, ',');
              n := umlDeleteFirstStr_Discontinuity(n, ',');
              inc(j);
            end;

          break;
        end;
    end;

  // csv body
  if bp > 0 then
    for i := bp to high(sour) do
      begin
        n := sour[i];
        if n.Len > 0 then
          begin
            for j := low(buff) to high(buff) do
                buff[j] := '';
            j := 0;
            while (j < length(buff)) and (n.Len > 0) do
              begin
                buff[j] := umlGetFirstStr_Discontinuity(n, ',');
                n := umlDeleteFirstStr_Discontinuity(n, ',');
                inc(j);
              end;
            OnNotify(sour[i], king, buff);
          end;
      end;

  SetLength(buff, 0);
  SetLength(king, 0);
  n := '';
end;

procedure CustomImportCSV_P(const OnGetLine: TCSVGetLineProc; OnNotify: TCSVSaveProc);
var
  IsEnd: Boolean;
  i, j, hc: NativeInt;
  n, s: TPascalString;
  king, buff: TArrayPascalString;
begin
  // csv head
  while True do
    begin
      IsEnd := False;
      n := '';
      OnGetLine(n, IsEnd);
      if IsEnd then
          exit;
      if n.L <> 0 then
        begin
          hc := n.GetCharCount(',') + 1;
          SetLength(buff, hc);
          SetLength(king, hc);

          for j := low(king) to high(king) do
              king[j] := '';
          j := 0;
          while (j < length(king)) and (n.Len > 0) do
            begin
              king[j] := umlGetFirstStr_Discontinuity(n, ',');
              n := umlDeleteFirstStr_Discontinuity(n, ',');
              inc(j);
            end;

          break;
        end;
    end;

  // csv body
  while True do
    begin
      IsEnd := False;
      n := '';
      OnGetLine(n, IsEnd);
      if IsEnd then
          exit;
      if n.Len > 0 then
        begin
          s := n;
          for j := low(buff) to high(buff) do
              buff[j] := '';
          j := 0;
          while (j < length(buff)) and (n.Len > 0) do
            begin
              buff[j] := umlGetFirstStr_Discontinuity(n, ',');
              n := umlDeleteFirstStr_Discontinuity(n, ',');
              inc(j);
            end;
          OnNotify(s, king, buff);
        end;
    end;

  SetLength(buff, 0);
  SetLength(king, 0);
  n := '';
end;

var
  ExLibs: THashVariantList = nil;

function GetExtLib(LibName: SystemString): HMODULE;
begin
  Result := 0;
{$IF not(Defined(IOS) and Defined(CPUARM))}
  if ExLibs = nil then
      ExLibs := THashVariantList.Create;
  if not ExLibs.Exists(LibName) then
    begin
      try
{$IFNDEF FPC}
{$IFDEF ANDROID}
        Result := LoadLibrary(PChar(umlCombineFileName(System.IOUtils.TPath.GetLibraryPath, LibName).text));
{$ELSE ANDROID}
        Result := LoadLibrary(PChar(LibName));
{$ENDIF ANDROID}
{$ELSE FPC}
        Result := LoadLibrary(PChar(LibName));
{$ENDIF FPC}
        ExLibs.Add(LibName, Result);
      except
        FreeExtLib(LibName);
        Result := 0;
      end;
    end
  else
      Result := ExLibs[LibName];
{$IFEND}
end;

function FreeExtLib(LibName: SystemString): Boolean;
begin
  Result := False;
{$IF not(Defined(IOS) and Defined(CPUARM))}
  if ExLibs = nil then
      ExLibs := THashVariantList.Create;
  if ExLibs.Exists(LibName) then
    begin
      try
          FreeLibrary(HMODULE(ExLibs[LibName]));
      except
      end;
      ExLibs.Delete(LibName);
      Result := True;
    end;
{$IFEND}
end;

function GetExtProc(const LibName, ProcName: SystemString): Pointer;
{$IF not(Defined(IOS) and Defined(CPUARM))}
var
  h: HMODULE;
{$IFEND}
begin
  Result := nil;
{$IF not(Defined(IOS) and Defined(CPUARM))}
  h := GetExtLib(LibName);
  if h <> 0 then
    begin
      Result := GetProcAddress(h, PChar(ProcName));
      if Result = nil then
          DoStatus('error external libray: %s - %s', [LibName, ProcName]);
    end;
{$IFEND}
end;

{$IFDEF RangeCheck}{$R-}{$ENDIF}


function umlCompareByteString(const s1: TPascalString; const s2: PArrayRawByte): Boolean;
var
  tmp: TBytes;
  i: Integer;
begin
  SetLength(tmp, s1.L);
  for i := 0 to s1.L - 1 do
      tmp[i] := Byte(s1.buff[i]);

  Result := CompareMemory(@tmp[0], @s2^[0], s1.L);
end;

function umlCompareByteString(const s2: PArrayRawByte; const s1: TPascalString): Boolean;
var
  tmp: TBytes;
  i: Integer;
begin
  SetLength(tmp, s1.L);
  for i := 0 to s1.L - 1 do
      tmp[i] := Byte(s1.buff[i]);

  Result := CompareMemory(@tmp[0], @s2^[0], s1.L);
end;

procedure umlSetByteString(const sour: TPascalString; const dest: PArrayRawByte);
var
  i: Integer;
begin
  for i := 0 to sour.L - 1 do
      dest^[i] := Byte(sour.buff[i]);
end;

procedure umlSetByteString(const dest: PArrayRawByte; const sour: TPascalString);
var
  i: Integer;
begin
  for i := 0 to sour.L - 1 do
      dest^[i] := Byte(sour.buff[i]);
end;

function umlGetByteString(const sour: PArrayRawByte; const L: Integer): TPascalString;
var
  i: Integer;
begin
  Result.L := L;
  for i := 0 to L - 1 do
      Result.buff[i] := SystemChar(sour^[i]);
end;

{$IFDEF RangeCheck}{$R+}{$ENDIF}


procedure SaveMemory(p: Pointer; siz: NativeInt; DestFile: TPascalString);
var
  m64: TMem64;
begin
  m64 := TMem64.Create;
  m64.SetPointerWithProtectedMode(p, siz);
  m64.SaveToFile(DestFile);
  DisposeObject(m64);
end;

type
  TFileMD5_CacheData = record
    Time_: TDateTime;
    Size_: Int64;
    md5: TMD5;
  end;

  PFileMD5_CacheData = ^TFileMD5_CacheData;

  TFileMD5Cache = class
  private
    Critical: TCritical;
    FHash: THashList;
    procedure DoDataFreeProc(p: Pointer);
    function DoGetFileMD5(FileName: U_String): TMD5;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
  end;

var
  FileMD5Cache: TFileMD5Cache = nil;

procedure TFileMD5Cache.DoDataFreeProc(p: Pointer);
begin
  Dispose(PFileMD5_CacheData(p));
end;

function TFileMD5Cache.DoGetFileMD5(FileName: U_String): TMD5;
var
  p: PFileMD5_CacheData;
  ft: TDateTime;
  fs: Int64;
begin
  if not umlFileExists(FileName) then
    begin
      Critical.Lock;
      FHash.Delete(FileName);
      Critical.UnLock;
      Result := NullMD5;
      exit;
    end;

  ft := umlGetFileTime(FileName);
  fs := umlGetFileSize(FileName);
  Critical.Lock;
  p := FHash[FileName];
  if p = nil then
    begin
      new(p);
      p^.Time_ := ft;
      p^.Size_ := fs;
      p^.md5 := umlFileMD5___(FileName);
      FHash.Add(FileName, p, False);
      Result := p^.md5;
    end
  else
    begin
      if (ft <> p^.Time_) or (fs <> p^.Size_) then
        begin
          p^.Time_ := ft;
          p^.Size_ := fs;
          p^.md5 := umlFileMD5___(FileName);
        end;
      Result := p^.md5;
    end;
  Critical.UnLock;
end;

constructor TFileMD5Cache.Create;
begin
  inherited Create;
  FHash := THashList.CustomCreate($FFFF);
  FHash.OnFreePtr := {$IFDEF FPC}@{$ENDIF FPC}DoDataFreeProc;
  FHash.IgnoreCase := True;
  FHash.AccessOptimization := True;
  Critical := TCritical.Create;
end;

destructor TFileMD5Cache.Destroy;
begin
  DisposeObject(Critical);
  DisposeObject(FHash);
  inherited Destroy;
end;

procedure TFileMD5Cache.Clear;
begin
  FHash.Clear;
end;

function umlFileMD5(FileName: TPascalString): TMD5;
begin
  Result := FileMD5Cache.DoGetFileMD5(FileName);
end;

procedure umlCacheFileMD5(FileName: U_String);
begin
  FileMD5Cache.DoGetFileMD5(FileName);
end;

type
  TCacheFileMD5FromDirectoryData_ = record
    Directory_, Filter_: U_String;
  end;

  PCacheFileMD5FromDirectoryData_ = ^TCacheFileMD5FromDirectoryData_;

var
  CacheThreadIsAcivted: Boolean = True;
  CacheFileMD5FromDirectory_Num: Integer = 0;

procedure DoCacheFileMD5FromDirectory(thSender: TCompute);
var
  p: PCacheFileMD5FromDirectoryData_;
  arry: U_StringArray;
  n: U_SystemString;
begin
  p := thSender.UserData;
  try
    arry := umlGetFileListWithFullPath(p^.Directory_);
    for n in arry do
      begin
        if umlMultipleMatch(p^.Filter_, umlGetFileName(n)) then
          if umlFileExists(n) then
              umlCacheFileMD5(n);
        if not CacheThreadIsAcivted then
            break;
      end;
    SetLength(arry, 0);
  except
  end;
  p^.Directory_ := '';
  p^.Filter_ := '';
  Dispose(p);
  AtomDec(CacheFileMD5FromDirectory_Num);
end;

procedure umlCacheFileMD5FromDirectory(Directory_, Filter_: U_String);
var
  p: PCacheFileMD5FromDirectoryData_;
begin
  AtomInc(CacheFileMD5FromDirectory_Num);
  new(p);
  p^.Directory_ := Directory_;
  p^.Filter_ := Filter_;
  TCompute.RunC(p, nil, {$IFDEF FPC}@{$ENDIF FPC}DoCacheFileMD5FromDirectory);
end;

function umlBinToInt(Value: U_String): UInt64;
var
  i, Size: Integer;
begin
  Result := 0;
  Size := Value.L;
  for i := Size downto 1 do
    begin
      if Value[i] = '1' then
          Result := Result + (1 shl (Size - i));
    end;
end;

function umlIntToBin(v: UInt64): U_String;
begin
  if v = 0 then
    begin
      Result := '0';
      exit;
    end;
  Result := '';
  while v > 0 do
    begin
      if v and $1 = 1 then
          Result := '1' + Result
      else
          Result := '0' + Result;
      v := v shr 1;
    end;
  while Result.First = '0' do
      Result.DeleteFirst;
end;

initialization

FileMD5Cache := TFileMD5Cache.Create;
CacheFileMD5FromDirectory_Num := 0;
CacheThreadIsAcivted := True;

Lib_DateTimeFormatSettings := FormatSettings;
Lib_DateTimeFormatSettings.ShortDateFormat := 'yyyy-MM-dd';
Lib_DateTimeFormatSettings.DateSeparator := '-';
Lib_DateTimeFormatSettings.TimeSeparator := ':';
Lib_DateTimeFormatSettings.LongTimeFormat := 'hh:mm:ss:zzz';

finalization

CacheThreadIsAcivted := False;
while CacheFileMD5FromDirectory_Num > 0 do
    TCompute.Sleep(1);

if ExLibs <> nil then
    DisposeObject(ExLibs);
DisposeObject(FileMD5Cache);

end.
