Suche

[DBR]

Delphi-Quellcode:

const
  Delimiters = [#1..#47, #58..#64, #91..#96, #123..#191, #215, #216, #247, #248];
  Delimiters_0 = [#0] + Delimiters;

procedure GetWords(s: string; woerter: TStrings);
var
  p, r: pchar;
  Token: string;
begin
  woerter.Clear;
  p := pchar(s);
  repeat
    r := p;
    while not (p^ in Delimiters_0) do inc(p);
    SetString(Token, r, p - r);
    if Token <> '' then woerter.Add(Token);
    while p^ in Delimiters do inc(p);
  until p^ = #0;
end;

function such(Txt, Pattern: string): boolean;
var
  slP: TStringlist;
  x: integer;
  pt: PChar;
  p: array of PChar;
  i: array of integer;
  b: array of boolean;
begin
  if (Txt = '') or (Pattern = '') then begin
    result := false;
    exit;
  end;
  Txt := ansiuppercase(Txt);
  Pattern := ansiuppercase(Pattern);
  slP := TStringlist.Create;
  GetWords(Pattern, slP);
  setlength(p, slP.count);
  setlength(i, slP.count);
  setlength(b, slP.count);
  for x := 0 to slP.count - 1 do begin
    p[x] := @slP[x][1];
    i[x] := length(slP[x]);
    b[x] := false;
  end;
  pt := @Txt[1];
  while pt^ <> #0 do begin
    for x := 0 to high(p) do
      if comparemem(pt, p[x], i[x]) then b[x] := true;
    inc(pt);
    result := true;
    for x := 0 to high(b) do
      result := result and b[x];
    if result then break;
  end;
  b := nil;
  i := nil;
  p := nil;
  slP.free;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  suchtext: string;
begin
  suchtext := 'Das Haus';
  if such('Ein schönes Haus, das ist klar.', suchtext)
    then showmessage('"' + suchtext + '" ist vorhanden') else
    showmessage('"' + suchtext + '" ist nicht vorhanden');
end;