检测URL地址的有效性
function GetURLs(line: string): TStringList;
var
i : integer;
posURL,
s : string;
begin
Result := TStringList.Create;
s := line;
i := 0;
if Length(s) < 5 then exit;
repeat
i := Pos(' ', s);
if i > 0 then
begin
posURL := Copy(s, 1, i-1);
s := Copy(s, i+1, Length(s)-i);
if isURL(posURL) then
Result.Add(posURL);
end else
begin
PosURL := s;
if isURL(posURL) then
Result.Add(posURL);
Break;
end;
until Length(s) = 0;
if Result.Count = 0 then
begin
Result.Free;
Result := nil;
end;
end;
function IsURL(s: string): Boolean;
var
i: integer;
begin
Result := False;
if Length(s) < 5 then exit;
if (s[Length(s)] = '.') or (Pos('..', s) > 0) then exit;
for i := 1 to Length(s) do
if (Ord(s) < 33) or (Ord(s) > 126) then exit;
if (Pos('www.',LowerCase(s)) = 1) or (Pos('news:', LowerCase(s)) = 1) and
(Length(s) > 6) then
begin
Result := True;
Exit;
end;
if (Length(s) > 12) or (Pos('mailto:', LowerCase(s)) = 1) and
(Pos('@', s) > 1) and (Pos('.', s) > 4) and (Pos('.', s) > (Pos('@', s) +1)) then
begin
Result := True;
Exit;
end;
if (Pos('http:://', LowerCase(s)) > 0) or (Pos('ftp://', LowerCase(s)) > 0) and
(Length(s) > 10) and (Pos('.', s) > 7) then
begin
Result := True;
Exit;
end;
end;
