{********************************************************************}
{                                                                    }
{ written by TMS Software                                            }
{            copyright © 2013                                        }
{            Email : info@tmssoftware.com                            }
{            Web : http://www.tmssoftware.com                        }
{                                                                    }
{ The source code is given as is. The author is not responsible      }
{ for any possible damage done due to the use of this code.          }
{ The complete source code remains property of the author and may    }
{ not be distributed, published, given or sold in any form as such.  }
{ No parts of the source code can be included in any other component }
{ or application without written authorization of the author.        }
{********************************************************************}

unit FMX.TMSGridDataUtil;

interface

{$I TMSDEFS.INC}

uses
  Types, Classes, Generics.Collections;

type
  TAutoType = (atNumeric,atFloat,atString,atDate,atTime,atScientific);

  TIntList = class(TList<Integer>)
  private
    procedure SetInteger(Index: Integer; Value: Integer);
    function GetInteger(Index: Integer):Integer;
    function GetStrValue: string;
    procedure SetStrValue(const Value: string);
  public
    procedure DeleteValue(Value: Integer);
    function HasValue(Value: Integer): Boolean;
    function IndexOfValue(Value: Integer): integer;
    property Items[index: Integer]: Integer read GetInteger write SetInteger; default;
    procedure Add(Value: Integer);
    procedure Insert(Index,Value: Integer);
    procedure Delete(Index: Integer);
    property StrValue: string read GetStrValue write SetStrValue;
  end;


  function IsType(s:string): TAutoType;
  function Matches(s0a,s1a:PChar):Boolean;
  function MatchStr(s1,s2:string;DoCase:Boolean):boolean;
  function MatchStrEx(s1,s2:string;DoCase:Boolean):boolean;
  function VarPos(su,s:string;var Respos:Integer):Integer;
  function CharPos(ch: Char; const s: string): Integer;
  function NumSingleChar(p:char;s:string):Integer;
  function DoubleToSingleChar(ch: Char;const s:string):string;
  procedure CSVToLineFeeds(var s:string);
  function VarCharPos(ch: Char; const s: string; var Res: Integer): Integer;
  function NumChar(p:char;s:string):Integer;
  function SinglePos(p:char;s:string;var sp: Integer):Integer;
  function GetToken(var s:string;separator:string): string;
  function FileToLf(s:string;multiline:Boolean = True): string;
  function LfToFile(s:string): string;
  function GetNextLine(var s: string;multiline:Boolean = True): string;
  function CSVQuotes(const S: string): string;
  procedure LineFeedsToCSV(var s: string);
  procedure LineFeedsToCSVNQ(var s: string);
  function LinesInText(s: string;multiline:Boolean = True): Integer;
  function HTMLStrip(s: string): string;
  function HTMLLineBreaks(s:string):string;
  function HTMLColor(l:dword):string;
  function CRToLF(s: string): string;
  function FixNonBreaking(su: string): string;
  function FixMarkup(su:string): string;
  function IsURL(const s:string):boolean;

implementation

uses
  Math, StrUtils, SysUtils
  ,Character;

const
  LINEFEED = #13;
  NumSpecialChar = 51;

var
  {$IFDEF DELPHI_LLVM}
  HTMLEncodedChar: array[1..55] of string = ('é','è','ë','ê',
  {$ELSE}
  HTMLEncodedChar: array[1..55] of ansistring = ('é','è','ë','ê',
  {$ENDIF}
                                                 'ó','ò','ö','ô',
                                                 'í','ì','ï','î',
                                                 'ú','ù','ü','û',
                                                 'á','à','ä','â',
                                                 'É','È','Ë','Ê',
                                                 'Ó','Ò','Ö','Ô',
                                                 'Í','Ì','Ï','Î',
                                                 'Ú','Ù','Ü','Û',
                                                 'Á','À','Ä','Â',
                                                 'ç','Ç','ø','Ø',
                                                 'å','Å','©','®',
                                                 '€','«','»','ã','Ã','õ','Õ');

  {$IFDEF DELPHI_LLVM}
  HTMLSpecialChar: array[1..55] of string = ('&eacute;','&egrave;','&euml;','&ecirc;',
  {$ELSE}
  HTMLSpecialChar: array[1..55] of ansistring = ('&eacute;','&egrave;','&euml;','&ecirc;',
  {$ENDIF}
                                                 '&oacute;','&ograve;','&ouml;','&ocirc;',
                                                 '&iacute;','&igrave;','&iuml;','&icirc;',
                                                 '&uacute;','&ugrave;','&uuml;','&ucirc;',
                                                 '&aacute;','&agrave;','&auml;','&acirc;',
                                                 '&Eacute;','&Egrave;','&Euml;','&Ecirc;',
                                                 '&Oacute;','&Ograve;','&Ouml;','&Ocirc;',
                                                 '&Iacute;','&Igrave;','&Iuml;','&Icirc;',
                                                 '&Uacute;','&Ugrave;','&Uuml;','&Ucirc;',
                                                 '&Aacute;','&Agrave;','&Auml;','&Acirc;',
                                                 '&ccedil;','&Ccedil;','&oslash;','&Oslash;',
                                                 '&aring;','&Aring;','&copy;','&reg;',
                                                 '&euro;','&laquo;','&raquo;','&atilde;','&Atilde;','&otilde;','&Otilde');


type
  TCharSet = array of char;


{ TIntList }

procedure TIntList.SetInteger(Index:Integer;Value:Integer);
begin
  inherited Items[Index] := Value;
end;

function TIntList.GetInteger(Index: Integer): Integer;
begin
  Result := Integer(inherited Items[Index]);
end;

procedure TIntList.DeleteValue(Value: Integer);
var
  i: integer;
begin
  i := IndexOf(Value);
  if i <> -1 then
    Delete(i);
end;

function TIntList.HasValue(Value: Integer): Boolean;
begin
  Result := IndexOfValue(Value) <> -1;
end;

function TIntList.IndexOfValue(Value: Integer): integer;
begin
  Result := IndexOf(Value);
end;

procedure TIntList.Add(Value: Integer);
begin
  inherited Add(Value);
end;

procedure TIntList.Delete(Index: Integer);
begin
  inherited Delete(Index);
end;

function TIntList.GetStrValue: string;
var
  i: integer;
begin
  for i := 1 to Count do
    if i = 1 then
      Result:= IntToStr(Items[i - 1])
    else
      Result := Result + ',' + IntToStr(Items[i - 1]);
end;

procedure TIntList.SetStrValue(const Value: string);
var
  sl:TStringList;
  i: Integer;
begin
  sl := TStringList.Create;
  sl.CommaText := Value;
  Clear;
  for i := 1 to sl.Count do
   Add(StrToInt(sl.Strings[i - 1]));
  sl.Free;
end;

procedure TIntList.Insert(Index, Value: Integer);
begin
  inherited Insert(Index, Value);
end;

function CRToLF(s:string): string;
var
  i: integer;
  res:string;
begin
  res := '';

  {$IFDEF DELPHI_LLVM}
  for i := 0 to length(s) - 1 do
  {$ELSE}
  for i := 1 to length(s) do
  {$ENDIF}
    if (s[i] <> #13) then
      res := res + s[i]
    else
      res := res + #10;

  Result := res;
end;


function HTMLStrip(s:string):string;
var
  TagPos: integer;
begin
  Result := '';
  // replace line breaks by linefeeds
  while (pos('<BR>',uppercase(s))>0) do s := StringReplace(s,'<BR>',chr(13)+chr(10),[rfIgnoreCase]);
  while (pos('<HR>',uppercase(s))>0) do s := StringReplace(s,'<HR>',chr(13)+chr(10),[rfIgnoreCase]);

  {remove all other tags}
  while (VarPos('<',s,TagPos) > 0) do
  begin
    Result := Result + Copy(s,1,TagPos-1);
    if (VarPos('>',s,TagPos)>0) then
      Delete(s,1,TagPos)
    else
      Break;
  end;
  Result := Result + s;
end;

function CSVQuotes(const s: string): string;
var
  i: Integer;
begin
  Result := '';
  {$IFDEF DELPHI_LLVM}
  for i := 0 to length(s) - 1 do
  {$ELSE}
  for i := 1 to length(s) do
  {$ENDIF}
  begin
    Result := Result + s[i];
    if s[i]='"' then
      Result := Result + '"';
  end;
end;


function CharPos(ch: Char; const s: string): Integer;
var
  i: Integer;
begin
  Result := 0;
  {$IFDEF DELPHI_LLVM}
  for i := 0 to length(s) - 1 do
  {$ELSE}
  for i := 1 to length(s) do
  {$ENDIF}
    if s[i] = ch then
    begin
      Result := i;
      Break;
    end;
end;

function DoubleToSingleChar(ch: Char;const s:string):string;
var
  Res: string;
  i: Integer;
begin
  if (s = '') or (CharPos(ch,s) = 0) then
  begin
    DoubleToSingleChar := s;
    Exit;
  end;

  res := '';
  {$IFDEF DELPHI_LLVM}
  i   := 0;
  {$ELSE}
  i   := 1;
  {$ENDIF}

  repeat
    Res := Res + s[i];
    // skip dbl quote
    if ((s[i] = ch) and (s[i + 1] = ch)) then
      Inc(i);
    Inc(i);
  until (i > Length(s));

  DoubleToSingleChar := Res;
end;

function VarPos(su,s:string;var Respos:Integer):Integer;
begin
  Respos := Pos(su,s);
  Result := Respos;
end;

procedure CSVToLineFeeds(var s:string);
var
  res: string;
  i: Integer;
begin
  if CharPos(#11,s) = 0 then
    Exit;
  Res := '';
  {$IFDEF DELPHI_LLVM}
  for i := 0 to length(s) - 1 do
  {$ELSE}
  for i := 1 to length(s) do
  {$ENDIF}
    if s[i] = #11 then
      Res := Res + #13#10
    else
      Res := Res + s[i];
  s := Res;
end;

function VarCharPos(ch: Char; const s: string; var Res: Integer): Integer;
var
  i: Integer;
begin
  Result := 0;
  {$IFDEF DELPHI_LLVM}
  for i := 0 to length(s) - 1 do
  {$ELSE}
  for i := 1 to length(s) do
  {$ENDIF}
    if s[i] = ch then
    begin
      Res := i;
      Result := i;
      Break;
    end;
end;

function NumChar(p:char;s:string):Integer;
var
  Res,vp: Integer;
begin
  Res := 0;
  while VarPos(p,s,vp) > 0 do
  begin
    Delete(s,1,vp);
    Inc(Res);
  end;
  Result := Res;
end;


function SinglePos(p:char;s:string;var sp: Integer):Integer;
var
  i: Integer;
  QuoteCount: Integer;
begin
  i := 1;
  QuoteCount:= 0;
  while i <= Length(s) do
  begin
    if s[i] = p then
    begin
      if i < Length(s) then
        Inc(QuoteCount)
      else
        if i = Length(s) then
        begin
          Result := i;
          sp := i;
          Exit;
        end;
    end
    else
    begin
      if (Odd(QuoteCount)) then
      begin
        Result := i - 1;
        sp := i - 1;
        Exit;
      end
      else
        QuoteCount := 0;
    end;
    Inc(i);
  end;
  Result := 0;
  sp := 0;
end;

function NumSingleChar(p:char;s:string):Integer;
var
  Res,sp: Integer;
begin
  Res := 0;
  while SinglePos(p,s,sp) > 0 do
  begin
    Delete(s,1,sp);
    Inc(Res);
  end;
  Result := Res;
end;




function MatchStr(s1,s2:string;DoCase:Boolean):Boolean;
begin
  if DoCase then
    MatchStr := Matches(PChar(s1),PChar(s2))
  else
    MatchStr := Matches(PChar(AnsiUpperCase(s1)),PChar(AnsiUpperCase(s2)));
end;


{$IFDEF MACOS}
function StripThousandSep(ps: pchar):string;
begin
end;

function ShortDateFormat: String;
begin
end;

function DateSeparator: String;
begin
end;

function TimeSeparator: String;
begin
end;

{$ELSE}

function StripThousandSep(ps: pchar):string;
var
  i: Integer;
  s: string;
begin
  Result := '';
  s := strpas(ps);
  {$IFDEF DELPHI_LLVM}
  for i := 0 to length(s) - 1 do
  {$ELSE}
  for i := 1 to length(s) do
  {$ENDIF}
  begin
    if s[i] = FormatSettings.DecimalSeparator then
      Result := Result + '.' else
      if s[i] <> FormatSettings.ThousandSeparator then
        Result := Result + s[i];
  end;
end;

{$ENDIF}

function IsDate(s:string;var dt:TDateTime):boolean;
var
  su, ts: string;
  da,mo,ye,ho,mi,se: word;
  err: Integer;
  dp,mp,yp,vp: Integer;
begin
  Result := False;

  ts := '';

  su := UpperCase(FormatSettings.ShortDateFormat);
  dp := pos('D',su);
  mp := pos('M',su);
  yp := pos('Y',su);

  da := 0;
  mo := 0;
  ye := 0;
  ho := 0;
  mi := 0;
  se := 0;

  if VarPos(FormatSettings.DateSeparator,s,vp)>0 then
  begin
    su := Copy(s,1,vp - 1);

    if (dp<mp) and
       (dp<yp) then
       val(su,da,err)
    else
    if (mp<dp) and
       (mp<yp) then
       val(su,mo,err)
    else
    if (yp<mp) and
       (yp<dp) then
       val(su,ye,err);

    if err<>0 then Exit;
    Delete(s,1,vp);

    if VarPos(FormatSettings.DateSeparator,s,vp)>0 then
    begin
      su := Copy(s,1,vp - 1);

      if ((dp>mp) and (dp<yp)) or
         ((dp>yp) and (dp<mp)) then
         val(su,da,err)
      else
      if ((mp>dp) and (mp<yp)) or
         ((mp>yp) and (mp<dp)) then
         val(su,mo,err)
      else
      if ((yp>mp) and (yp<dp)) or
         ((yp>dp) and (yp<mp)) then
         val(su,ye,err);

      if err<>0 then Exit;
      Delete(s,1,vp);

      s := Trim(s);

      if VarPos(' ',s, vp) > 0 then  // there is space to separate date & time
      begin
        ts := copy(s, vp, length(s));
        s := copy(s, 1, vp - 1);
      end;

      if (dp>mp) and
         (dp>yp) then
         val(s,da,err)
      else
      if (mp>dp) and
         (mp>yp) then
         val(s,mo,err)
      else
      if (yp>mp) and
         (yp>dp) then
         val(s,ye,err);

      if err<>0 then Exit;
      if (da>31) then Exit;
      if (mo>12) then Exit;

      if (ts <> '') then  // there is a time part
      begin
        if VarPos(FormatSettings.TimeSeparator,ts,vp)>0 then
        begin
          su := Copy(ts,1,vp - 1); // hour part
          val(su,ho,err);

          if (err <> 0) then Exit;
          if (ho > 23) then Exit;

          Delete(ts,1,vp);

          if VarPos(FormatSettings.TimeSeparator,ts,vp)>0 then // there is a second part
          begin
            su := Copy(ts,1,vp - 1); // minute part
            val(su,mi,err);

            if err <> 0 then Exit;
            Delete(ts,1,vp);

            val(ts,se,err);  // second part
            if (err <> 0) then Exit;
            if (se > 60) then Exit;
          end
          else
          begin
            val(su,mi,err); // minute part
            if (err <> 0) then Exit;
          end;

          if (mi > 59) then Exit;

          Result := true;
        end;
      end
      else
        Result := True;

      try
        dt := EncodeDate(ye,mo,da) + EncodeTime(ho,mi,se,0);
      except
        Result := False;
      end;
    end;
  end;
end;


function Matches(s0a,s1a: PChar): Boolean;
const
  larger = '>';
  smaller = '<';
  logand  = '&';
  logor   = '^';
  asterix = '*';
  qmark = '?';
  negation = '!';
  null = #0;

var
  matching:boolean;
  done:boolean;
  len:longint;
  lastchar:char;
  s0,s1,s2,s3:pchar;
  oksmaller,oklarger,negflag:boolean;
  compstr:array[0..255] of char;
  flag1,flag2,flag3:boolean;
  equal:boolean;
  n1,n2:double;
  code1,code2:Integer;
  dt1,dt2:TDateTime;
  q: integer;
begin
  oksmaller := True;
  oklarger := True;
  flag1 := False;
  flag2 := False;
  flag3 := False;
  negflag := False;
  equal := False;

  { [<>] string [&|] [<>] string }

  // do larger than or larger than or equal
  s2 := StrPos(s0a,larger);
  if s2 <> nil then
  begin
    inc(s2);
    if (s2^ = '=') then
    begin
      Equal := True;
      inc(s2);
    end;

    while (s2^ = ' ') do
      inc(s2);

    s3 := s2;
    len := 0;

    lastchar := #0;

    q := 0;

    while (s2^ <> ' ') and (s2^ <> NULL) and (odd(q) or ((s2^ <> '&') and (s2^ <> '|')))  do
    begin
      if (s2^= '"') then
        inc(q);

      if (len = 0) and (s2^ = '"') then
        inc(s3)
      else
        inc(len);

      lastchar := s2^;
      inc(s2);

      if (s2^= ' ') and odd(q) then // skip space if between quotes
      begin
        lastchar := s2^;
        inc(s2);
      end;
    end;

    if (len > 0) and (lastchar = '"') then
      dec(len);

    StrLCopy(compstr,s3,len);

    Val(StripThousandSep(s1a),n1,code1);
    Val(StripThousandSep(compstr),n2,code2);

    if IsDate(compstr,dt2) then code2 := 1;
    if IsDate(s1a,dt1) then code1 := 1;

    if (code1 = 0) and (code2 = 0) then {both are numeric types}
    begin
      if equal then
        oklarger := n1 >= n2
      else
        oklarger := n1 > n2;
    end
    else
    begin
      if IsDate(StrPas(compstr),dt2) and IsDate(StrPas(s1a),dt1) then
      begin
        if equal then
         oklarger := dt1 >= dt2
        else
         oklarger := dt1 > dt2;
      end
      else
      begin
        if equal then
         oklarger := (strlcomp(compstr,s1a,255)<=0)
        else
         oklarger := (strlcomp(compstr,s1a,255)<0);
      end;
    end;
    flag1 := True;
  end;

  equal := False;

  // do smaller than or smaller than or equal
  s2 := strpos(s0a,smaller);
  if (s2 <> nil) then
  begin
    inc(s2);
    if (s2^ = '=') then
      begin
       equal := True;
       inc(s2);
      end;

    lastchar := #0;

    while (s2^=' ') do inc(s2);
    s3 := s2;
    len := 0;
    q := 0;

    while (s2^ <> ' ') and (s2^ <> NULL) and (odd(q) or ((s2^ <> '&') and (s2^ <> '|'))) do
    begin
      if s2^ = '"' then
        inc(q);

      if (len = 0) and (s2^ = '"') then
        inc(s3)
      else
        inc(len);

      lastchar := s2^;
      inc(s2);
    end;

    if (len > 0) and (lastchar = '"') then
      dec(len);

    strlcopy(compstr,s3,len);

    Val(StripThousandSep(s1a),n1,code1);
    Val(StripThousandSep(compstr),n2,code2);
    if IsDate(compstr,dt2) then code2 := 1;
    if IsDate(s1a,dt1) then code1 := 1;

    if (code1 = 0) and (code2 = 0) then // both are numeric types
     begin
      if equal then
       oksmaller := n1 <= n2
      else
       oksmaller := n1 < n2;
     end
    else
     begin
      // check for dates here ?
      if IsDate(strpas(compstr),dt2) and IsDate(strpas(s1a),dt1) then
       begin
        if equal then
         oksmaller := dt1 <= dt2
        else
         oksmaller := dt1 < dt2;
       end
      else
       begin
        if equal then
          oksmaller := (strlcomp(compstr,s1a,255)>=0)
        else
          oksmaller := (strlcomp(compstr,s1a,255)>0);
       end;
     end;

    flag2 := True;
  end;

  s2 := strpos(s0a,negation);

  if (s2 <> nil) then
  begin
    inc(s2);
    while (s2^=' ') do
      inc(s2);
    s3 := s2;
    len := 0;

    lastchar := #0;
    q := 0;

    while (s2^ <> ' ') and (s2^ <> NULL) and (odd(q) or ((s2^ <> '&') and (s2^ <> '|'))) do
    begin
      if (s2^ = '"') then
        inc(q);

      if (len = 0) and (s2^ = '"') then
        inc(s3)
      else
        inc(len);

      lastchar := s2^;
      inc(s2);
    end;

    if (len > 0) and (lastchar = '"') then
      dec(len);

    strlcopy(compstr,s3,len);
    flag3 := True;
  end;

  if (flag3) then
  begin
    if strpos(s0a,larger) = nil then
      flag1 := flag3;
    if strpos(s0a,smaller) = nil then
      flag2 := flag3;
  end;

  if (strpos(s0a,logor) <> nil) then
    if flag1 or flag2 then
    begin
      matches := oksmaller or oklarger;
      Exit;
    end;

  if (strpos(s0a,logand)<>nil) then
    if flag1 and flag2 then
    begin
      matches := oksmaller and oklarger;
      Exit;
    end;

  if ((strpos(s0a,larger) <> nil) and (oklarger)) or
     ((strpos(s0a,smaller) <> nil) and (oksmaller)) then
  begin
    matches := True;
    Exit;
  end;

  s0 := s0a;
  s1 := s1a;

  matching := True;

  done := (s0^ = NULL) and (s1^ = NULL);

  while not done and matching do
  begin
    case s0^ of
    qmark:
      begin
        matching := s1^ <> NULL;
        if matching then
        begin
          inc(s0);
          inc(s1);
        end;
      end;
    negation:
      begin
        negflag:=True;
        inc(s0);
      end;
    '"':
      begin
        inc(s0);
      end;
    (*
    '\':
      begin
        inc(s0);
        matching := s0^ = s1^;

        if matching then
        begin
          inc(s0);
          inc(s1);
        end;
      end;
    *)
    asterix:
      begin
        repeat
          inc(s0)
        until (s0^ <> asterix);
        len := strlen(s1);
        inc(s1,len);
        matching := matches(s0,s1);
        while (len >= 0) and not matching do
        begin
         dec(s1);
         dec(len);
         matching := Matches(s0,s1);
       end;
       if matching then
       begin
         s0 := strend(s0);
         s1 := strend(s1);
       end;
     end;
   else
     begin
       matching := s0^ = s1^;

       if matching then
       begin
         inc(s0);
         inc(s1);
       end;
     end;
   end;

   Done := (s0^ = NULL) and (s1^ = NULL);
  end;

  if negflag then
    Matches := not matching
  else
    Matches := matching;
end;

function StripLogicSpaces(s: string): string;
var
  i, k: integer;
  q: integer;
begin

  q := 0;
  {$IFDEF DELPHI_LLVM}
  i := 0;
  k := length(s) - 1;
  {$ELSE}
  i := 1;
  k := length(s);
  {$ENDIF}
  Result := '';

  while (i <= k) do
  begin
    if s[i] = '"' then
      inc(q);

    if (s[i] = ' ') then
    begin
      if odd(q) then
        result := result + s[i];
    end
    else
      Result := Result + s[i];

    inc(i);
  end;
end;


function FirstChar(Charset: TCharSet;s:string;var spos: integer):char;
var
  i:Integer;
  q: Integer;

  function InArray(ch: char): boolean;
  var
    j: integer;
  begin
    result := false;
    for j := 0 to High(CharSet) - 1 do
    begin
      if ch = CharSet[j] then
      begin
        result := true;
        break;
      end;
    end;
  end;


begin
  {$IFDEF DELPHI_LLVM}
  i := 0;
  {$ELSE}
  i := 1;
  {$ENDIF}
  q := 0;
  spos := -1;
  Result := #0;

  while i <= Length(s) do
  begin
    if s[i] = '"' then
      inc(q);

    if (InArray(s[i])) and not odd(q) then
    begin
      spos := i;
      Result := s[i];
      Break;
    end;
    Inc(i);
  end;
end;

function ClosingParenthesis(s1: string): integer;
var
  i,j,k,r: integer;
begin
  r := 0;
  j := 0;
  k := 0;
  {$IFDEF DELPHI_LLVM}
  i := 0;
  {$ELSE}
  i := 1;
  {$ENDIF}

  while (i <= length(s1)) do
  begin
    if (s1[i] = ')') then
      inc(k);

    if (s1[i] = '(') then
      inc(j);

    if (s1[i] = ')') and (j = k) then
    begin
      r := i;
      break;
    end;


    inc(i);
  end;

  Result := r;
end;



function MatchStrEx(s1,s2:string;DoCase:Boolean): Boolean;
var
  ch,lastop: Char;
  sep,cp: Integer;
  res,newres: Boolean;
  CharArray: TCharSet;

begin
  // remove leading & trailing spaces
  s1 := Trim(s1);

//  outputdebugstring(pchar('matchstrex:'+s1));

  // remove spaces between multiple filter conditions
  s1 := StripLogicSpaces(s1);

  if VarPos('=',s1,sep) = 1 then
    Delete(s1,sep,1);

  LastOp := #0;
  Res := True;

  SetLength(CharArray,5);
  CharArray[0] := '(';
  CharArray[1] := ';';
  CharArray[2] := '^';
  CharArray[3] := '&';
  CharArray[4] := '|';

  repeat
    ch := FirstChar(CharArray,s1, sep);

    // extract first part of filter
    if ch <> #0 then
    begin
      //VarPos(ch,s1,sep);

      {$IFDEF DELPHI_LLVM}
      if (length(s1) > 0) and (s1[0] = '(') and (pos('(',s1) > 0) then
      {$ELSE}
      if (length(s1) > 0) and (s1[1] = '(') and (pos('(',s1) > 0) then
      {$ENDIF}
      begin // found start of parenthesis
        cp := ClosingParenthesis(s1);
        NewRes := MatchStrEx(copy(s1,2,cp - 2),s2,DoCase);
        delete(s1,1,cp);
      end
      else
      begin
        NewRes := MatchStr(Copy(s1,1,sep - 1),s2,DoCase);
        Delete(s1,1,sep);
      end;

      if LastOp = #0 then
        Res := NewRes
      else
        case LastOp of
        ';','^','|':Res := Res or NewRes;
        '&':Res := Res and NewRes;
        end;

      LastOp := ch;
     end;

  until (ch = #0);

  NewRes := MatchStr(s1,s2,DoCase);

  if LastOp = #0 then
    Res := NewRes
  else
    case LastOp of
    ';','^','|':Res := Res or NewRes;
    '&':Res := Res and NewRes;
    end;

  Result := Res;
end;


function GetToken(var s:string;separator:string):string;
var
  sp:Integer;
begin
  Result := '';
  sp := Pos(separator,s);
  if sp > 0 then
  begin
    Result := Copy(s,1,sp - 1);
    Delete(s,1,sp);
  end;
end;


function GetNextLine(var s:string;multiline:boolean = True):string;
var
  vp: Integer;
begin
  if VarPos(LINEFEED,s,vp) > 0 then
  begin
    Result := Copy(s,1,vp-1);
    Delete(s,1,vp);
    if s<>'' then
      if s[1] = #10 then
        Delete(s,1,1);
    if not Multiline then
      s := '';
  end
  else
  begin
    Result := s;
    s := '';
  end;
end;


function Lftofile(s:string):string;
var
  i:Integer;
begin
  if Pos(#13,s) > 0 then
  {$IFDEF DELPHI_LLVM}
  for i := 0 to length(s) - 1 do
  {$ELSE}
  for i := 1 to length(s) do
  {$ENDIF}
    begin
      if s[i] = #13 then s[i] := #9;
      if s[i] = #10 then s[i] := #8;
      if s[i] = #0 then s[i] := #1;

    end;
  LFToFile := s;
end;


function FileToLF(s:string;multiline:boolean = true):string;
var
  i:Integer;
begin
  if Pos(#8,s)>0 then
  {$IFDEF DELPHI_LLVM}
  for i := 0 to length(s) - 1 do
  {$ELSE}
  for i := 1 to length(s) do
  {$ENDIF}
    begin
      if s[i] = #9 then s[i] := #13;
      if s[i] = #8 then s[i] := #10;
      if s[i] = #1 then s[i] := #0;
    end;
  if not MultiLine then
    FileToLF := GetNextLine(s,multiline)
  else
    FiletoLF := s;
end;


procedure LineFeedsToCSV(var s:string);
var
  vp: Integer;
begin
  while VarPos(#13#10,s,vp)>0 do
  begin
    Delete(s,vp,1);
    s[vp] := #11;
  end;
  s := '"' + s + '"';
end;

procedure LineFeedsToCSVNQ(var s:string);
var
  vp: Integer;
begin
  while VarPos(#13#10,s,vp)>0 do
    Delete(s,vp,1);
end;

function LinesInText(s:string;multiline:boolean = true):Integer;
var
  vp: Integer;
begin
  Result := 1;
  if not Multiline then Exit;
  while VarPos(LINEFEED,s,vp)>0 do
  begin
    Inc(Result);
    Delete(s,1,vp);
  end;
end;


function CheckNum(ch:char): boolean;
begin
  Result := ch.IsNumber;
end;

function CheckSignedNum(ch:char): boolean;
begin
  Result := ch.IsNumber or (ch = '-');
end;


function CheckExpNum(ch:char): boolean;
begin
  Result := ch.IsNumber or (ch = 'e') or (ch = 'E');
end;


function CheckFloatNum(ch: char): boolean;
begin
  Result := ch.IsNumber or (ch = FormatSettings.ThousandSeparator) or (ch = FormatSettings.DecimalSeparator) or (ch = 'e') or (ch = 'E');
end;

function CheckSignedDottedNum(ch: char): boolean;
begin
  Result := ch.IsNumber or (ch = '.') or (ch = '-') or (ch = 'e') or (ch = 'E') or (ch = '+');
end;

function CheckSignedFloatNum(ch: char): boolean;
begin
  Result := CheckFloatNum(ch) or (ch ='+') or (ch = '-');
end;

function IsType(s:string): TAutoType;
var
  i: Integer;
  isI,isF,isS: Boolean;
  th,de,mi: Integer;
  isE: boolean;

begin
  Result := atString;
  if s = '' then Exit;

  isI := True;
  isF := True;
  isS := True;
  isE := False;

  th := -1;
  de := 0;
  mi := 0;

  {$IFDEF DELPHI_LLVM}
  for i := 0 to length(s) - 1 do
  {$ELSE}
  for i := 1 to length(s) do
  {$ENDIF}
  begin
    if not CheckSignedNum(s[i]) then
      isI := False;

    if (s[i] = 'e') or (s[i] = 'E') then
    begin
      if isE then
        isS := false;
      isE := true;
    end;

    // - sign must be first char
    if (i > 1) and (s[i] = '-') then
    begin
      isI := false;
      isF := false;
    end;

    if (i = 1) and ((s[i] = 'e') or (s[i] = 'E')) then
      isS := false;

    if (i = length(s)) and ( (s[i] = 'e') or (s[i] = 'E') or (s[i] = '+') or (s[i] = '-') ) then
      isS := false;

    if not (CheckNum(s[i]) or (s[i] = '-') or (s[i] = FormatSettings.ThousandSeparator) or (s[i] = FormatSettings.DecimalSeparator) ) then
      isF := False;

    if not (CheckSignedFloatNum(s[i]) and (s[i] <> FormatSettings.ThousandSeparator)) then
      isS := False;

    if (s[i] = FormatSettings.ThousandSeparator) and (i - th < 4) and (th <> -1) then
    begin
      isF := False;
    end;

    if (s[i] = FormatSettings.ThousandSeparator) then
    begin
      th := i;
    end;

    if (s[i] = FormatSettings.DecimalSeparator) then
      Inc(de);
    if (s[i] = '-') then
      Inc(mi);
  end;

  if isI then
    Result := atNumeric
  else
  begin
    if isF and not isE then
      Result := atFloat;
    if isS and isE then
    begin
      if mi = 2 then
        mi := 1;
      Result := atScientific;
    end;
  end;

  if (mi > 1) or (de > 1) then
    Result := atString;
end;

function HTMLLineBreaks(s:string):string;
var
  i: Integer;
  res: String;
begin
  res := '';

  if Pos(#13,s) = 0 then
    res := s
  else
  {$IFDEF DELPHI_LLVM}
  for i := 0 to length(s) - 1 do
  {$ELSE}
  for i := 1 to length(s) do
  {$ENDIF}
    begin
      if s[i] <> #13 then
        res := res + s[i]
      else
        res := res + '<br>';
    end;

  Result := res;
end;

function HTMLColor(l:dword):string;
const
  HexDigit:array[0..$F] of char = '0123456789ABCDEF';

var
  lw,hw: Word;
begin
  lw := l and $FFFF;
  hw := (l and $FFFF0000) shr 16;
  HTMLColor := HexDigit[Lo(hw) shr 4]+HexDigit[Lo(hw) and $F]+
               HexDigit[Hi(lw) shr 4]+HexDigit[Hi(lw) and $F]+
               HexDigit[Lo(lw) shr 4]+HexDigit[Lo(lw) and $F];
end;

function IPos(su,s:string):Integer;
begin
  Result := Pos(UpperCase(su),UpperCase(s));
end;

function TagReplaceString(const Srch,Repl:string;var Dest:string):Boolean;
var
  i: Integer;
begin
  i := IPos(srch,dest);
  if i > 0 then
  begin
    Result := True;
    Delete(Dest,i,Length(Srch));
    Dest := Copy(Dest,1,i-1) + Repl + Copy(Dest,i,Length(Dest));
  end
  else
    Result := False;
end;


function FixNonBreaking(su: string): string;
begin
  while Pos(' ',su) > 0 do
  begin
    TagReplacestring(' ','&nbsp;',su);
  end;
  Result := su;
end;

function FixMarkup(su:string): string;
var
  i: integer;
begin
  while Pos('&',su) > 0 do
  begin
    TagReplacestring('&','*amp;',su);
  end;

  while Pos('*amp;',su) > 0 do
  begin
    TagReplacestring('*amp;','&amp;',su);
  end;

  while Pos('"',su) > 0 do
  begin
    TagReplacestring('"','&quot;',su);
  end;

  while Pos('<',su) > 0 do
  begin
    TagReplacestring('<','&lt;',su);
  end;

  while Pos('>',su) > 0 do
  begin
    TagReplacestring('>','&gt;',su);
  end;

  for i := 1 to NumSpecialChar do
  begin
    while Pos(string(HTMLEncodedChar[i]),su) > 0 do
    begin
      TagReplacestring(string(HTMLEncodedChar[i]),string(HTMLSpecialChar[i]),su);
    end;
  end;

  Result := su;
end;

function IsURL(const s:string):boolean;
begin
  Result := (Pos('://',s) > 0) or (Pos('mailto:',s) > 0);
end;

end.

