• Что бы вступить в ряды "Принятый кодер" Вам нужно:
    Написать 10 полезных сообщений или тем и Получить 10 симпатий.
    Для того кто не хочет терять время,может пожертвовать средства для поддержки сервеса, и вступить в ряды VIP на месяц, дополнительная информация в лс.

  • Пользаватели которые будут спамить, уходят в бан без предупреждения. Спам сообщения определяется администрацией и модератором.

  • Гость, Что бы Вы хотели увидеть на нашем Форуме? Изложить свои идеи и пожелания по улучшению форума Вы можете поделиться с нами здесь. ----> Перейдите сюда
  • Все пользователи не прошедшие проверку электронной почты будут заблокированы. Все вопросы с разблокировкой обращайтесь по адресу электронной почте : info@guardianelinks.com . Не пришло сообщение о проверке или о сбросе также сообщите нам.

Delphi Поиск Текста В Текстовых Файлах

  • Автор темы Автор темы Sascha
  • Дата начала Дата начала

Sascha

Заместитель Администратора
Команда форума
Администратор
Регистрация
9 Май 2015
Сообщения
1,551
Баллы
155
Поиск текста в текстовых файлах:

Код:
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.
 
Вверх Снизу