was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1547)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (115)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (127)
Strings (83)
System (268)
VCL (243)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

24 Visitors Online


 
...Textdateien nach Text durchsuchen?
Autor: Hansjörg Hassler
[ Tip ausdrucken ]  

Tip Bewertung (5):  
     


unit Unit1;

interface

uses
  
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;

type
  
TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
  private
    
{ Private-Deklarationen }
  
public
    
{ Public-Deklarationen }
  
end;

var
  
Form1: TForm1;



  // Aus einem alten c't-Heft von C nach Delphi übersetzt
  // Deklarationsteil

procedure Ts_init(P: PChar; m: Integer);
function Ts_Search(Text, p: PChar; m: Integer; Start: Longint): Longint;



  // Globale Variablen
  // *****************


var

  
shift: array[0..255] of Byte;     // Shifttabelle für Turbosearch
  
Look_At: Integer;                   // Look_At-Position für Turbosearch



implementation

{$R *.DFM}


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 (Musterlänge+1)
  //     initialisiert.
  //  2. Für jedes Zeichen im Muster wird seine Position (von hinten gezählt) in
  //     der Shift-Tabelle eingetragen.
  //     Für das Muster "Hans" würden folgende Shiftpositionen ermittelt werde:
  //      Für H  = ASCII-Wert = 72d ,dass von hinten gezählt an der 4. Stelle ist,
  //                                 wird Shift[72] := 4 eingetragen.
  //      Für a  = 97d   = Shift[97]  := 3;
  //      Für n  = 110d  = Shift[110] := 2;
  //      Für 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 überschrieben 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*Musterlänge 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 auslösen  (hier beim drücken eines Speedbuttons auf FORM1)

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  
tt: string;
  L: Integer;
  L2, sp, a: Longint;
  F: file;         // File-Alias
  
Size: Integer;   // Textlänge
  
Buffer: PChar;   // Text-Memory-Buffer
begin
  
tt := Edit1.Text;      // Suchmuster
  
L  := Length(TT);      // Suchmusterlänge
  
ts_init(PChar(TT), L); // Sprungtabelle für Suchmuster initialisieren
  
try
    
AssignFile(F, 'test.txt');
    Reset(F, 1);                   // File öffnen
    
Size := FileSize(F);           // Filegrösse ermitteln
    
GetMem(Buffer, Size + L + 1);      // Memory reservieren in der Grösse von
    // TextFilelänge+Musterlänge+1
    
try
      
BlockRead(F, Buffer^, Size);  // Filedaten in den Buffer füllen
      
StrCat(Buffer, PChar(TT));     // Suchmuster ans Ende des Textes anhängen
      // damit der Suchalgorythmus keine Fileende-
      // Kontrolle machen muss.
      // Turbo-Search

      
SP := 0;               // Startpunkt der Suche im Text
      
A  := 0;               // Anzahl-gefunden-Zähler
      
while SP < Size do
      begin
        
L2 := Ts_Search(Buffer, PChar(TT), L, SP); // L = Musterlänge
        // SP= Startposition im Text

        
SP := L2 + L; // StartPosition auf Letzte gefundene Position+Musterlänge
        
Inc(a);     // Anzahl gefunden Zähler
      
end;
      // Am Schluss nicht vergessen Buffer freigeben und Inputfile schliessen
    
finally
      
FreeMem(Buffer);              // Memory freigeben.
    
end;
  finally
    
CloseFile(F);                   // Datei schliessen.
  
end;
end;

end.


 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners