unitsearchstring.pas

Delphi的另一款钢琴软件

begin
  if not fCaseSensitive then
    AString := UpperCase (AString);
  ok := mMaybe;

  for i := 0 to nOrWords - 1 do
    if WildContains (AString, fOrWords [i]) then
    begin
      ok := mYes;
      break
    end;

  if ok = mMaybe then
    for i := 0 to nAndWords - 1 do
      if not WildContains (AString, fAndWords [i]) then
      begin
        ok := mNo;
        break
      end;

  if ok = mMaybe then
    for i := 0 to nNotWords - 1 do
      if WildContains (AString, fNotWords [i]) then
      begin
        ok := mNo;
        break
      end;

  if ok = mMaybe then
    result := (nAndWords > 0) or (nNotWords > 0)
  else
    result := ok = mYes

end;

{ TGoogleLikeStringSearcher }

procedure TGoogleLikeStringSearcher.Parse(searchString: string);
type
  tOP = (opAnd, opOr, opNot);
var
  l : Integer;
  s1 : string;
  op : tOp;

  procedure AddToVarArray (var arr : TStrArray; const st : string; var n : Integer);
  begin
    if n = Length (arr) then
      SetLength (arr, n + 5);
    arr [n] := st;
    Inc (n)
  end;

begin
  if CompareText (fSearchString, searchString) = 0 then
    Exit;
  fSearchString := searchString;
  nAndWords := 0;
  nOrWords := 0;
  nNotWords := 0;
  if not fCaseSensitive then
    searchString := UpperCase (searchString);

  l := Length (searchString);
  op := opAnd;
  while l > 0 do
  begin
    case searchString [1] of
      '+' :
        begin
          op := opAnd;
          Delete (searchString, 1, 1);
          l := Length (searchString);
        end;
      '-' :
        begin
          op := opNot;
          Delete (searchString, 1, 1);
          l := Length (searchString);
        end
    end;

    if l = 0 then break;

    if searchString [1] = '"' then
    begin
      Delete (searchString, 1, 1);
      s1 := SplitString ('"', searchString)
    end
    else
    begin
      s1 := SplitString (' ', searchString);
      if UpperCase (s1) = 'OR' then
      begin
        op := opOR;
        l := Length (searchString);
        continue
      end
    end;

    if s1 <> '' then
      case op of
        opAnd : AddToVarArray (fAndWords, s1, nAndWords);
        opOr  : AddToVarArray (fOrWords, s1, nOrWords);
        opNot : AddToVarArray (fNotWords, s1, nNotWords)
      end;

    op := opAnd;
    l := Length (searchString)
  end
end;

{ TWideStringSearcher }

constructor TWideStringSearcher.Create(const ASearchString: WideString; ACaseSensitive : boolean);
begin
  fCaseSensitive := ACaseSensitive;
  fSearchString := ASearchString;
  Parse (ASearchString)
end;

function TWideStringSearcher.Matches(AString: WideString): boolean;
type
  TMatch = (mYes, mNo, mMaybe);
var
  i : Integer;
  ok : TMatch;

begin
  if not fCaseSensitive then
    AString := WideUpperCase (AString);
  ok := mMaybe;

  for i := 0 to nOrWords - 1 do
    if WWildContains (AString, fOrWords [i]) then
    begin
      ok := mYes;
      break
    end;

  if ok = mMaybe then
    for i := 0 to nAndWords - 1 do
      if not WWildContains (AString, fAndWords [i]) then
      begin
        ok := mNo;
        break
      end;

  if ok = mMaybe then
    for i := 0 to nNotWords - 1 do
      if WWildContains (AString, fNotWords [i]) then
      begin
        ok := mNo;
        break
      end;

  if ok = mMaybe then
    result := (nAndWords > 0) or (nNotWords > 0)
  else
    result := ok = mYes
end;

{ TGoogleLikeWideStringSearcher }

procedure TGoogleLikeWideStringSearcher.Parse(searchString: WideString);
type
  tOP = (opAnd, opOr, opNot);
var
  l : Integer;
  s1 : WideString;
  op : tOp;

  procedure AddToVarArray (var arr : TWStrArray; const st : WideString; var n : Integer);
  begin
    if n = Length (arr) then
      SetLength (arr, n + 5);
    arr [n] := st;
    Inc (n)
  end;

begin
  if WideCompareText (fSearchString, searchString) = 0 then
    Exit;
  fSearchString := searchString;
  nAndWords := 0;
  nOrWords := 0;
  nNotWords := 0;
  if not fCaseSensitive then
    searchString := WideUpperCase (searchString);

  l := Length (searchString);
  op := opAnd;
  while l > 0 do
  begin
    case searchString [1] of
      '+' :
        begin
          op := opAnd;
          Delete (searchString, 1, 1);
          l := Length (searchString);
        end;
      '-' :
        begin
          op := opNot;
          Delete (searchString, 1, 1);
          l := Length (searchString);
        end
    end;

    if l = 0 then break;

    if searchString [1] = '"' then
    begin
      Delete (searchString, 1, 1);
      s1 := WideSplitString ('"', searchString)
    end
    else
    begin
      s1 := WideSplitString (' ', searchString);
      if WideUpperCase (s1) = 'OR' then
      begin
        op := opOR;
        l := Length (searchString);
        continue
      end
    end;

    if s1 <> '' then
      case op of
        opAnd : AddToVarArray (fAndWords, s1, nAndWords);
        opOr  : AddToVarArray (fOrWords, s1, nOrWords);
        opNot : AddToVarArray (fNotWords, s1, nNotWords)
      end;

    op := opAnd;
    l := Length (searchString)
  end
end;

function SearchStringArray (arr : array of string; const st : string) : Integer;

  function bsearch (s, e : Integer) : Integer;
  var
    m, c : Integer;
  begin
    if s <= e then
    begin
      m := s + (e - s) div 2;

      c := CompareText (st, arr [m]);

      if c = 0 then
        result := m
      else
        if c > 0 then
          result := bsearch (m + 1, e)
        else
          result := bsearch (s, m - 1)
    end
    else
      result := -1
  end;

begin
  result := bsearch (Low (arr), High (arr))
end;

function StringArrayContains (arr : array of string; const st : string) : boolean;
begin
  result := SearchStringArray (arr, st) >= 0
end;

function WideDequotedStr (st : WideString; q : WideChar) : WideString;
var
  i, l : Integer;
begin
  l := Length (st);
  if (l > 0) and (st [1] = q) then
  begin
    i := 2;
    while i <= l do
      if st [i] = q then
      begin
        if (i + 1 <= l) and (st [i + 1] = q) then
        begin
          Delete (st, i, 1);
          Inc (i);
          Dec (l);
        end
        else
        begin
          Dec (i,2);
          break
        end
      end
      else
        Inc (i);
    result := Copy (st, 2, i);
  end
end;

function WideQuotedStr (st : WideString; q : WideChar) : WideString;
var
  I: Integer;
begin
  Result := St;
  for I := Length(Result) downto 1 do
    if Result[I] = q then Insert(q, Result, I);
  Result := q + Result + q;
end;

function DelimPos (const delims : string; const st : string; out delim : char) : Integer;
var
  i, p : Integer;
begin
  if delims = '' then
  begin
    result := 0;
    exit
  end;

  result := MaxInt;
  for i := 1 to Length (delims) do
  begin
    p := Pos (delims [i], st);
    if (p > 0) and (p < result) then
    begin
      delim := delims [i];
      result := p
    end
  end;

  if result = MaxInt then
    result := 0
end;

function DelimSplitString (const search : string; var s : string; out delim : char) : string;
var
  p : Integer;
begin
  p := DelimPos (search, s, delim);
  if p > 0 then
  begin
    result := Trim (Copy (s, 1, p - 1));
    s := Trim (Copy (s, p + 1, maxInt))
  end
  else
  begin
    result := Trim (s);
    s := ''
  end
end;

end.