Algoritmy:

Zadání:

Vytvořte proceduru, která otevře zadaný soubor a překopíruj jej do dalšího souboru se zadaným jménem, přičemž odstraní všechny HTML tagy.
HTML tag je definován jako řetězec tvaru , kde X je libovolný neprázdný řetězec nezačínající mezerou. Předpokládejte, že zadaný soubor existuje a že zápis na disk je možný - nekontrolujte a neošetřujte tyto případy.

Užijeme konečný automat.

Procedure RemoveHTMLTags(FileNameIn,FileNameOut:string);
{Procedura prekopiruje soubor FileNameIn do souboru FileNameOut, pricemz
 odstrani vsechny HTML tagy, tj. retezce tvaru , kde X je libovolny
 neprazdny retezec nezacinajici mezerou.}
var Status:byte;
    FIn,FOut:text;
    p:char;
begin {RemoveHTMLTags}
  Status:=0;
  Assign(FIn,FileNameIn);
  Assign(FOut,FileNameOut);
  reset(FIn);
  rewrite(FOut);
  while not eof(FIn) do begin
    while not eoln(FIn) do begin
      read(FIn,p);
      case Status of
        0: if p='<' then Status:=1 else write(FOut,p);
        1: if p=' ' then begin
             Status:=0;
             write(FOut,'< ');
           end {if} else if p='>' then begin
             Status:=0;
             write(FOut,'<>');
           end {if} else Status:=2;
        2: if p=' ' then Status:=3
           else if p='>' then Status:=0;
        3: if p<>' ' then Status:=2;
      end; {case}
    end; {while not eoln}
    readln(FIn);
    if Status=0 then writeln(FOut,'');
  end; {while not eof}
  close(FIn);
  close(FOut);
end; {RemoveHTMLTags}
  

Varování:

Z důvodů popisování HTML značek v HTML dokumentu jsem byl donucen deformovat některé HTML značky přidáním znaku #. Všude, kde v následujícím textu naleznete tento znak, patří ve skutečnosti prázdné místo. V případě, že si stáhnete zdrojový kód tohoto příkladu, tam se toto nevyskytuje.

Vytvořte proceduru, která otevře zadaný soubor a překopíruj jej do dalšího souboru se zadaným jménem, přičemž ponechá jen text mezi tagy <#BODY> a <#/BODY>.
Předpokládejte, že zadaný soubor existuje a že zápis na disk je možný - nekontrolujte a neošetřujte tyto případy.

Užijeme konečný automat.

Procedure KeepBody(FileNameIn,FileNameOut:string);
{Procedura otevre soubor FileNameIn a opise jej do souboru FileNameOut,
 pricemz je splneno nasledujici:
 - opisuje se jen text, ktery lezi mezi prvnim vyskytem znacky
   <#BODY> ci <#BODY xxx> a prvnim vyskytem znacky 
 - je-li znacka umisteno v komentari, napr. <#!-- <#BODY>, procedura ji povazuje
   za platnou znacku, a tak muze vydat NESPRAVNY vysledek}
var Status:byte;
    FIn,FOut:text;
    p:char;
    Ending:boolean;
begin {KeepBody}
  Ending:=false;
  Status:=0;
  Assign(FIn,FileNameIn);
  Assign(FOut,FileNameOut);
  reset(FIn);
  rewrite(FOut);
  while (not eof(FIn))and(not Ending) do begin
    while (not eoln(FIn))and(not Ending) do begin
      read(FIn,p);
      case Status of
        0: if p='<' then Status:=1;
        1: if p in ['B','b'] then Status:=2 else Status:=0;
        2: if p in ['O','o'] then Status:=3 else Status:=0;
        3: if p in ['D','d'] then Status:=4 else Status:=0;
        4: if p in ['Y','y'] then Status:=5 else Status:=0;
        5: if p='>' then
             Status:=7
           else if p=' ' then
                  Status:=6
                else
                  Status:=0;
        6: if p='>' then Status:=7;
        7: if p<>'<' then
             write(FOut,p)
           else
             Status:=8;
        8: if p='/' then
             Status:=9
           else begin
             write(FOut,'<'+p);
             Status:=7;
           end; {else}
        9: if p in ['B','b'] then
             Status:=10
           else begin
             write(FOut,'<#/'+p);
             Status:=7;
           end; {else}
        10:if p in ['O','o'] then
             Status:=11
           else begin
             write(FOut,'<#/B'+p);
             Status:=7;
           end; {else}
        11:if p in ['D','d'] then
             Status:=12
           else begin
             write(FOut,'<#/BO'+p);
             Status:=7;
           end; {else}
        12:if p in ['Y','y'] then
             Status:=13
           else begin
             write(FOut,'<#/BOD'+p);
             Status:=7;
           end; {else}
        13:if p in ['>'] then
             Ending:=true
           else begin
             write(FOut,'<#/BODY'+p);
             Status:=7;
           end; {else}
      end; {case}
    end; {while not eoln}
    readln(FIn);
    if Status=7 then writeln(FOut,'');
  end; {while not eof}
  close(FIn);
  close(FOut);
end; {KeepBody}