本文整理自网络，侵删。
function Ge_tLinks(Url: string): Tstrings;
var
HttpStr, str, Url1: string;
st1, end1, i, j, Ord1: integer;
begin
Result := TStringList.create; //创建Tstringlist事例
Httpstr := UrlGetStr(url);
for i := length(url) downto 9 do
begin
if url[i] = '/' then
begin
Url1 := copy(url, 1, i);
break;
end;
if i = 9 then Url1 := url + '/'; //结束都没有找到"/"就加一个"/"
end;
i := 1;
while true do
begin
st1 := Q_PosText('<a', httpstr, i);
st1 := Q_PosText('href=', httpstr, st1);
if (st1 = 0) or (st1 < i) then break;
st1 := st1 + 5; //开始位置设置为 href= 之后的位置
i := st1;
while true do
begin
// if i >= length(Httpstr) then break;
Ord1 := Ord(Httpstr[i]);
case Ord1 of
34, 39: //如果连接前有" 或 ' 就
begin
if i = st1 then
begin
st1 := st1 + 1;
end
else begin
end1 := i;
break;
end;
end;
36..38, 40..59, 61, 63..95, 97..254: ;
else
begin
end1 := i;
break;
end
end;
i := i + 1;
end;
//连接内容
str := copy(httpstr, st1, end1 - st1);
if (length(str) > 8) and (Q_PosText('mailto:', str, 1) = 0) and (Q_PosText('javascript:', str, 1) = 0) then
begin
if pos('://', str) = 0 then //表示要加前面网址的
begin
if str[1] = '/' then
begin
str := copy(url1, 1, Q_PosText('/', url1, 9)) + copy(str, 2, 100);
if Result.IndexOf(str) = -1 then Result.Add(str);
end
else begin
str := Url1 + str;
if Result.IndexOf(str) = -1 then Result.Add(str);
end;
end
else begin //表示本身就加了 http://的
if Result.IndexOf(str) = -1 then Result.Add(str);
end;
end;
i := end1; //
end;
end; 相关阅读 >>
Delphi xe andriod 文件后缀对应mime类型
更多相关阅读请进入《Delphi》频道 >>
