Поиск текста в текстовом файле

[alekstav]

Добрый день.
Я пытаюсь написать программу «Поиск слова в текстовом файле». В программировании я новичок, поэтому использую исходники найденные в Интернете. Однако не хватает знаний, чтоб дописать листинг, чтоб запустилась найденая программа.
Язык Delphi. Желательно поподробнее пояснить. Заранее спасибо.

unit BMSearch;


interface

type
{$IFDEF WINDOWS}

  size_t = Word;
{$ELSE}

  size_t = LongInt;
{$ENDIF}

type

  TTranslationTable = array[char] of char; { таблица перевода }

  TSearchBM = class(TObject)
  private
    FTranslate: TTranslationTable; { таблица перевода }
    FJumpTable: array[char] of Byte; { таблица переходов }
    FShift_1: integer;
    FPattern: pchar;
    FPatternLen: size_t;

  public
    procedure Prepare(Pattern: pchar; PatternLen: size_t; IgnoreCase: Boolean);
    procedure PrepareStr(const Pattern: string; IgnoreCase: Boolean);

    function Search(Text: pchar; TextLen: size_t): pchar;
    function Pos(const S: string): integer;
  end;

implementation

uses SysUtils;

// Игнорируем регистр таблицы перевода

procedure CreateTranslationTable(var T: TTranslationTable; IgnoreCase: Boolean);
var

  c: char;
begin

  for c := #0 to #255 do
    T[c] := c;

  if not IgnoreCase then
    exit;

  for c := 'a' to 'z' do
    T[c] := UpCase(c);

  {Связываем все нижние символы с их эквивалентом верхнего регистра}

  T['Б'] := 'A';
  T['А'] := 'A';
  T['Д'] := 'A';
  T['В'] := 'A';

  T['б'] := 'A';
  T['а'] := 'A';
  T['д'] := 'A';
  T['в'] := 'A';

  T['Й'] := 'E';
  T['И'] := 'E';
  T['Л'] := 'E';
  T['К'] := 'E';

  T['й'] := 'E';
  T['и'] := 'E';
  T['л'] := 'E';
  T['к'] := 'E';

  T['Н'] := 'I';
  T['М'] := 'I';
  T['П'] := 'I';
  T['О'] := 'I';

  T['н'] := 'I';
  T['м'] := 'I';
  T['п'] := 'I';
  T['о'] := 'I';

  T['У'] := 'O';
  T['Т'] := 'O';
  T['Ц'] := 'O';
  T['Ф'] := 'O';

  T['у'] := 'O';
  T['т'] := 'O';
  T['ц'] := 'O';
  T['ф'] := 'O';

  T['Ъ'] := 'U';
  T['Щ'] := 'U';
  T['Ь'] := 'U';
  T['Ы'] := 'U';

  T['ъ'] := 'U';
  T['щ'] := 'U';
  T['ь'] := 'U';
  T['ы'] := 'U';

  T['с'] := 'С';
end;

// Подготовка таблицы переходов

procedure TSearchBM.Prepare(Pattern: pchar; PatternLen: size_t;

  IgnoreCase: Boolean);
var

  i: integer;
  c, lastc: char;
begin

  FPattern := Pattern;
  FPatternLen := PatternLen;

  if FPatternLen < 1 then
    FPatternLen := strlen(FPattern);

  { Данный алгоритм базируется на наборе из 256 символов }

  if FPatternLen > 256 then
    exit;

  { 1. Подготовка таблицы перевода }

  CreateTranslationTable(FTranslate, IgnoreCase);

  { 2. Подготовка таблицы переходов }

  for c := #0 to #255 do
    FJumpTable[c] := FPatternLen;

  for i := FPatternLen - 1 downto 0 do
  begin
    c := FTranslate[FPattern[i]];
    if FJumpTable[c] >= FPatternLen - 1 then
      FJumpTable[c] := FPatternLen - 1 - i;
  end;

  FShift_1 := FPatternLen - 1;
  lastc := FTranslate[Pattern[FPatternLen - 1]];

  for i := FPatternLen - 2 downto 0 do
    if FTranslate[FPattern[i]] = lastc then
    begin
      FShift_1 := FPatternLen - 1 - i;
      break;
    end;

  if FShift_1 = 0 then
    FShift_1 := 1;
end;

procedure TSearchBM.PrepareStr(const Pattern: string; IgnoreCase: Boolean);
var

  str: pchar;
begin

  if Pattern <> '' then
  begin
{$IFDEF Windows}

    str := @Pattern[1];
{$ELSE}

    str := pchar(Pattern);
{$ENDIF}

    Prepare(str, Length(Pattern), IgnoreCase);
  end;
end;

{ Поиск последнего символа & просмотр справа налево }

function TSearchBM.Search(Text: pchar; TextLen: size_t): pchar;
var

  shift, m1, j: integer;
  jumps: size_t;
begin

  result := nil;
  if FPatternLen > 256 then
    exit;

  if TextLen < 1 then
    TextLen := strlen(Text);

  m1 := FPatternLen - 1;
  shift := 0;
  jumps := 0;

  { Поиск последнего символа }

  while jumps <= TextLen do
  begin
    Inc(Text, shift);
    shift := FJumpTable[FTranslate[Text^]];
    while shift <> 0 do
    begin
      Inc(jumps, shift);
      if jumps > TextLen then
        exit;

      Inc(Text, shift);
      shift := FJumpTable[FTranslate[Text^]];
    end;

    { Сравниваем справа налево FPatternLen - 1 символов }

    if jumps >= m1 then
    begin
      j := 0;
      while FTranslate[FPattern[m1 - j]] = FTranslate[(Text - j)^] do
      begin
        Inc(j);
        if j = FPatternLen then
        begin
          result := Text - m1;
          exit;
        end;
      end;
    end;

    shift := FShift_1;
    Inc(jumps, shift);
  end;
end;

function TSearchBM.Pos(const S: string): integer;
var

  str, p: pchar;
begin

  result := 0;
  if S <> '' then
  begin
{$IFDEF Windows}

    str := @S[1];
{$ELSE}

    str := pchar(S);
{$ENDIF}

    p := Search(str, Length(S));
    if p <> nil then
      result := 1 + p - str;
  end;
end;

end.

[Stilet]

Поиск слова в текстовом файле

Ты уверен что этот твой "не маленький" код делает именно это?
И еще ты уверен что все что прописано в твоем "не маленьком" коде обязательно нужно?
Просто есть однако средства попроще для поиска.

[_SERGEYX_]

Вывод: на стоит бездумно пользоваться чужими исходниками. Лучше потихоньку написать своё, понимая каждую строку.

[MyLastHit]

Хм, помоему, было бы проще и логичнее использовать в твоем случае функции Pos и метод Memo1.Lines.loadfromfile('путь') у мемо. Вот пример оооочень простенькой програмки для поиска текста в файле, написал ну максимум за 5 минут, показывает строки в которых найден твой текст, модернизировать можешь как душа пожелает:

[Overclocker]

Сообщение от MyLastHit

Хм, помоему, было бы проще и логичнее использовать в твоем случае функции Pos и метод Memo1.Lines.loadfromfile('путь') у мемо. Вот пример оооочень простенькой програмки для поиска текста в файле, написал ну максимум за 5 минут, показывает строки в которых найден твой текст, модернизировать можешь как душа пожелает:

Тогда как скопировать этот найденый текст в другой txt файл? А если данный текст отсутствует, который ищем, то как записать нами искомый текст в другой файл, чтобы в дальнейшем посчитать сколько раз данный текст небыл найден, при условии что в искомом тексте каждый день это текст может быть или отсутствовать???

[MyLastHit]

Тогда как скопировать этот найденый текст в другой txt файл?

Вот тебе- просто принцип пойми как сохранять, а циклы и операторы сам уж напиши:
I вариант сохранения в файл(Сохранение текста из мемо):

memo1.lines.savetofile('путь'+'\имя'+'.разрешение(например .txt)');

II вариант (Создание файла и добавлениев него строк):

var f1:System.Text;
begin   
    AssignFile(f1,'путь'+'\имя'+'.разрешение(например .txt)');
    try
      Append(f1);//добавляем строку в файл, при условии что он уже существует
    except
      rewrite(f1);//если файла нет то создаем его(вобще функция для переписывания файла, но и для создания годно)
    end;
    writeln(f1,edit1.text');//текст который надо добавить
    CloseFile(f1);
end;

[alekstav]

Всем спасибо.
На счет того, что этот КОД именно то делает.. не знаю... поэтому решил сам делать.
MyLastHit спасибо за исходник, буду думать, как его можно к себе присобачить.
Я сейчас также примерно сделал как у тебя (но более громоздко). Указываю расположение файла, задаю ключевое слово, открываю файл и через readln заполняю Memo…А вот дальше не могу пока сделать чтоб программа сравнивало каждую строчку txt-ка с этой string-овой переменной (ключевым словом)

[Overclocker]

MyLastHit Благодарю за помощь )))

Нужна подсказка :

 memo2.Lines.LoadFromFile(edit3.Text); // в edit3 задан путь где этот файл находится
// Z- это константа строкового типа
//надо найти в этом файле Z (текст) и удалить из файла находящегося в(edit3)
// вот код с помощью которого я пытаюсь удалить но не работает 
                                    
While pos (z,memo2.Lines.Text)>0 do
                              
 begin
                                      P:= POS(z,Memo2.Lines.Text);
                                      DELETE(Memo2.Lines.Text,P,Length(z)); // ашипко
                                      memo1.lines.savetofile('L1.txt');
  end;

может по иному как то или что не верно в этом коде?

[Johnson]

DELETE(Memo2.Lines.Text,P,Length(z) ); // ашипко

процедурами с возвращаемой переменной нельзи изменять проперти объектов.

твой вариант:

temp:=Memo2.Lines.Text;
DELETE(temp,P,Length(z) );
Memo2.Lines.Text:=temp;

не знаю твоего исходника, но вобще правильнее будет так даже:

temp:=Memo2.Text; // копируем текст мемо во временную переменную (тип string)
DELETE(temp,P,Length(z) ); // делаем с ней что надо - удаляем часть...
Memo2.Text:=temp; // запихиваем текст обратно из переменной в мемо

ЗЫ: а вобще что ты конкретно хочешь от программы? зачем в поисковике удаление? если нужно искать несколько одинаковых строк - то правильнее использовать PosEx из модуля StrUtils.
PosEx({слово},{текст},{смещение - номер символа в строке с которого начинать поиск}) = номер символа в строке

а ещё правильнее - почитать (ВНИМАТЕЛЬНО!!!) литературу или уроки по интересующей теме... к примеру http://www.delphi.int.ru/articles/118/