RnQ/for.RnQ/RTL/RDUtils.pas

{
  This file is part of R&Q.
  Under same license
}
unit RDUtils;
{$I ForRnQConfig.inc}
{$I NoRTTI.inc}

interface

uses
  Winapi.Windows, System.SysUtils, System.WideStrUtils, System.Classes, System.Types, Vcl.Graphics, RDGlobal;

type
  THelpers = class
    class function IfThen(AValue: Boolean; TrueVal, FalseVal: T): T;
  end;

function IfThen(AValue: Boolean; const ATrue: Integer; const AFalse: Integer = 0): Integer; overload; inline

function packArray(a: array of Integer; zero: Integer): TintegerDynArray;
function compareInt(a, b: Integer): Smallint; OverLoad;
function compareInt(a, b: int64): Smallint; OverLoad;
function CompareDate(a, b: TDateTime): Smallint;
function boundInt(var i: Integer; min, max: Integer): Integer;
function bound(i: Integer; min, max: Integer): Integer;
function within(pt: Tpoint; x, y, w, h: Integer): Boolean; overload; inline;
function within(a, b, c: Integer): Boolean; overload; inline;
function DestRect(const W, H, cw, ch: Integer): TGPRect; overload;
function DestRect(const PicSize, DestSize: TGPSize): TGPRect; overload;
function BoundsSize(srcSize, maxSize: TSize): TSize; overload;
function BoundsSize(srcCX, srcCY, maxCX, maxCY: Longint): TSize; overload;
// strings
function isURL(const s: string; ofs: Integer = 1): Boolean;
function ipos(const ss: string; const s: string): Integer;
function capitalize(const s: string): string;
procedure convertAllNewlinesToCRLF(var s: string);
function template(const src: string; table: array of string): string;
// function  TLV(code:integer; data:string):string;
function newline2slashn(s: string): string;
function ExcludeTrailingCRLF(const s: String): String;
function DupAmpersand(const s: String): String;
function onlyDigits(const s: string): string; overload;
function matches(const s: string; from: Integer; const sub: string): Boolean; inline;

function matchesA(const s: RawByteString; from: Integer; const sub: RawByteString): Boolean; inline;
function Imatches(const s: string; from: Integer; const sub: string): Boolean;
function dupString(const s: RawByteString): RawByteString; overload; inline;
function dupString(const s: String): String; overload; inline;

function trailing(const s, ss: string): Boolean;
procedure swap4(var a, b: Integer); overload;
procedure swap4(var a, b: TDateTime); overload;
procedure swap4(var src, dest; count: dword; cond: Boolean); overload;
// Convert
function qword_BE2verU(d: UInt64): String;
function qword_LE2verU(d: UInt64): String;
function bool2str(const b: Boolean): RawByteString;
function ABCD_ADCB(d: dword): dword; assembler;
function str2color(const s: AnsiString): Tcolor;
function color2str(color: Tcolor): AnsiString;
function Color2HTML(Color: TColor): String;
function IntToStr(i, d: Integer): string; overload;

// Strings
function old_UnUTF(const s: RawByteString): String;
function IsUTF(const s: RawByteString): Boolean;
function UTF(const s: String): RawByteString;
function UnUTF(const s: RawByteString): String; overload;
function UnUTF(const s: String): String; overload;
function WideBEToStr(const Value: RawByteString): String;
function StrToUnicode(const Value: String): RawByteString; overload;
{$IFDEF UNICODE} {$IF CompilerVersion >= 24}
function RnQEndsText(const ASubText, AText: UnicodeString): Boolean;
{$ELSE}
function RnQEndsText(const ASubText, AText: UnicodeString): Boolean; inline;
{$IFEND ver} {$ENDIF UNICODE}

function TBytesToString(B: TBytes; CodePage: Integer = CP_UTF8): string;
function StringToTBytes(const S: string; CodePage: Integer = CP_UTF8): TBytes;
procedure SaveBytesToFile(const Data: TBytes; const FileName: string);

// strings
function findInStrings(const s: String; var ss: String; const separator: String): Integer; overload;
function findInStrings(const s: String; ss: Tstrings): Integer; overload;

function chop(i: Integer; var s: RawByteString): RawByteString; overload; inline;
function chop(i, l: Integer; var s: RawByteString): RawByteString; overload;
function chop(const ss: RawByteString; var s: RawByteString): RawByteString; overload;
function chopline(var s: RawByteString): RawByteString; overload;
function choplineV(const s: RawByteString; var pos0: Integer): RawByteString; overload;

{$IFDEF UNICODE}
function chop(const ss: String; var s: String): String; overload;
function chop(i, l: Integer; var s: String): String; overload;
function chop(i: Integer; var s: String): String; overload;
function chopline(var s: String): String; overload;
function choplineV(const s: String; var pos0: Integer): String; overload;
{$ENDIF UNICODE}
{$IFDEF UNICODE}
function isOnlyDigits(const s: AnsiString): Boolean; overload;
function isOnlyDigits(const s: String): Boolean; overload;
{$ELSE ~UNICODE}
function isOnlyDigits(const s: AnsiString): Boolean;
{$ENDIF UNICODE}
// function  UnDelimiter(s : String) :String;
function BetterStr(const s: String): String;

// convert
function str2valor(const s: AnsiString): int64;
function hex2Str(const s: RawByteString): RawByteString;
function hex2StrSafe(const s: RawByteString): RawByteString;

function hex2StrU(const s: String): RawByteString;

function PacketToHex(Buffer: Pointer; BufLen: Word): AnsiString;
function hexDump(const data: RawByteString): AnsiString;
function hexDumpS(const data: RawByteString): String;

function str2hex(const s: RawByteString): AnsiString; overload;
function str2hexU(const s: RawByteString): String; overload;
function str2hex(const s: RawByteString; const Delim: AnsiChar): AnsiString; overload;
function str2fontstyle(const s: AnsiString): Tfontstyles;
function fontstyle2str(fs: Tfontstyles): AnsiString;
function hexToInt(const s: RawByteString): Cardinal;
function strings2str(const split: string; ss: Tstrings): string; overload;
function strings2str(const split: string; const ss: array of string): string; overload;
procedure str2strings(const split: String; src: string; var ss: Tstrings); deprecated;
function size2str(sz: int64): String;

// function  bmp2wbmp(bmp : TBitmap) : String;
// procedure wbmp2bmp(Stream: TStream; var pic : TBitmap);
// procedure wbmp2bmp(s: String; pic : TBitmap);

function Rgb2Gray(RGBColor: Tcolor): byte;

function DoubleAsInt64(Value: double): int64;
function Int64AsDouble(Value: int64): double;
function TryStrToLongWord(const S: string; var Value: LongWord): Boolean;

function Hex2String(const Buffer: String): RawByteString;
function String2Hex(const Buffer: RawByteString): String;

var
  RnQDefaultSystemCodePage: Integer;

implementation

uses
{$IFDEF UNICODE}
  System.Character,
{$ENDIF UNICODE}
  System.StrUtils, System.Math, System.NetEncoding;

class function THelpers.IfThen(AValue: Boolean; TrueVal, FalseVal: T): T;
begin
  if AValue then
    Result := TrueVal
  else
    Result := FalseVal
end;

function IfThen(AValue: Boolean; const ATrue: Integer; const AFalse: Integer = 0): Integer; inline;
begin
  Result := THelpers.IfThen(AValue, ATrue, AFalse);
end;

function packArray(a: array of Integer; zero: Integer): TintegerDynArray;
var
  i, n: Integer;
begin
  n := 0;
  setlength(result, length(a));
  for i := 0 to length(a) - 1 do
    if a[i] <> zero then
    begin
      result[n] := a[i];
      inc(n);
    end;
  setlength(result, n);
end; // packArray

function compareInt(a, b: Integer): Smallint;
begin
  if a < b then
    result := -1
  else if a > b then
    result := +1
  else
    result := 0
end; // compareInt

function compareInt(a, b: int64): Smallint;
begin
  if a < b then
    result := -1
  else if a > b then
    result := +1
  else
    result := 0
end; // compareInt

function CompareDate(a, b: TDateTime): Smallint;
begin
  if a < b then
    result := -1
  else if a > b then
    result := +1
  else
    result := 0
end;

function boundInt(var i: Integer; min, max: Integer): Integer;
begin
  if i > max then
    i := max;
  if i < min then
    i := min;
  result := i;
end; // boundInt

function bound(i: Integer; min, max: Integer): Integer;
begin
  if i > max then
    result := max
  else if i < min then
    result := min
  else
    result := i;
end; // boundInt

function within(a, b, c: Integer): Boolean; overload; inline;
begin
  result := (b >= a) and (b <= c)
end;

function within(pt: Tpoint; x, y, w, h: Integer): Boolean; overload; inline;
begin
  result := (pt.x >= x) and (pt.y >= y) and (pt.x < x + w) and (pt.y < y + h)
end;

function BoundsSize(srcCX, srcCY, maxCX, maxCY: Longint): TSize;
begin
  if (srcCX > maxCX) or (srcCY > maxCY) then
  begin
    if srcCX * maxCY < srcCY * maxCX then
    begin
      result.cx := maxCY * srcCX div srcCY;
      // Result.cx := MulDiv(maxCY, srcCX, srcCY);
      result.cy := maxCY;
    end
    else
    begin
      result.cx := maxCX;
      result.cy := maxCX * srcCY div srcCX;
      // Result.cy := MulDiv(maxCX, srcCY, srcCX);
    end;
  end
  else
  begin
    result.cx := srcCX;
    result.cy := srcCY;
  end;
end;

function BoundsSize(srcSize, maxSize: TSize): TSize;
begin
  if (srcSize.cx > maxSize.cx) or (srcSize.cy > maxSize.cy) then
  begin
    if srcSize.cx * maxSize.cy < srcSize.cy * maxSize.cx then
    begin
      result.cx := maxSize.cy * srcSize.cx div srcSize.cy;
      // Result.cx := MulDiv(maxSize.cy, srcSize.cx, srcSize.cy);
      result.cy := maxSize.cy;
    end
    else
    begin
      result.cx := maxSize.cx;
      result.cy := maxSize.cx * srcSize.cy div srcSize.cx;
    end;
  end
  else
    result := srcSize;
end;

{ function DestRect(W, H, cw, ch :Integer): TRect;
  const
  Stretch = false;
  Proportional = True;
  Center  = True;
  var
  //  w, h, cw, ch: Integer;
  xyaspect: Double;
  begin
  //  w := Picture.GetWidth;
  //  h := Picture.GetHeight;
  //  cw := ClientWidth;
  //  ch := ClientHeight;
  if Stretch or (Proportional and ((w > cw) or (h > ch))) then
  begin
  if Proportional and (w > 0) and (h > 0) then
  begin
  xyaspect := w / h;
  if w > h then
  begin
  w := cw;
  h := Trunc(cw / xyaspect);
  if h > ch then  // woops, too big
  begin
  h := ch;
  w := Trunc(ch * xyaspect);
  end;
  end
  else
  begin
  h := ch;
  w := Trunc(ch * xyaspect);
  if w > cw then  // woops, too big
  begin
  w := cw;
  h := Trunc(cw / xyaspect);
  end;
  end;
  end
  else
  begin
  w := cw;
  h := ch;
  end;
  end;

  with Result do
  begin
  Left := 0;
  Top := 0;
  Right := w;
  Bottom := h;
  end;

  if Center then
  OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
  end; }

function DestRect(const W, H, cw, ch: Integer): TGPRect;
const Stretch = false; Proportional = True; Center = True;
var
  // w, h, cw, ch: Integer;
    xyaspect: Double;
  // i, j : Integer;
begin
  // w := Picture.GetWidth;
  // h := Picture.GetHeight;
  // cw := ClientWidth;
  // ch := ClientHeight;
  with result do
  begin
    // X := 0;
    // Y := 0;
    Width := min(cw, W);
    Height := min(ch, H);
  end;

  if Stretch or (Proportional and ((W > cw) or (H > ch))) then
  begin
    if Proportional and (W > 0) and (H > 0) then
    begin
      xyaspect := W / H;
      if W > H then
      begin
        // w := cw;
        // Result.Width := cw;
        result.Height := Trunc(cw / xyaspect);
        if result.Height > ch then // woops, too big
        begin
          result.Height := ch;
          result.Width := Trunc(ch * xyaspect);
        end;
      end
      else
      begin
        // h := ch;
        result.Width := Trunc(ch * xyaspect);
        if result.Width > cw then // woops, too big
        begin
          result.Width := cw;
          result.Height := Trunc(cw / xyaspect);
        end;
      end;
    end
    { else
      begin
      w := cw;
      h := ch;
      end; }
  end;

  if Center then
  begin
    // OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
    // inc(Result.X, (cw - w) div 2);
    // inc(Result.Y, (ch - h) div 2);
    result.x := (cw - result.Width) div 2;
    result.y := (ch - result.Height) div 2;
  end;
end;

function DestRect(const PicSize, DestSize: TGPSize): TGPRect;
const Stretch = false; Proportional = True; Center = True;
var
  // w, h, cw, ch: Integer;
    xyaspect: Double;
begin
  // w := Picture.GetWidth;
  // h := Picture.GetHeight;
  // cw := ClientWidth;
  // ch := ClientHeight;
  // Result.size := DestSize;
  with result do
  begin
    // X := 0;
    // Y := 0;
    Width := min(DestSize.Width, PicSize.Width);
    Height := min(DestSize.Height, PicSize.Height);
    Width := max(Width, 0);
    Height := max(Height, 0);
  end;
  if Stretch or (Proportional and ((PicSize.Width > DestSize.Width) or
    (PicSize.Height > DestSize.Height))) then
  begin
    if Proportional and (PicSize.Width > 0) and (PicSize.Height > 0) then
    begin
      xyaspect := PicSize.Width / PicSize.Height;
      if PicSize.Width > PicSize.Height then
      begin
        // Result.Width := DestSize.Width;
        result.Height := Trunc(DestSize.Width / xyaspect);
        if result.Height > DestSize.Height then // woops, too big
        begin
          result.Height := DestSize.Height;
          result.Width := Trunc(DestSize.Height * xyaspect);
        end;
      end
      else
      begin
        // Result.Height := DestSize.Height;
        result.Width := Trunc(DestSize.Height * xyaspect);
        if result.Width > DestSize.Width then // woops, too big
        begin
          result.Width := DestSize.Width;
          result.Height := Trunc(DestSize.Width / xyaspect);
        end;
      end;
    end
    { else
      begin
      Result.Width := DestSize.Width;
      Result.Height := DestSize.Height;
      end; }
  end;
  {
    with Result do
    begin
    X := 0;
    Y := 0;
    Width := w;
    Height := h;
    end;
  }
  if Center then
  begin
    // OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
    // inc(Result.X, (DestSize.Width - Result.Width) div 2);
    // inc(Result.Y, (DestSize.Height - Result.Height) div 2);
    result.x := (DestSize.Width - result.Width) div 2;
    result.y := (DestSize.Height - result.Height) div 2;
  end
  else
  begin
    result.x := 0;
    result.y := 0;
  end
end;

function isURL(const s: string; ofs: Integer = 1): Boolean;
begin
{$IFDEF UNICODE}
  while (Integer(s[ofs]) <= $7F) and (((s[ofs] >= '0') and (s[ofs] <= '9')) or s[ofs].IsLetter()) do
{$ELSE nonUNICODE}
  while s[ofs] in ['0' .. '9', 'a' .. 'z', 'A' .. 'Z'] do
{$ENDIF UNICODE}
    inc(ofs);
  result := copy(s, ofs, 3) = '://';
end; // isURL

function ipos(const ss: string; const s: string): Integer;
begin
  for result := 1 to length(s) do
    if ansiCompareText(ss, copy(s, result, length(ss))) = 0 then
      exit;
  result := 0;
end; // ipos

function capitalize(const s: string): string;
begin
  result := s;
  if result > '' then
    result[1] := ansiuppercase(result[1])[1];
end; // capitalize

procedure convertAllNewlinesToCRLF(var s: string);
begin
  s := AdjustLineBreaks(s, tlbsCRLF);
end; // convertAllNewlinesToCRLF

function template(const src: string; table: array of string): string;
var
  i: Integer;
begin
  result := src;
  i := 0;
  while i < length(table) do
  begin
    // result := ReplaceText(result, table[i], table[i+1]);
    result := ReplaceStr(result, table[i], table[i + 1]);
    inc(i, 2);
  end;
end; // template

function newline2slashn(s: string): string;
var
  i: Integer;
begin
  repeat
    i := pos(#13, s);
    if i > 0 then
    begin
      s[i] := '\';
      if (i >= length(s)) or (s[i + 1] <> #10) then
        insert('n', s, i)
      else
        s[i + 1] := 'n';
    end;
  until i = 0;
  result := s;
end; // newline2slashn

function onlyDigits(const s: string): string;
var
  i: Integer;
begin
  i := 1;
  // t := 1;
  result := copy(s, 1, length(s));
  while i <= length(result) do
    //if s[i] in ['0' .. '9'] then
    if s[i].IsDigit then
      // if TCharacter.IsDigit(Result, i) then
      inc(i)
    else
      delete(result, i, 1);
  // result:=s;
end; // onlyDigits

function matches(const s: string; from: Integer; const sub: string): Boolean; inline;
// begin result:=sub=copy(s,from,length(sub)) end;
// begin result:=AnsiPos(sub, s) = from end;
var
{$IFDEF MSWINDOWS}
  P: PChar;
{$ENDIF}
  l, L2: Integer;
begin
  dec(from);
{$IFDEF MSWINDOWS}
  // P := PChar(s)+from;
  P := PChar(@s[1]) + from;
{$ENDIF}
  l := length(sub);
  L2 := length(s) - from;
  if l > L2 then
    result := False
  else
{$IFDEF MSWINDOWS}
    result := CompareString(LOCALE_USER_DEFAULT, 0, // NORM_IGNORECASE,
      P, l, PChar(sub), l) = 2;
{$ENDIF}
{$IFDEF LINUX}
  result := WideSameText(ASubText, copy(AText, 1, l));
{$ENDIF}
end;

function matchesA(const s: RawByteString; from: Integer; const sub: RawByteString): Boolean; inline;
// begin result:=sub=copy(s,from,length(sub)) end;
// begin result:=AnsiPos(sub, s) = from end;
var
{$IFDEF MSWINDOWS}
  P: PAnsiChar;
{$ENDIF}
  l, L2: Integer;
begin
  dec(from);
{$IFDEF MSWINDOWS}
  // P := PChar(s)+from;
  P := PAnsiChar(@s[1]) + from;
{$ENDIF}
  l := length(sub);
  L2 := length(s) - from;
  if l > L2 then
    result := False
  else
{$IFDEF MSWINDOWS}
    result := CompareStringA(LOCALE_USER_DEFAULT, 0, // NORM_IGNORECASE,
      P, l, PAnsiChar(sub), l) = 2;
{$ENDIF}
{$IFDEF LINUX}
  result := SameText(ASubText, copy(AText, 1, l));
{$ENDIF}
end;

function Imatches(const s: string; from: Integer; const sub: string): Boolean;
// begin result:=compareText(sub,copy(s,from,length(sub)))=0 end;
var
{$IFDEF MSWINDOWS}
  P: PChar;
{$ENDIF}
  l, L2: Integer;
begin
  dec(from);
{$IFDEF MSWINDOWS}
  P := PChar(s) + from;
{$ENDIF}
  l := length(sub);
  L2 := length(s) - from;
  if l > L2 then
    result := False
  else
{$IFDEF MSWINDOWS}
    result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P, l, PChar(sub), l) = 2;
{$ENDIF}
{$IFDEF LINUX}
  result := WideSameText(ASubText, copy(AText, 1, l));
{$ENDIF}
end;

function dupString(const s: RawByteString): RawByteString;
begin
  result := copy(s, 1, length(s))
end;

{$IFDEF UNICODE}
function dupString(const s: string): string;
begin
  result := copy(s, 1, length(s))
end;
{$ENDIF UNICODE}

function trailing(const s, ss: string): Boolean;
begin
  result := ss = copy(s, length(s) - length(ss) + 1, length(ss))
end;

function bool2str(const b: Boolean): RawByteString;
begin
  result := AnsiChar(b)
end;

function ABCD_ADCB(d: dword): dword; assembler;
asm
  mov EAX, d
  ror EAX, 16
  ror AX, 8
  rol EAX, 16
  ror AX, 8
  rol EAX, 8
end; // ABCD_ADCB

function color2str(color: Tcolor): AnsiString;
{$IFDEF UNICODE}
var
  res: String;
begin
  // color:=ABCD_ADCB(ColorToRGB(color));
  if ColorToIdent(color, res) then
    result := res
  else
  begin
    color := ABCD_ADCB(ColorToRGB(color));
    result := IntToHex(color, 6);
  end;
{$ELSE nonUNICODE}

begin
  // color:=ABCD_ADCB(ColorToRGB(color));
  if not ColorToIdent(color, result) then
  begin
    color := ABCD_ADCB(ColorToRGB(color));
    result := intToHex(color, 6);
  end;
{$ENDIF UNICODE}
end; // color2str

function str2color(const s: AnsiString): Tcolor;
begin
  if length(s) = 0 then
    result := -1
  else if s[1] = '$' then
    result := ABCD_ADCB(stringToColor(s))
  else if (length(s) > 2) and (upcase(s[1]) = 'C') and (upcase(s[2]) = 'L') then
    result := stringToColor(s)
  else
    result := ABCD_ADCB(stringToColor('$' + s))
end; // str2color

function Color2HTML(Color: TColor): String;
begin
  Color := ABCD_ADCB(ColorToRGB(Color));
  Result := '#' + IntToHex(Color, 6);
end;

{$IF DEFINED(WIN64) OR DEFINED(FPC)}

function IntToHexA(Value: Integer; Digits: Integer): AnsiString; inline;
begin
  result := intToHex(Value, Digits);
end;

function IntToStrA(Value: Integer): AnsiString; inline;
begin
  result := intToStr(Value);
end;

{$ELSE win32}
// {$IF DEFINED(UNICODE) AND DEFINED(WIN32) AND DEFINED(X86ASM)}
{$IF DEFINED(UNICODE) AND DEFINED(WIN32)}

procedure CvtInt;
{ IN:
  EAX:  The integer value to be converted to text
  ESI:  Ptr to the right-hand side of the output buffer:  LEA ESI, StrBuf[16]
  ECX:  Base for conversion: 0 for signed decimal, 10 or 16 for unsigned
  EDX:  Precision: zero padded minimum field width
  OUT:
  ESI:  Ptr to start of converted text (not start of buffer)
  ECX:  Length of converted text
}
asm // StackAlignSafe
  OR      CL,CL
  JNZ     @CvtLoop
@C1:    OR      EAX,EAX
  JNS     @C2
  NEG     EAX
  CALL    @C2
  MOV     AL,'-'
  INC     ECX
  DEC     ESI
  MOV     [ESI],AL
  RET
@C2:    MOV     ECX,10

@CvtLoop:
  PUSH    EDX
  PUSH    ESI
@D1:    XOR     EDX,EDX
  DIV     ECX
  DEC     ESI
  ADD     DL,'0'
  CMP     DL,'0'+10
  JB      @D2
  ADD     DL,('A'-'0')-10
@D2:    MOV     [ESI],DL
  OR      EAX,EAX
  JNE     @D1
  POP     ECX
  POP     EDX
  SUB     ECX,ESI
  SUB     EDX,ECX
  JBE     @D5
  ADD     ECX,EDX
  MOV     AL,'0'
  SUB     ESI,EDX
  JMP     @z
@zloop: MOV     [ESI+EDX],AL
@z:     DEC     EDX
  JNZ     @zloop
  MOV     [ESI],AL
@D5:
end;

function IntToHexA(Value: Integer; Digits: Integer): AnsiString;
// FmtStr(Result, '%.*x', [Digits, Value]);
asm
  CMP     EDX, 32        // Digits < buffer length?
  JBE     @A1
  XOR     EDX, EDX
@A1:    PUSH    ESI
  MOV     ESI, ESP
  SUB     ESP, 32
  PUSH    ECX            // result ptr
  MOV     ECX, 16        // base 16     EDX = Digits = field width
  CALL    CvtInt
  MOV     EDX, ESI
  POP     EAX            // result ptr
  (* {$IF DEFINED(Unicode)}
  CALL    System.@UStrFromPCharLen
  {$ELSE} *)
  PUSH    RnQDefaultSystemCodePage
  CALL    System.@LStrFromPCharLen
  // {$IFEND}
  ADD     ESP, 32
  POP     ESI
end;

function IntToStrA(Value: Integer): AnsiString;
// FmtStr(Result, '%d', [Value]);
asm
  PUSH    ESI
  MOV     ESI, ESP
  SUB     ESP, 16
  XOR     ECX, ECX       // base: 0 for signed decimal
  PUSH    EDX            // result ptr
  XOR     EDX, EDX       // zero filled field width: 0 for no leading zeros
  CALL    CvtInt
  MOV     EDX, ESI
  POP     EAX            // result ptr
  (* {$IF DEFINED(Unicode)}
  CALL    System.@UStrFromPCharLen
  {$ELSE} *)
  PUSH    RnQDefaultSystemCodePage
  CALL    System.@LStrFromPCharLen
  // {$IFEND}
  ADD     ESP, 16
  POP     ESI
end;
{$ELSE nonUNICODE}
{$IF CompilerVersion >= 24}
{$MESSAGE FATAL 'Must be UNICODE.'}
{$ENDIF}

function IntToHexA(Value: Integer; Digits: Integer): AnsiString; inline;
begin
  result := intToHex(Value, Digits);
end;

function IntToStrA(Value: Integer): AnsiString; inline;
begin
  result := intToStr(Value);
end;
{$ENDIF UNICODE}
{$ENDIF win64}

function IntToStr(i, d: Integer): String; overload;
begin
  Result := Format('%.*d', [d, i]);
end; // IntToStr

function ExcludeTrailingCRLF(const s: String): String;
begin
  Result := s.TrimRight([#13, #10]);
end;

function DupAmpersand(const s: String): String;
begin
  Result := ReplaceStr(s, '&', '&&');
end;

procedure swap4(var a, b: Integer);
var
  bak: Integer;
begin
  bak := a;
  a := b;
  b := bak;
end; // swap

procedure swap4(var a, b: TDateTime);
var
  bak: TDateTime;
begin
  bak := a;
  a := b;
  b := bak;
end; // swap

procedure swap4(var src, dest; count: dword; cond: Boolean);
var
  temp: Pointer;
begin
  if not cond then
    exit;
  getmem(temp, count);
  move(src, temp^, count);
  move(dest, src, count);
  move(temp^, dest, count);
  freemem(temp, count);
  { asm
    mov ESI, src
    mov EDI, dest
    mov ECX, count
    @L:
    mov AL, [ESI]
    xchg AL, [EDI]
    mov [ESI], AL
    inc ESI
    inc EDI
    loop @L
    end; }
end; // swapMem

function qword_BE2verU(d: UInt64): String;
begin
  result := format(String('%d.%d.%d.%d'), [Word(d), Word(d shr 16), Word(d shr 32), Word(d shr 48)])
end;

function qword_LE2verU(d: UInt64): String;
begin
  result := format(String('%d.%d.%d.%d'), [Word(d shr 48), Word(d shr 32), Word(d shr 16), Word(d)])
end;

procedure SwapWordByteOrder(P: PAnsiChar; Len: Cardinal);
var
  b: AnsiChar;
begin
  while Len > 0 do
  begin
    b := P[0];
    P[0] := P[1];
    P[1] := b;
    inc(P, 2);
    dec(Len, 2);
  end;
end;

procedure StrSwapByteOrder(P: PWord);
begin
  while (P^ <> 0) do
  begin
    P^ := MakeWord(HiByte(P^), LoByte(P^));
    Inc(P);
  end;
end;

function chop(const ss: RawByteString; var s: RawByteString): RawByteString;
begin
  result := chop(pos(ss, s), length(ss), s)
end;

function chop(i: Integer; var s: RawByteString): RawByteString; inline;
begin
  result := chop(i, 1, s)
end;

function chop(i, l: Integer; var s: RawByteString): RawByteString;
begin
  if i = 0 then
  begin
    result := s;
    s := '';
    exit;
  end;
  result := copy(s, 1, i - 1);
  delete(s, 1, i - 1 + l);
end; // chop

function chopline(var s: RawByteString): RawByteString;
var
  i: Integer;
begin
  for i := 1 to length(s) do
    case s[i] of
      #10:
        begin
          result := chop(i, s);
          exit;
        end;
      #13:
        begin
          if (i < length(s)) and (s[i + 1] = #10) then
            result := chop(i, 2, s)
          else
            result := chop(i, s);
          exit;
        end;
    end;
  result := chop(0, 0, s);
end; // chopline

function choplineV(const s: RawByteString; var pos0: Integer): RawByteString;
var
  i, l: Integer;
begin
    l := Length(s);
    if pos0 < l then
    for i := pos0 to l do
      case s[i] of
        #10:
          begin
            result := Copy(s, pos0, i-pos0);
            pos0 := i+1;
            exit;
          end;
        #13:
          begin
            if (i < length(s)) and (s[i+1]=#10) then
              begin
                result := Copy(s, pos0, i-pos0);
                pos0 := i+2;
              end
             else
              begin
                result := Copy(s, pos0, i-pos0);
                pos0 := i+1;
              end;
            exit;
          end;
        end;
    result := s;
    pos0 := Length(s)+1;
end; // chopline

{$IFDEF UNICODE}
function chop(i, l: Integer; var s: String): String;
begin
  if i = 0 then
  begin
    result := s;
    s := '';
    exit;
  end;
  result := copy(s, 1, i - 1);
  delete(s, 1, i - 1 + l);
end; // chop

function chop(i: Integer; var s: String): String; inline;
begin
  result := chop(i, 1, s)
end;

function chop(const ss: String; var s: String): String;
begin
  result := chop(pos(ss, s), length(ss), s)
end;

function chopline(var s: String): String;
var
  i: Integer;
begin
  for i := 1 to length(s) do
    case s[i] of
      #10:
        begin
          result := chop(i, s);
          exit;
        end;
      #13:
        begin
          if (i < length(s)) and (s[i + 1] = #10) then
            result := chop(i, 2, s)
          else
            result := chop(i, s);
          exit;
        end;
    end;
  result := chop(0, 0, s);
end; // chopline

function choplineV(const s: String; var pos0: Integer): String;
var
  i, l: Integer;
begin
    l := Length(s);
    if pos0 < l then
    for i := pos0 to l do
      case s[i] of
        #10:
          begin
            result := Copy(s, pos0, i-pos0);
            pos0 := i+1;
            exit;
          end;
        #13:
          begin
            if (i < length(s)) and (s[i+1]=#10) then
              begin
                result := Copy(s, pos0, i-pos0);
                pos0 := i+2;
              end
             else
              begin
                result := Copy(s, pos0, i-pos0);
                pos0 := i+1;
              end;
            exit;
          end;
        end;
    result := Copy(s, pos0);
    pos0 := Length(s)+1;
end; // chopline
{$ENDIF UNICODE}

function old_UnUTF(const s: RawByteString): String;
begin
  if (Length(s) > 1)
     and ((s[1] < #5) or (s[2] < #5) or ((s[1] = #255) and (s[2] = #254)))
     and not odd(Length(s)) then
  begin
    if (s[1] < #5) then
      Result := WideBEToStr(s);
  end else
    Result := UnUTF(s);
end;

function IsUTF(const s: RawByteString): Boolean;
begin
  Result := IsUTF8String(s);
end;

function UTF(const s: String): RawByteString;
begin
  if IsUTF8String(s) then
    Result := s
  else
    Result := UTF8Encode(s)
end;

function UnUTF(const s: RawByteString): String;
begin
  if IsUTF8String(s) then
    Result := System.UTF8ToString(s)
  else
    Result := s;
end;

function UnUTF(const s: String): String;
begin
  if IsUTF8String(s) then
    Result := System.UTF8ToString(s)
  else
    Result := s;
end;

function WideBEToStr(const Value: RawByteString): String;
var
  Str: RawByteString;
begin
  if Value = '' then
  begin
    Result := '';
    Exit;
  end;
  Str := Copy(Value, 1, Length(Value));
  StrSwapByteOrder(PWord(Str));
  Result := WideCharToString(PWideChar(@Str[1]));
end;

function StrToUnicode(const Value: String): RawByteString;
var
  Buffer: Pointer;
  BufLen: LongWord;
begin
  if Value = '' then
  begin
    Result := '';
    Exit;
  end;
  BufLen := length(Value) * 2 + 2;
  setlength(result, BufLen);
  Buffer := @result[1];
  FillChar(Buffer^, BufLen, 0);
  StringToWideChar(Value, Buffer, BufLen);
  SwapWordByteOrder(PAnsiChar(@Result[1]), Length(result));
  SetLength(Result, BufLen - 2);
end;

{$IFDEF UNICODE} {$IF CompilerVersion >= 24}
function RnQEndsText(const ASubText, AText: UnicodeString): Boolean;
var
  SubTextLocation: Integer;
begin
  SubTextLocation := AText.length - ASubText.length + 1;
  if (SubTextLocation > 0) and (ASubText <> '') and (ByteType(AText, SubTextLocation) <> mbTrailByte) then
    result := AnsiStrIComp(PChar(ASubText), PChar(@AText[SubTextLocation])) = 0
  else
    result := False;
end;
{$ELSE}

function RnQEndsText(const ASubText, AText: UnicodeString): Boolean;
begin
  result := AnsiEndsText(ASubText, AText);
end;
{$IFEND ver} {$ENDIF UNICODE}

function findInStrings(const s: string; ss: Tstrings): Integer;
begin
  result := 0;
  while result < ss.count do
    if ss[result] = s then
      exit
    else
      inc(result);
  result := -1;
end; // findInStrings

function findInStrings(const s: String; var ss: String; const separator: String): Integer;
begin
  result := 0;
  while ss > '' do
    if chop(separator, ss) = s then
      exit
    else
      inc(result);
  result := -1;
end; // findInStrings

function hexToInt(const s: RawByteString): Cardinal;
var
  i, v, c: Cardinal;
begin
  result := 0;
  c := 0;
  i := length(s);
  while i > 0 do
  begin
    if s[i] >= 'a' then
      v := byte(s[i]) - byte('a') + 10
    else if s[i] >= 'A' then
      v := byte(s[i]) - byte('A') + 10
    else
      v := byte(s[i]) - byte('0');
    inc(result, v shl c);
    inc(c, 4);
    dec(i);
  end;
end; // hexToInt

function str2valor(const s: AnsiString): int64;
var
  cd: Integer;
begin
  if s = '' then
    result := -1
  else if s[length(s)] = 'h' then
    result := hexToInt(copy(s, 1, length(s) - 1))
  else
    try
      Val(s, result, cd);
      if cd <> 0 then
        result := 0
    except
      result := 0
    end
end; // str2valor

function hex2Str(const s: RawByteString): RawByteString;
var
  i: Integer;
begin
  result := '';
  // c:=0;
  // i:=length(s);
  i := 1;
  while i < length(s) do
  begin
    result := result + AnsiChar(hexToInt(copy(s, i, 2)));
    { if s[i] >= 'a' then v:=byte(s[i])-byte('a')+10 else
      if s[i] >= 'A' then v:=byte(s[i])-byte('A')+10 else
      v:=byte(s[i])-byte('0');
      result := result + IntToStr(v);
      //  inc(result, v shl c);
      //  inc(c,4);
      dec(i); }
    inc(i, 2);
  end;
end; // hexToInt

function hex2StrSafe(const s: RawByteString): RawByteString;
var
  i: Integer;
  ch: AnsiChar;
begin
  result := '';
  // c:=0;
  // i:=length(s);
  i := 1;
  while i < length(s) do
  begin
    if (s[i] in hexChars) and (s[i + 1] in hexChars) then
      ch := AnsiChar(hexToInt(copy(s, i, 2)))
    else
      ch := ' ';
    result := result + ch;
    { if s[i] >= 'a' then v:=byte(s[i])-byte('a')+10 else
      if s[i] >= 'A' then v:=byte(s[i])-byte('A')+10 else
      v:=byte(s[i])-byte('0');
      result := result + IntToStr(v);
      //  inc(result, v shl c);
      //  inc(c,4);
      dec(i); }
    inc(i, 2);
  end;
end; // hexToInt

function hex2StrU(const s: String): RawByteString;
var
  i: Integer;
  ch: AnsiChar;
begin
  result := '';
  // c:=0;
  // i:=length(s);
  i := 1;
  while i < length(s) do
  begin
    if CharInSet(s[i], hexChars) and CharInSet(s[i + 1], hexChars) then
      ch := AnsiChar(hexToInt(copy(s, i, 2)))
    else
      ch := ' ';
    result := result + ch;
    { if s[i] >= 'a' then v:=byte(s[i])-byte('a')+10 else
      if s[i] >= 'A' then v:=byte(s[i])-byte('A')+10 else
      v:=byte(s[i])-byte('0');
      result := result + IntToStr(v);
      //  inc(result, v shl c);
      //  inc(c,4);
      dec(i); }
    inc(i, 2);
  end;
end; // hex2StrU

function PacketToHex(Buffer: Pointer; BufLen: Word): AnsiString;
var
  // S: AnsiString;
  i: Cardinal;
begin
  result := '';
  for i := 1 to BufLen do
  begin
    result := result + IntToHexA(PByte(LongWord(Buffer) + i - 1)^, 2);
  end;
end;

function str2hex(const s: RawByteString): AnsiString;
var
  // ofs,
  i: Integer;
  // s2:string;
begin
  result := '';
  // ofs:=0;
  for i := 1 to length(s) do
  begin
    result := result + IntToHexA(byte(s[i]), 2);
    // result:=result+' ';
  end;
end; // Str2hex

function str2hexU(const s: RawByteString): String;
var
  // ofs,
  i: Integer;
  // s2:string;
begin
  result := '';
  // ofs:=0;
  for i := 1 to length(s) do
  begin
    result := result + intToHex(byte(s[i]), 2);
    // result:=result+' ';
  end;
end; // Str2hex

function str2hex(const s: RawByteString; const Delim: AnsiChar): AnsiString;
var
  // ofs,
  i: Integer;
  // s2:string;
begin
  result := '';
  // ofs:=0;
  for i := 1 to length(s) do
  begin
    if i > 1 then
      result := result + Delim;
    result := result + IntToHexA(byte(s[i]), 2);
    // result:=result+' ';
  end;
end; // Str2hex

function strings2str(const split: string; ss: Tstrings): string;
var
  i: Integer;
begin
  result := '';
  if ss = nil then
    exit;
  i := 0;
  while i < ss.count - 1 do
  begin
    result := result + ss[i] + split;
    inc(i);
  end;
  // the last one without split
  if ss.count > 0 then
    result := result + ss[ss.count - 1]
end; // strings2str

function strings2str(const split: string; const ss: array of string): string;
var
  i: Integer;
begin
  result := '';
  if length(ss) = 0 then
    exit;
  for i := 0 to length(ss) - 2 do
    result := result + ss[i] + split;
  result := result + ss[length(ss) - 1];
end;

procedure str2strings(const split: String; src: string; var ss: Tstrings);
var
  i: Integer;
begin
  ss.clear;
  while src > '' do
  begin
    i := pos(split, src);
    if i = 0 then
      i := length(src) + 1;
    ss.ADD(copy(src, 1, i - 1));
    delete(src, 1, i + length(split) - 1);
  end;
end; // strings2str

function hexDump(const data: RawByteString): AnsiString;
const
  cols = 16;
var
  ofs, i: Integer;
  s, s2: AnsiString;
begin
  result := '';
  ofs := 0;
  while ofs < length(data) do
  begin
    s := '';
    s2 := '';
    for i := 1 to cols do
      if ofs + i <= length(data) then
      begin
        s := s + IntToHexA(byte(data[ofs + i]), 2);
        if i = 8 then
          s := s + '  '
        else
          s := s + ' ';
        if data[ofs + i] < #32 then
          s2 := s2 + '.'
        else
          s2 := s2 + data[ofs + i];
      end;
    s := s + stringOfChar(AnsiChar(' '), cols * 3 + 4 - length(s));
    result := result + s + s2 + CRLF;
    inc(ofs, cols);
  end;
end; // hexDump

function hexDumpS(const data: RawByteString): String;
const
  cols = 16;
var
  ofs, i: Integer;
  s, s2: String;
begin
  result := '';
  ofs := 0;
  while ofs < length(data) do
  begin
    s := '';
    s2 := '';
    for i := 1 to cols do
      if ofs + i <= length(data) then
      begin
        s := s + intToHex(byte(data[ofs + i]), 2);
        if i = 8 then
          s := s + '  '
        else
          s := s + ' ';
        if data[ofs + i] < #32 then
          s2 := s2 + '.'
        else
          s2 := s2 + String(data[ofs + i]);
      end;
    s := s + stringOfChar(' ', cols * 3 + 4 - length(s));
    result := result + s + s2 + CRLF;
    inc(ofs, cols);
  end;
end; // hexDump

function isOnlyDigits(const s: AnsiString): boolean;
var
  i: Integer;
begin
  Result := False;
  i := 1;
  while i <= length(s) do
    if s[i] in ['0'..'9'] then
      inc(i)
    else
      Exit;
  if i > 1 then
    Result := TRUE;
end; // isOnlyDigits

{$IFDEF UNICODE}
function  isOnlyDigits(const s: UnicodeString): boolean;
var
  i: Integer;
begin
  Result := False;
  i := 1;
  while i <= length(s) do
//    if s[i] in ['0'..'9'] then
    if s[i].IsDigit then
      inc(i)
    else
      Exit;
  if i > 1 then
    Result := TRUE;
end; // isOnlyDigits
{$ENDIF UNICODE}

function str2fontstyle(const s: AnsiString): Tfontstyles;
begin
  result := [];
  if ansipos(AnsiChar('b'), s) > 0 then
    include(result, fsBold);
  if ansipos(AnsiChar('i'), s) > 0 then
    include(result, fsItalic);
  if ansipos(AnsiChar('u'), s) > 0 then
    include(result, fsUnderline);
end; // str2fontstyle

function fontstyle2str(fs: Tfontstyles): AnsiString;
begin
  result := '';
  if fsBold in fs then
    result := result + 'b';
  if fsItalic in fs then
    result := result + 'i';
  if fsUnderline in fs then
    result := result + 'u';
end; // str2fontstyle

function size2str(sz: int64): String;
begin
  if sz > GByte then // GB
    result := FloatToStr(round(100 * (sz / GByte)) / 100) + ' GByte'
  else if sz > MByte then // MB
    result := FloatToStr(round(100 * (sz / MByte)) / 100) + ' MByte'
  else if sz > 1024 then // KB
    result := FloatToStr(round(100 * (sz / 1024)) / 100) + ' KByte'
  else
    result := intToStr(sz) + ' Byte'
end;

function BetterStr(const S: String): String;
var
  I: Integer;
begin
  SetLength(Result, Length(S));
  for I := 1 to Length(S) do
  if S[I] < #32 then
    Result[I] := '.'
  else
    Result[I] := S[I];
  Result := THTMLEncoding.HTML.Encode(Result);
end;

function BetterStrS(const s: String): String;
var
  i: Integer;
begin
  setlength(result, length(s));
  for i := 1 to length(s) do
    if s[i] < #32 then
      result[i] := '.'
    else
      result[i] := s[i];
end;

function Rgb2Gray(RGBColor: Tcolor): byte;
// var
// Gray : byte;
begin
  result := round((0.30 * GetRValue(RGBColor)) + (0.59 * GetGValue(RGBColor)) + (0.11 * GetBValue(RGBColor)));
  // Result := RGB(Gray, Gray, Gray);
end;

function DoubleAsInt64(Value: Double): Int64;
var
  i: Int64 absolute Value;
begin
  Result := i;
end;

function Int64AsDouble(Value: Int64): Double;
var
  d: Double absolute Value;
begin
  Result := d;
end;

function TBytesToString(B: TBytes; CodePage: Integer = CP_UTF8): string;
var
  E: TEncoding;
begin
  E := TEncoding.GetEncoding(CodePage);
  try
    Result := E.GetString(B);
  finally
    E.Free;
  end;
end;

function StringToTBytes(const S: string; CodePage: Integer = CP_UTF8): TBytes;
var
  E: TEncoding;
begin
  E := TEncoding.GetEncoding(CodePage);
  try
    Result := E.GetBytes(S);
  finally
    E.Free;
  end;
end;

procedure SaveBytesToFile(const Data: TBytes; const FileName: string);
var
  stream: TMemoryStream;
begin
  stream := TMemoryStream.Create;
  try
    if Length(data) > 0 then
      stream.WriteBuffer(data[0], Length(data));
    stream.SaveToFile(FileName);
  finally
    stream.Free;
  end;
end;

function TryStrToLongWord(const S: string; var Value: LongWord): Boolean;
var
  Int64Value: Int64;
begin
  Result := TryStrToInt64(S, Int64Value) and (Int64Value >= 0) and (Int64Value <= High(Value));
  if Result then
    Value := LongWord(Int64Value);
end;

function Hex2String(const Buffer: String): RawByteString;
begin
  SetLength(Result, Length(Buffer) div 2);
  HexToBin(PChar(Buffer), PAnsiChar(Result), Length(Result));
end;

function String2Hex(const Buffer: RawByteString): String;
begin
  SetLength(Result, 2*Length(Buffer));
  BinToHex(PAnsiChar(Buffer), PChar(Result), Length(Buffer));
end;

initialization

RnQDefaultSystemCodePage := GetACP;

end.