Delphi World - Поиск текста в текстовых файлах
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Поиск текста в текстовых файлах

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

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 ubersetzt 
  // 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 fur Turbosearch 
  Look_At: Integer;                   // Look_At-Position fur 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 (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;

 end.
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования