Функция, возвращающая текст между двумя определёнными строками
Procedure IsolateText( Const S: String; Tag1, Tag2: String; list:TStrings );
Var
pScan, pEnd, pTag1, pTag2: PChar;
foundText: String;
searchtext: String;
Begin{ Set up pointers we need for the search. HTML is not case sensitive, so
we need to perform the search on a uppercased copy of S.}
searchtext := Uppercase(S);
Tag1:= Uppercase( Tag1 );
Tag2:= Uppercase( Tag2 );
pTag1:= PChar(Tag1);
pTag2:= PChar(Tag2);
pScan:= PChar(searchtext);
Repeat{ Search for next occurence of Tag1. }
pScan:= StrPos( pScan, pTag1 );
If pScan <> NilThenBegin{ Found one, hop over it, then search from that position
forward for the next occurence of Tag2. }
Inc(pScan, Length( Tag1 ));
pEnd := StrPos( pScan, pTag2 );
If pEnd <> NilThenBegin{ Found start and end tag, isolate text between,
add it to the list. We need to get the text from
the original S, however, since we want the un-uppercased
version! So we calculate the address pScan would hold if
the search had been performed on S instead of searchtext. }
SetString( foundText,
Pchar(S) + (pScan- PChar(searchtext) ),
pEnd - pScan );
list.Add( foundText );
{ Continue next search after the found end tag. }
pScan := pEnd + Length(tag2);
End{ If }Else{ Error, no end tag found for start tag, abort. }
pScan := Nil;
End; { If }Until pScan = Nil;
End;
Статья Функция, возвращающая текст между двумя определёнными строками раздела Синтаксис Текст и Строки может быть полезна для разработчиков на Delphi и FreePascal.
Комментарии и вопросы
:: 2008-12-30 12:34:30 :: re:Функция, возвращающая текст между двумя определёнными строками
так вроде проще :)
function IsolateText( Const S: String; Tag1, Tag2: String):String;
var p1,p2:integer;
begin
result:=\'\';
p1:=0;p2:=0;
p1:=pos(Tag1,s)+Length(Tag1);
P2:=PosEx(Tag2,s,p1)-p1;
if (p1=0)and(p2=0) then exit;
result:=copy(s,p1,p2);
end;
:: 2008-12-30 12:55:09 :: re:Функция, возвращающая текст между двумя определёнными строками
Функция, возвращающая текст между N-нным вхождением двух определённых строк
function IsolateTextEx(Const S, Tag1,Tag2:String;n:integer):string;
var p1,p2,i,ofs:integer;
begin
result:=\'\';
p1:=0;p2:=0;
i:=0;ofs:=1;
repeat
inc(i);
p1:=posEx(Tag1,s,ofs)+Length(Tag1);
p2:=posEx(Tag2,s,p1)-p1;
if (p1=0)and(p2=0)then exit;
ofs:=p1+p2;
until i=n;
result:=copy(s,p1,p2);
end;
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.