Интернет решения от доктора Боба

Swart Bob

readln(guest,Str);

writeln(Str)

end;

close(guest);

writeln('</BODY');

writeln('</HTML')

end.

Примечание,

для того, что бы упростить, мы не используем базу данных для хранения комментариев. Иначе это потребовало установки BDE на web сервере.

3.4.3. Детектор мертвых ссылок

Любой серьезный web сайт и его web мастер должны всегда следить за актуальность ссылок. И если обнаружится мертвая ссылка (например другой web сайт прекратил существование), но нет никаких оправданий для внутренних мертвых ссылок. И поэтому я написал простую программу, назвав ее HTMLINKS, которая может сканировать .HTM файлы на их присутствие на локальной машине. (что бы потом загрузить их на сервер). HTM файлы из текущего каталога и всех подкаталогов рекурсивно читаются и проверяются на тег "<A href="#"text_emphasis">"<FRAME SRC=" . Если страница локальная, то есть без префикса "http://", то файл открывается с использованием относительно пути. Если страница не находится, то мы имеем внутреннюю мертвую ссылку, которая должна быть исправлена!!

Заметим, что программа игнорирует все "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('<A href="#"text_code"> (Pos('FRAME SRC="',Str) 0) do

begin

if Pos('<A href="#"text_code"> Delete(Str,1,Pos('href="#"text_code"> 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