home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 February / Chip_2000-02_cd.bin / internet / BIBLECD / PREVOD.ZIP / PREVOD.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1998-10-27  |  6.3 KB  |  194 lines
  1. program    Prevod(input,output);
  2. uses    Fr_sok;
  3. label    konec,preskok;
  4.  
  5. var    f,g:Text;
  6.     kapitola:Byte;
  7.     nedokonceno:Boolean;
  8.     adresar,jmeno:String;
  9.  
  10. function PocetKap:Word; {P⌐edpokládám, æe f je otev⌐enÿ soubor}
  11. var    s:String;
  12.     pocet,pom:Word;
  13.     f0:Text;
  14.     chyba:Integer;
  15.     kapitola:Byte;
  16. begin
  17.   UschovejPozici(f); {Zji¿têní a uloæení aktuální pozice ve vstupním souboru}
  18.   pocet:=0;
  19.   while Not(Eof(f)) do
  20.   begin
  21.     Readln(f,s);
  22.     if s[1]='\' then Break;
  23.     if s[1]='@' then
  24.     begin
  25.       s:=Copy(s,2,Length(s));System.Val(s,kapitola,chyba);
  26.       if (chyba=0) and (kapitola>pocet) then begin pocet:=kapitola;end;
  27.     end;
  28.   end;
  29.   ObnovPozici(f); {Nastavení pûvodní pozice ve vstupním souboru}
  30.   PocetKap:=pocet;
  31. end;
  32.  
  33. procedure KonecWWWstranky;
  34. begin
  35.  if nedokonceno=True then
  36.  begin
  37.   Writeln(g,'</A>');nedokonceno:=False;
  38.  end;
  39.  if kapitola>0 then
  40.  begin
  41.   cskod:=3;Writeln(g,'</OL>');Writeln(g);Writeln(g,'<HR>');
  42.   Writeln(g,cs('<A HREF="mailto: sokolovs@troja.fjfi.cvut.cz">Námêty, p⌐ipomínky a dotazy - EMAIL</A>, '));
  43.   Writeln(g,cs('<A HREF="http://www-troja.fjfi.cvut.cz/~sokolovs/">moje WWW stránka</A> a '));
  44.   Writeln(g,cs('<A HREF="http://www-troja.fjfi.cvut.cz/BIBLE/BIBLE.HTM">Bible - çeská verze s odkazy</A>'));
  45.   Writeln(g,'</BODY>');Writeln(g,'</HTML>');Writeln(g);cskod:=1;
  46.   kapitola:=0;Close(g);
  47.  end;
  48. end;
  49.  
  50. var    i,pocet,vers:Byte;
  51.     nazev,s,zkratka:String;
  52.     chyba0,p1,p2:Integer;
  53.     jmeno2:String;
  54.     komentare:Boolean;
  55. begin
  56.  Nastav;cskod:=1;Vypni_Zvuk;stav:=Vypnuta;komentare:=False;
  57.  jmeno:='I:\ELBI\BIBLE.BI\BIBLEKR.BI\book.txt';CtiString3('Zadejte soubor book.txt z programu Elbi:',False,False,jmeno);
  58.  adresar:='H:\TMP';CtiString3('Zadejte adresar, kam se ulozi vytvorene WWW stranky:',False,False,adresar);
  59.  if adresar[Length(adresar)]<>'\' then adresar:=adresar+'\';
  60.  Assign(f,jmeno);Reset(f);if (chyba<>0) then Hlaseni('Chyba p⌐i otev⌐ení vstupního souboru.');
  61.  while ((chyba=0) and Not(eof(f))) do
  62.  begin
  63.   {$I-}Readln(f,s);{$I+}chyba:=IOResult;if Length(s)<1 then goto preskok;
  64.   for i:=1 to length(s) do
  65.   begin {Znaky "<" a ">" vadí ve www stránce, proto se nahradí "[" a "]"}
  66.     if s[i]='<' then s[i]:='[';
  67.     if s[i]='>' then s[i]:=']';
  68.     if s[i]='"' then s[i]:=Chr(39); {nahrazení uvozovky apostrofem}
  69.   end;
  70.  
  71.   if s[1]='\' then
  72.   begin
  73.    if komentare=True then
  74.    begin
  75.      komentare:=False;Writeln(g,'<P>');
  76.    end;
  77.    KonecWWWstranky;
  78. {   if AnoNe2('P⌐ejete skonçit?') then goto konec;}
  79.    nazev:=OdstranZbytecneMezery(Copy(s,2,Length(s)-1));
  80.    p1:=Pos('(',nazev);p2:=Pos(')',nazev);
  81.    if ((p1>0) and (p2>0) and (p2>p1)) then
  82.    begin
  83.      zkratka:=Copy(nazev,p1+1,p2-p1-1); {Odstraní se nep⌐ístupné znaky ve jménu souboru}
  84.      zkratka:=Odstran_Hacky_Carky(OdstranZbytecneMezery(Copy(zkratka,1,p1-1)));
  85.      while (Pos('.',zkratka)>0) do System.Delete(zkratka,Pos('.',zkratka),1);
  86.      while (Pos(':',zkratka)>0) do System.Delete(zkratka,Pos(':',zkratka),1);
  87.      while (Pos('/',zkratka)>0) do System.Delete(zkratka,Pos('/',zkratka),1);
  88.      while (Pos('\',zkratka)>0) do System.Delete(zkratka,Pos('\',zkratka),1);
  89.    end else begin
  90.      CtiString3('*   *   *         Mûæete zmênit název kapitoly:      *      *      *',False,False,nazev);
  91.      CtiString3('Zadejte zkratku pro '+nazev,False,False,zkratka);
  92.    end;
  93.    jmeno2:=adresar+Odstran_Hacky_Carky(zkratka)+'.htm';
  94.    Writeln('Vytvá⌐ím soubor '+Odstran_Hacky_Carky(jmeno2)+' ...');
  95.    if Soubor_Existuje(jmeno2) then
  96.    begin
  97.      CtiString3('Zadejte jinou zkratku pro '+nazev+' (jinak bude soubor p⌐emazán)',False,False,zkratka);
  98.    end;
  99.    Assign(g,jmeno2);Rewrite(g);
  100.    if (chyba<>0) then begin Hlaseni('Nepoda⌐ilo se zapsat do souboru '+jmeno2);end;
  101.    cskod:=3;
  102.    Writeln(g,'<HTML>');
  103.    Writeln(g,'<HEAD>');
  104.    Writeln(g,cs(' <meta http-equiv="Content-Type" content="text/html; charset=windows-1250">'));
  105.    Writeln(g,cs(' <meta name="GENERATOR" content="P⌐evádêcí program z Elbi do WWW stránky">'));
  106.    Writeln(g,cs(' <TITLE>'+nazev+'</TITLE>'));
  107.    Writeln(g,'</HEAD>');
  108.  
  109.    Writeln(g,'<BODY>');
  110.    Write(g,cs('<IMG SRC="http://www.navrcholu.cz/cgi-bin/4web/nvhit.pl?id=00000194" WIDTH="0" HEIGHT="0" '));
  111.    Writeln(g,cs('alt="Poçítadlo" border="0">'));
  112.    Writeln(g,'<CENTER>');
  113.    Writeln(g,cs('<P><H2>'+nazev+'</H2><BR>'));
  114.    Writeln(g,'</CENTER><P>');
  115.    Writeln(g);kapitola:=0;
  116.    Writeln(g,'Kapitoly: ');
  117.    pocet:=PocetKap;if pocet<1 then pocet:=Cti_Byte('Zadejte poçet kapitol v '+nazev+' ('+str(pocet)+')');
  118.    for i:=1 to pocet do
  119.    begin
  120.     Write(g,'<A HREF="#'+Str(i)+'">'+Str(i)+'</A>');
  121.     if i<pocet then Write(g,',') else Write(g,'.');
  122.     if (i mod 3)=0 then Writeln(g) else Write(g,' ');
  123.    end;
  124.    Writeln(g,'<P>');Writeln(g);cskod:=1;nedokonceno:=False;goto preskok;
  125.   end;
  126.  
  127.   if s[1]='@' then
  128.   begin
  129.    if komentare=True then
  130.    begin
  131.      komentare:=False;Writeln(g,' <P>');
  132.    end;
  133.    if nedokonceno=True then
  134.    begin
  135.     Writeln(g,'</A>');nedokonceno:=False;
  136.    end;
  137.    if kapitola>0 then
  138.    begin
  139.     Writeln(g,'</OL>');Writeln(g);
  140.     kapitola:=0;
  141.    end;
  142.    cskod:=3;
  143.    s:=Copy(s,2,Length(s));System.Val(s,kapitola,chyba);
  144.    Writeln(g,'<A NAME="'+Str(kapitola)+'"></A>');
  145.    Writeln(g,cs('<OL><H2>'+Str(kapitola)+'.kapitola ('+nazev+')</H2>'));
  146.    cskod:=1;nedokonceno:=False;goto preskok;
  147.   end;
  148.  
  149.   if s[1] in ['1'..'9'] then
  150.   begin
  151.    if nedokonceno=True then
  152.    begin
  153.     Writeln(g,'</A>');nedokonceno:=False;
  154.    end;
  155.    i:=Pos(':',s);
  156.    if i>0 then
  157.    begin
  158.      System.Val(Copy(s,1,i-1),vers,chyba0);
  159.      if chyba=0 then
  160.      begin
  161.        if komentare=True then
  162.        begin
  163.      komentare:=False;Writeln(g,' <P>');
  164.        end;
  165.        Write(g,' <LI><A NAME="'+Str(kapitola)+':'+Str(vers)+'">');
  166.        s:=OdstranZbytecneMezery(Copy(s,i+1,Length(s)));
  167.        nedokonceno:=True;cskod:=3;Write(g,cs(s));cskod:=1;
  168.        goto preskok;
  169.      end;
  170.    end;
  171.   end;
  172.  
  173.   if s[1]='#' then
  174.   begin
  175.    if nedokonceno=True then
  176.    begin
  177.     Writeln(g,'</A>');nedokonceno:=False;
  178.    end;
  179.    s:=OdstranZbytecneMezery(Copy(s,2,Length(s)-1));komentare:=True;
  180.    cskod:=3;Writeln(g,' <BR><B>',cs(s),'</B></BR>');cskod:=1;goto preskok;
  181.   end;
  182.  
  183.   cskod:=3;
  184.   if komentare=True then Write(g,'<BR><B>');
  185.   Write(g,' '+OdstranZbytecneMezery(cs(s)));
  186.   if komentare=True then Writeln(g,'</B></BR>');
  187.   cskod:=1;
  188.   preskok:
  189.  end;
  190.  
  191.  KonecWWWstranky;
  192.  konec: Close(f);Fr_Sok.Konec;
  193. end.
  194.