procedure Ts_init(P: PChar; m: Integer); var i: Integer; begin // *** Suchmuster analysieren ****
{1.} for i := 0 to 255 do shift[i] := m + 1; {2.} for i := 0 to m - 1 do Shift[Ord(p[i])] := m - i;
Look_at := 0;
{3.} while (look_At < m - 1) do begin if (p[m - 1] = p[m - (look_at + 2)]) then Exit else Inc(Look_at, 1); end;
// *** Beschreibung **** // 1. Sprungtabelle Shift[0..255] wird mit der max. Sprungweite (Musterlange+1) // initialisiert. // 2. Fur jedes Zeichen im Muster wird seine Position (von hinten gezahlt) in // der Shift-Tabelle eingetragen. // Fur das Muster "Hans" wurden folgende Shiftpositionen ermittelt werde: // Fur H = ASCII-Wert = 72d ,dass von hinten gezahlt an der 4. Stelle ist, // wird Shift[72] := 4 eingetragen. // Fur a = 97d = Shift[97] := 3; // Fur n = 110d = Shift[110] := 2; // Fur s = 115d = Shift[115] := 1; // Da das Muster von Vorn nach Hinten durchsucht wird, sind doppelt auf- // tretende Zeichen kein Problem. Die Shift-Werte werden uberschrieben und // mit der kleinsten Sprungweite automatisch aktualisiert. // 3. Untersucht wo (position von hinten) das Letzte Zeichen im Muster // nochmals vorkommt und Speichert diese in der Variable Look_AT. // Die Maximale Srungweite beim Suchen kann also 2*Musterlange sein wenn // das letzte Zeichen nur einmal im Muster vorhanden ist. end;
function Ts_Search(Text, p: PChar; m: Integer; Start: Longint): Longint; var I: Longint; T: PChar; begin T := Text + Start; // Zeiger auf Startposition im Text setzen Result := -1; repeat i := m - 1; // Letztes Zeichen des Suchmusters im Text suchen. while (t[i] <> p[i]) do t := t + shift[Ord(t[m])]; i := i - 1; // Vergleichszeiger auf vorletztes Zeichen setzen if i < 0 then i := 0; // wenn nach nur einem Zeichen gesucht wird, // kann i = -1 werden. // restliche Zeichen des Musters vergleichen while (t[i] = p[i]) do begin if i = 0 then Result := t - Text; i := i - 1; end; // Muster nicht gefunden -> Sprung um max. 2*m if Result = -1 then t := t + Look_AT + shift[Ord(t[m + look_at])]; until Result <> -1; // Repeat end;
// Such-Procedure auslosen (hier beim drucken eines Speedbuttons auf FORM1)
procedure TForm1.SpeedButton1Click(Sender: TObject); var tt: string; L: Integer; L2, sp, a: Longint; F: file; // File-Alias Size: Integer; // Textlange Buffer: PChar; // Text-Memory-Buffer begin tt := Edit1.Text; // Suchmuster L := Length(TT); // Suchmusterlange ts_init(PChar(TT), L); // Sprungtabelle fur Suchmuster initialisieren try AssignFile(F, ′test.txt′); Reset(F, 1); // File offnen Size := FileSize(F); // Filegrosse ermitteln GetMem(Buffer, Size + L + 1); // Memory reservieren in der Grosse von // TextFilelange+Musterlange+1 try BlockRead(F, Buffer^, Size); // Filedaten in den Buffer fullen StrCat(Buffer, PChar(TT)); // Suchmuster ans Ende des Textes anhangen // damit der Suchalgorythmus keine Fileende- // Kontrolle machen muss. // Turbo-Search
SP := 0; // Startpunkt der Suche im Text A := 0; // Anzahl-gefunden-Zahler while SP < Size do begin L2 := Ts_Search(Buffer, PChar(TT), L, SP); // L = Musterlange // SP= Startposition im Text
SP := L2 + L; // StartPosition auf Letzte gefundene Position+Musterlange Inc(a); // Anzahl gefunden Zahler end; // Am Schluss nicht vergessen Buffer freigeben und Inputfile schliessen finally FreeMem(Buffer); // Memory freigeben. end; finally CloseFile(F); // Datei schliessen. end; end;
