Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как найти далее при помощи pos? [D6, Win95/98]


Страницы:   1 2

Delphimun ©   (2002-01-07 11:55:00) 

Как найти далее при помощи pos?

Вот способ, который находит только одно искомое слово, а как искать следующее слово(аналог ныйти далее в блокноте windows-а)

if pos(finddialog1.FindText,RichEdit1.Text)<>0 then
begin
RichEdit1.HideSelection := false;
RichEdit1.SelStart := pos(finddialog1.FindText,RichEdit1.Text)-1;
RichEdit1.SelLength := length(finddialog1.findtext);

Anatoly Podgoretsky   (2002-01-09 20:51:00) [1]

Romkin © (09.01.02 11:46)
Result := P - PChar(S) + 1;

Romkin © (09.01.02 14:50)
Насчет ассеблерного алгоритма, комментировать особо не буду, только скажу что очень неэффективный алгоритм, используются аггрегатные команды, на современных процессорах большое пенальти.

Romkin © (09.01.02 17:32)
Насчет ума это верно. Если я тебе скажу, что при определенных условиях пузырьковый алгоритм бует быстрее быстрой сортировки - ты мне поверишь?

Romkin   (2002-01-09 17:32:00) [2]

2Андрей Сенченко:
Это уже цикл...
На самом деле, задача поиска подстроки довольно сложная, особенно это заметно при длинных строках - элементарный алгоритм работает долго, умный - летает... Все примерно как с сортировкой - пузырьком - не больше десятка чисел, quicksort - для больших массивов в виртуальной памяти, и тд

Андрей Сенченко   (2002-01-09 17:01:00) [3]

Не помню где, по-моему у Экслера была такая прибаутка:
Начинающий программист пишет
10 BEGIN
20 PRINT "HELLO WORLD"
...
далее опускаю
...
Супер крутой системщик пишет : ... и далее следовал код по-моему строк на 500 с такими изворотами, что просто мама дорогоая.

Song   (2002-01-09 15:14:00) [4]

Даааа, ребят, такоооое развернули из обычной несложной задачи... :)))

Romkin   (2002-01-09 14:50:00) [5]

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

function TailPos(const S, SubStr: string; fromPos: integer): integer;
asm
PUSH EDI
PUSH ESI
PUSH EBX
PUSH EAX
OR EAX,EAX
JE @@2
OR EDX,EDX
JE @@2
DEC ECX
JS @@2

MOV EBX,[EAX-4]
SUB EBX,ECX
JLE @@2
SUB EBX,[EDX-4]
JL @@2
INC EBX

ADD EAX,ECX
MOV ECX,EBX
MOV EBX,[EDX-4]
DEC EBX
MOV EDI,EAX
@@1: MOV ESI,EDX
LODSB
REPNE SCASB
JNE @@2
MOV EAX,ECX
PUSH EDI
MOV ECX,EBX
REPE CMPSB
POP EDI
MOV ECX,EAX
JNE @@1
LEA EAX,[EDI-1]
POP EDX
SUB EAX,EDX
INC EAX
JMP @@3
@@2: POP EAX
XOR EAX,EAX
@@3: POP EBX
POP ESI
POP EDI
end;

Romkin   (2002-01-09 11:46:00) [6]

Вариант - системный поиск
Нагло вырезана AnsiPos и переиначена на поиск с позиции

uses SysUtils;

function fAnsiPos(const Substr, S: string; FromPos: integer): Integer;
var
P: PChar;
begin
Result := 0;
P := AnsiStrPos(PChar(S) + fromPos - 1, PChar(SubStr));
if P <> nil then
Result := Integer(P) - Integer(PChar(S)) + 1;
end;
AnsiStrPos - можно просто вырезать из SysUtils

panov   (2002-01-08 20:28:00) [7]

>Romkin © (08.01.02 18:27)
Ну вот, а если завтра этот вопрос в FAQ попадет?

Romkin   (2002-01-08 18:27:00) [8]

Не смотрите на Romkin © (08.01.02 17:18),
я в смещениях запутался!!! и голова не работает, завтра, завтра...

Yaro   (2002-01-08 18:08:00) [9]

Люди, я чот не пойму, нафиг вам POS??? Прекрасно и без него обойтись можно...
Просто делайте по такому принципу:
Пусть текст, в котором надо осуществить поиск будет Text, а искомый кусок будет, скажем, F_text...
Производим сканирование посимвольно, ищем все вхождения (назовем это Text[i]) f_text[1], после того как нашли сравниваем Text[i+1] и f_text[2] и так далее... Если не подходит хотяб один знак в цикле проверки символов, идем дальше...
В принципе способ эффективный, так как не "жрет" сильно много "больших" сравнений, как было бы, если сранивать таким образом - if copy(Text, i, length(Text)) = f_text...

Romkin   (2002-01-08 17:18:00) [10]

Попробовал, вот что получилось - функция не оптимальна, но вроде работает, эвристика по стоп-символу и суффиксу, дает значительный выигрыш на больших кусках текста и при длинных образцах (при коротких тоже неплохо)
Прибраться только надо, чтобы побыстрее работала... но влом

function fStrPos(const Line, Sample: string; FromPos, ToPos: integer): integer;
var
stLen, samLen: integer;
StopIndex: integer;
StopChar, ch: char;
SuffixStr, RevertSample: string;
SuffixLen: integer;
i, incr: integer;
begin
Result := 0;
//checks
SamLen := length(Sample);
if SamLen = 0 then exit;
if FromPos <= 0 then FromPos := 1;
stLen := length(Line);
if (ToPos < stLen) and (toPos >= FromPos) then
stLen := toPos;
//Переворачиваем Sample - удобно для Pos
SetLength(RevertSample, SamLen);
for i := 1 to SamLen do
RevertSample[SamLen - i + 1] := Sample[i];
//Пока не дошли до конца участка минус длина образца...
while FromPos <= (stLen - samLen + 1) do
begin
//сравниваем образец СПРАВА НАЛЕВО
StopIndex := 0;
for i := samLen downTo 1 do
if Sample[i] <> Line[i + FromPos - 1] then
begin
//На чем запнулись
StopIndex := i;
StopChar := Line[i + FromPos - 1];
SuffixStr := copy(Sample, i+1, samLen - i);
SuffixLen := length(SuffixStr);
Break;
end;
//Проверка совпадения
if StopIndex = 0 then
begin
Result := FromPos;
Exit;
end;
//Переворачиваем суффикс
for i := 1 to (SuffixLen div 2) do
begin
ch := suffixstr[SuffixLen - i + 1];
suffixstr[SuffixLen - i + 1] := suffixStr[i];
suffixstr[i] := ch;
end;
//Приращение по суффиксу - следующее вхождение
incr := Pos(SuffixStr, copy(RevertSample,SuffixLen + 1,SamLen));
//Приращение по стоп-символу:
for i := StopIndex - 1 downTo 1 do
if Sample[i] = StopChar then
begin
if incr < (SamLen - i) then
incr := SamLen - i;
break;
end;
if incr = 0 then incr := samLen;
inc(FromPos, incr);
end;
end;

Alx2   (2002-01-08 17:00:00) [11]

Блин, еще проверить не вернет ли pos ноль и если вернет, то Result := 0. Сорри. Тороплюсь :))

Alx2   (2002-01-08 16:58:00) [12]

Ой!
Надо if (PrevIdx<=Length(Str)) and (PrevIdx>0)

Alx2   (2002-01-08 16:57:00) [13]

Если при помощи Pos и почти эффективно, то:

function NextSubStr(Const SubStr,Str : String; PrevIdx : Integer):Integer;
begin
if (PrevIdx<Length(Str)) and (PrevIdx>0)
then
Result := pos(SubStr,PChar(@Str[PrevIdx]))+PrevIdx-1
else
Result := 0;
end;
Var k : Integer;
begin
k :=NextSubStr("a","abcabcabc",1);
Label1.Caption:=IntToStr(k); // Выводим позицию первого вхождения строки "a"
k :=NextSubStr("a","abcabcabc",k+1);
Label2.Caption:=IntToStr(k); // Выводим позицию следующего вхождения строки "a"
end;

panov   (2002-01-08 16:45:00) [14]

Это нормальное решение в лоб, но поэффективности(скорость работы) самое медленное...

Song   (2002-01-08 16:35:00) [15]

а можно присвоить вашу переменную другой, временной и после каждого последующего поиска удалять найденнный текст с начала до найденной позиции вместе с найденным символом и тогда следующий найденный символ, если даже он такой как и предыдущий, найдётся без проблем

SoftOne   (2002-01-08 15:17:00) [16]

> panov.
А это не компоненты. Это просто функции.

panov   (2002-01-08 15:12:00) [17]

А зачем лишние компоненты использовать??

SoftOne   (2002-01-08 15:11:00) [18]

А можно было и не думать, а использовать готовые функции из модуля StrUtils пакета RXLib.

panov   (2002-01-08 15:04:00) [19]

Из блестящей идеи Андрей Сенченко © (08.01.02 10:23)
и Юрий Зотов © (08.01.02 11:04)
родилось вот такое творение:

functionSearchString( constFindStr, SourceString: String;Num: Integer):Integer;
var
FirstP: PChar;
functionMyPos(const FindStr, SourceString: PChar;Num: Integer): PChar;
begin
Result := AnsiStrPos(SourceString,FindStr);
if(Result=nil) thenExit;
Inc(Result);
ifNum=1 thenExit;
ifnum>1 thenResult := MyPos(FindStr,Result,num-1);
end;
beginResult := 0;
FirstP := PChar(SourceString);
Result := MyPos(PChar(FindStr),PChar(SourceString),Num) - FirstP;
ifResult<0 thenResult := 0;
end;

Romkin   (2002-01-08 13:59:00) [20]

Если большое количество - пиши ручками, есть много алгоритмов быстрого поиска, надо только реализовать

Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо