本文整理自网络，侵删。
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;
相关阅读 >>
Delphi 的编译指令(1): $define、$undef、$ifdef、$else、$endif
Delphi listview 导出excel txt vcf 单元
Delphi 文字的高度与宽度: canvas.textextent
更多相关阅读请进入《Delphi》频道 >>
