// Hier eine schnelle Art und Weise, eine Zeichenkette in einem Text zu finden.
// Die Methode geht auf
Boyer & Moore zurück und fußt darauf, dass
// man einen ganzen Block vorrücken kann, wenn kein Zeichen des
// Suchbegriffes im durchsuchten Textblock vorhanden ist. Somit werden
// Textstellen nicht mehrmals in die Suche einbezogen, was aber passieren
// kann, wenn man bei der Suche immer nur Zeichen für Zeichen im Text vorrückt.


// Getestet mit D4 unter XP

function BoyerMooreSuche(SB, Txt: string): integer; 
var 
  Tabelle: array[0..255] of integer; 
  SBLen, SBIdx, Posi, Idx, Diff: integer; 
begin 
  result := 0; 
  if SB = '' then exit; 
  fillchar(Tabelle, sizeof(Tabelle), -1); 
  SBLen := Length(SB); 
  for SBIdx := 1 to SBLen do 
    Tabelle[Ord(SB[SBIdx])] := SBIdx; 
  Diff := Length(Txt) - SBLen; 
  SBIdx := 1; 
  Idx := 0; 
  while (SBIdx > 0) and (Idx <= Diff) do 
  begin 
    SBIdx := SBLen; 
    while (SB[SBIdx] = Txt[Idx + SBIdx]) and (SBIdx > 0) do 
      Dec(SBIdx); 
    if SBIdx > 0 then begin 
      Posi := Tabelle[Ord(Txt[Idx + SBIdx])]; 
      if Posi = -1 then Inc(Idx, SBIdx) 
      else if Posi > SBIdx then Inc(Idx, 1) 
      else Inc(Idx, SBIdx - Posi); 
    end; 
  end; 
  if SBIdx = 0 then result := Idx + 1; 
end; 
// Beispielaufruf: Ein Memo durchsuchen.
// Bei jedem Klick auf den Button wird 
// zur nächsten Fundstelle gesprungen 

const 
  stelle: integer = 0; 
 
procedure TextBoxSuche(cm: TCustomMemo; suche: string); 
var 
  lg, start: integer; 
begin 
  lg := length(suche); 
  start := stelle + BoyerMooreSuche(suche, copy(cm.text, stelle, maxint)) 
    - ord(stelle > 0); 
  if start > 0 then begin 
    if start <> stelle - 1 then begin 
      stelle := start; 
      cm.selstart := stelle - 1; 
      cm.perform(em_scrollcaret, 0, 0); 
      cm.sellength := lg; 
      inc(stelle, lg); 
    end else begin 
      stelle := 0; 
      cm.sellength := 0; 
      showmessage('Bis zum Ende durchsucht.'#13'Suche beginnt am Anfang.'); 
    end; 
  end else showmessage('Suchbegriff nicht vorhanden.'); 
  cm.setfocus; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  memo1.lines.loadfromfile('c:\windows\comsetup.log'); // z.B.
  memo1.scrollbars := ssBoth; 
end; 
 
procedure TForm1.Button9Click(Sender: TObject); 
begin 
  textboxsuche(Memo1, 'Gemeinsame Dateien'); 
end; 



Zugriffe seit 6.9.2001 auf Delphi-Ecke