Выбрать главу

3.4.2. Гостевая книга

Подлинный CGI пример: приложение – гостевая книга (в котором спрашиваем имя и небольшой комментарий), всего лишь несколько строк на Дельфи.

Сначала CGI форма:

  <HTML>

  <BODY>

  <H2>Dr.Bob's Guestbook</H2>

  <FORM ACTION="http://www.drbob42.com/cgi-bin/guest.exe" METHOD=POST

  Name: <INPUT TYPE=text NAME=name<BR>

  Comments: <TEXTAREA COLS=42 LINES=4 NAME=comments>

  <P>

  <INPUT TYPE=SUBMIT VALUE="Send Comments to Dr.Bob">

  </FORM>

  </BODY>

  </HTML>

Теперь консольное (Дельфи) приложение:

  program CGI;

  {$I-}

  {$APPTYPE CONSOLE}

  uses

    DrBobCGI;

  var

    guest: Text;

    Str: String;

  begin

    Assign(guest,'guest'); // assuming that's the guestbook

    Append(guest);

    if IOResult <> 0 then // open new guestbook

    begin

      Rewrite(guest);

      writeln(guest,'<HTML');

      writeln(guest,'<BODY')

    end;

    writeln(guest,'Date: ',DateTimeToStr(Now),'<BR');

    writeln(guest,'Name: ',Value('name'),'<BR');

    writeln(guest,'Comments: ',Value('comments'),'<HR');

    reset(guest);

    writeln('Content-type: text/html');

    writeln;

    while not eof(guest) do // now output guestbook itself

    begin

      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=" или "<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="',Str)  0) or

                (Pos('FRAME SRC="',Str)  0) do

          begin

            if Pos('<A HREF="',Str)  0 then

              Delete(Str,1,Pos('HREF="',Str)+8-3)

            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