字符串提取算法-木庄网络博客

本文整理自网络，侵删。
 private

FPageString:string;
FCurDir :string;
FHost :string;


function Tform1.GetLinks(Links: TStrings): integer;
var iLen, i: integer;
sLink: string;
boHref, boImg, boStart, boOther :Boolean;
ch :char;
p :PChar;
s :array[0..255] of char;
label addchEnd;
begin

result := -1;
Links.Clear;

iLen := length (FPageString);

boHref := False;
boImg := False;
boStart := False;
boOther := False;

sLink := '';

p := PChar (FPageString);

i := -1;

While True do begin
Inc (i);
if i >= iLen - 1 then break;
ch := p[i];
if boOther then begin
if ch = '>' then begin
boOther := False;
end ;
Continue;
end;

if (not boHref) and (not boImg) then begin
if i + 10 >= iLen then break;
if p[i] <> '<' then
continue;

if p[i+1] in ['A', 'a'] then begin
if p [i+2] = ' ' then begin
boHref := True;
boStart := False;
sLink := '';
Inc (i, 2);
Continue;
end;
end else

if p[i+1] in ['I', 'i'] then begin
StrLCopy ( @s, @p[i], 5);
s[5] := #0;

if SameText (s, '<img ') then begin
boImg := True;
boStart := False;
sLink := '';
Inc (i, 4);
Continue;
end;
end;

boOther := True;
continue;
end;

if ch = '>' then begin
goto addchEnd;
end;

if not BoStart then begin
if boHref then begin
StrLCopy ( @s, @p[i], 5);
s[5] := #0;
if SameText (s, 'href=') then begin
boStart := True;
Inc (i, 4);

end;
end;

if boImg then begin
StrLCopy ( @s, @p[i], 4);
s[4] := #0;
if SameText (s, 'src=') then begin
boStart := True;
Inc (i, 3);
end;
end;

continue;
end;

if ch in [' ', '"', #39] then begin
if sLink <> '' then begin

goto addchEnd;
end;
Continue;
end;

if (ch = '.') and (p[i+1] = '/') then begin
Inc (i);
continue;
end;

sLink := sLink + ch;
continue;

addchEnd:
boHref := False;
boImg := False;
boStart := False;

if sLink <> '' then begin
if not SameText ('http://', Copy (sLink, 1, 7)) then
begin
if sLink[1] <> '/' then
sLink := FCurDir + sLink
else
sLink := FHost + sLink;
end;
Links.Add(sLink)
end;

end;

result := Links.Count;
end;
字符串提取算法

相关推荐

评论
