Заметим, что программа игнорирует все "file://", "ftp://", "mailto:", "news:" and ".exe?" значения если они встретятся внутри "HREF" части. Конечно, вы свободны в расширить HTMLINKS для проверки и этих случаев, можно также реализовать проверку и внешних ссылок. Для информации я написал и детектор внешних мертвых ссылок в статье для The Delphi Magazine, подробности можно найти на моем web сайте. Для анализа мертвых локальных ссылок код следующий:
> {$APPTYPE CONSOLE}
> {$I-,H+}
> uses
> SysUtils;
> var
> Path: String;
> procedure CheckHTML(const Path: String);
> var
> SRec: TSearchRec;
> Str: String;
> f: Text;
> begin
> if FindFirst('*.htm', faArchive, SRec) = 0 then
> repeat
> Assign(f,SRec.Name);
> Reset(f);
> if IOResult = 0 then { no error }
> while not eof(f) do
> begin
> readln(f,Str);
> while (Pos('do
> begin
> if Pos('
> else
> Delete(Str,1,Pos('FRAME SRC="',Str)+10);
> if (Pos('#',Str) <> 1) and
> (Pos('http://',Str) <> 1) and
> (Pos('mailto:',Str) <> 1) and
> (Pos('news:',Str) <> 1) and
> (Pos('ftp://',Str) <> 1) and
> (Pos('.exe?',Str) = 0) then { skip external links & exe }
> begin
> if Pos('file:///',Str) = 1 then Delete(Str,1,8);
> if (Pos('#',Str) 0) and
> (Pos('#',Str) < Pos('"',Str)) then Str[Pos('#',Str)] := '"';
> if not FileExists(Copy(Str,1,Pos('"',Str)-1)) then
> writeln(Path,'\',SRec.Name,': [',Copy(Str,1,Pos('"',Str)-1),']')
> end
> end
> end;
> Close(f);
> if IOResult <> 0 then { skip }
> until FindNext(SRec) <> 0;
> FindClose(SRec);
> // check sub-directories recursively
> if FindFirst('*.*', faDirectory, SRec) = 0 then
> repeat
> if ((SRec.Attr AND faDirectory) = faDirectory) and
> (SRec.Name[1] <> '.') then
> begin
> ChDir(SRec.Name);
> CheckHTML(Path+'\'+SRec.Name);
> ChDir('..')
> end
> until FindNext(SRec) <> 0;
> FindClose(SRec)
> end {CheckHTML};
> begin
> writeln('HTMLinks 4.0 (c) 1997-2000 by Bob Swart (aka Dr.Bob - www.drbob42.com)');
> writeln;
> FileMode := $40;
