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

Вниз

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

 
Delphimun   (2002-01-07 11:55) [0]

Как найти далее при помощи 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);


 
Delphimun   (2002-01-07 14:26) [1]

Простой же вопрос много раз в форуме был, я просто найти не могу наверняка многие знают


 
NDeu   (2002-01-07 16:55) [2]

В Help-e TCustomRichEdit.FindText ест Example


 
Delphimun   (2002-01-07 18:22) [3]

мне нужно искать в файловой переменной, а не в richedit-е, загружать текст в richedit не могу, т.к его модуль много места кушает. Нужно всё сделать при помощи pos


 
marat_from_tomsk   (2002-01-08 05:16) [4]

работай порциями
после того как нашел первое вхождение
удали обработанную порцию и ищи дальше ...
или поищи требуемую функцию
вот например в FoxPro есть подходящая функция
найти n-ое вхождение


 
Андрей Сенченко   (2002-01-08 10:23) [5]

a := pos("a",str);
b := pos("b",Copy(str,a,(length(str)-pos("a",str));

Примерно так. Но еще нужно учесть ЧТО возвращает pos() и расставить +-1 во второй строке в нужных местах


 
Юрий Зотов   (2002-01-08 11:04) [6]

Как легко заметить, помещая код Андрея Сенченко в цикл от 1 до N, находим то самое N-е вхождение. А помещая в цикл while, находим все вхождения. И при этом исходная строка остается неизменной.


 
Delphimun   (2002-01-08 13:43) [7]

я не совсем понял, напишите пожалуйста пример, с моим кодом(который выше),


 
Delphimun   (2002-01-08 13:45) [8]

а работать пропорциями для меня не совсем выгодно, т.к нужно
обрабатывать очень большое кол-во текста

Пример мне нужен с кодом Андрея Сенченко.


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

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


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

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

function SearchString( const FindStr, SourceString: String;Num: Integer):Integer;
var
FirstP: PChar;
function MyPos(const FindStr, SourceString: PChar;Num: Integer): PChar;
begin
Result := AnsiStrPos(SourceString,FindStr);
if (Result=nil) then Exit;
Inc(Result);
if Num=1 then Exit;
if num>1 then Result := MyPos(FindStr,Result,num-1);
end;
begin Result := 0;
FirstP := PChar(SourceString);
Result := MyPos(PChar(FindStr),PChar(SourceString),Num) - FirstP;
if Result<0 then Result := 0;
end;


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

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


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

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


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

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


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

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


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

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


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

Если при помощи 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;


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

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


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

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


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

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

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;


 
Yaro   (2002-01-08 18:08) [20]

Люди, я чот не пойму, нафиг вам 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 18:27) [21]

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


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

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


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

Вариант - системный поиск
Нагло вырезана 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


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

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

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;


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

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


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

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


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

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


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

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

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

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



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

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

Наверх




Память: 0.52 MB
Время: 0.004 c
1-90304
Сержик
2002-01-11 09:36
2002.01.28
Компонента для архивирования есть?


3-90211
Softmaster
2001-12-23 09:57
2002.01.28
Вопрос по QReport


1-90288
KingSize
2002-01-10 17:57
2002.01.28
Открытие


3-90217
kay
2001-12-24 22:12
2002.01.28
BDE


4-90430
Nicke
2001-11-27 15:35
2002.01.28
Приложение как служба Win NT





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский