Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2007.05.20;
Скачать: [xml.tar.bz2];

Вниз

Поиск   Найти похожие ветки 

 
Человек   (2007-05-03 19:15) [0]

Здравствуйте, Мастера. Помогите разобраться с одной маленькой проблемкой.
Вот скажем у меня есть поле edit1 . Есть также текстовый файл test.txt, в котором набран текст. Необходимо , чтобы при вводе текста в edit1, производися поиск в test.txt . Я искал вот так вот :

procedure TForm2.Button1Click(Sender: TObject);
var
f:TStrings;
i: Integer; begin
f:= TStringList.Create();
f.LoadFromFile("c:\test.txt"); for i:=0 to f.Count-1 do begin if f.Strings[I] = form2.Edit1.Text then
Application.MessageBox("Строка найдена", "Поиск закончен", MB_OKCANCEL)
end;f.Free;
end;


но при таком вот поиске, получалось, что ищет он только построчно, и если ввести пробел в edit1 , то тоже ничего не находит. Как сделать правильный поиск?


 
Desdechado ©   (2007-05-03 20:10) [1]

> ищет он только построчно,
> Как сделать правильный поиск?
А тебе как надо?

PS Pos


 
Человек   (2007-05-03 22:38) [2]

Desdechado , Извиняюсь, я наверное неправильно выразился. Вобщем когда я ввожу в edit1 слово для поиска , например , "привет" а в файле test.txt первая строка "привет делфи бугага гыы" то он почему то не находит привет в этой строке, а если строка просто состоит из искомого слдова , то бишь "привет" , то делфи её с радостью обнаруживает.


 
Kostafey ©   (2007-05-03 23:45) [3]


if  Pos(form2.Edit1.Text, f.Strings[I])<>0 then
 Application.MessageBox("Строка найдена", "Поиск закончен", MB_OKCANCEL);


 
Novice   (2007-05-04 08:10) [4]

unit BMSearch;

(* -------------------------------------------------------------------

Поиск строки методом Boyer-Moore.

Это - один из самых быстрых алгоритмов поиска строки.
See a description in:

R. Boyer и S. Moore.
Быстрый алгоритм поиска строки.
Communications of the ACM 20, 1977, страницы 762-772
------------------------------------------------------------------- *)

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.

(С) DelphiWorld


 
Человек   (2007-05-04 09:34) [5]

Kostafey, спасибо большое.


 
Desdechado ©   (2007-05-04 12:00) [6]

Человек   (04.05.07 09:34) [5]
Постскриптумы не читаем, ага?


 
clickmaker ©   (2007-05-04 12:07) [7]


> [6] Desdechado ©   (04.05.07 12:00)

человеку "код давай", а то премии лишат
а ты тут со своими постскриптумами :)


 
Человек   (2007-05-04 15:57) [8]

Desdechado, ну уж извиняйте, вашего PS я не понял)))


 
Kostafey ©   (2007-05-04 16:28) [9]

> [6] Desdechado ©   (04.05.07 12:00)

Гм..да, следовало бы на Вас сослаться.
Теперь по судам затаскают за нарушение авторских прав :))



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2007.05.20;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.49 MB
Время: 0.039 c
1-1174570621
serg_new
2007-03-22 16:37
2007.05.20
Скачать карты из GoogleMap


2-1177733162
Cj
2007-04-28 08:06
2007.05.20
Программа открывающая файл


2-1177728215
Pekar
2007-04-28 06:43
2007.05.20
Имя текущего пользователя


15-1177080094
Scaltro
2007-04-20 18:41
2007.05.20
Нужна программа...


2-1178101289
sergeyst
2007-05-02 14:21
2007.05.20
Как закрыть нужную форму?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский