home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 January / PCWorld_2003-01_cd.bin / Software / Vyzkuste / htmltocz / html2cz.pas < prev    next >
Pascal/Delphi Source File  |  2002-09-29  |  10KB  |  291 lines
  1. {$H+}
  2. program html2cz;
  3. {html2cz je siren pod licenci GNU GPL - gpl.txt
  4.  slovnik.cz je siren pod licenci GNU FDL - fdl.txt}
  5. uses dos,uhash;
  6. type cas=record
  7.            hod, min, sec, hun: word;
  8.          end;
  9. var cesta:pathStr; f:SearchRec; fcz:text; s:string; del,rep:boolean;
  10.     slov:longint; z:zaznam; i:integer; procent:real;
  11.     celkemp,celkemn:longint; zacatek,konec,celkem: cas;
  12.     
  13. {------------------------------------------------------------------------------}
  14.  
  15. procedure vypis_informace;
  16. begin
  17.    writeln;
  18.    writeln(space(5)+'html2cz je program ktery obohati html stranky v anglickem jazyce');
  19.    writeln(space(5)+'o jejich cesky preklad - vice viz README.');
  20.    writeln;
  21.    writeln(space(5)+'Parametry programu jsou nasledujici:');
  22.    writeln(space(5)+'html2cz.exe [cesta] [del | rep]');
  23.    writeln;
  24.    writeln(space(5)+'kde [cesta] je povinny parametr a muze znamenat:');
  25.    writeln(space(5)+'"html2cz c:\slozka" - prelozi se zadana slozka');
  26.    writeln(space(5)+'"html2cz c:\soubor" - prelozi se zadany soubor');
  27.    writeln(space(5)+'"html2cz slozka" - prelozi se slozka, ktera je v html2cz adresari');
  28.    writeln(space(5)+'"html2cz soubor" - prelozi se soubor, ktery je v html2cz adresari');
  29.    writeln;
  30.    writeln(space(5)+'a [del | rep] jsou nepovinne vylucujici se parametry kde:');
  31.    writeln(space(5)+'del = smaze anglicke soubory a ponecha ".cz.html" soubory');
  32.    writeln(space(5)+'rep = prepise anglicke soubory ceskymi');
  33.    writeln;
  34.    writeln(space(5)+'Priklad:');
  35.    writeln(space(5)+'html2cz.exe c:\html40 rep');
  36.    writeln(space(5)+'prepise vsechny anglicke soubory ve slozce c:\html40.');
  37.    writeln;
  38.    writeln(space(5)+'Po otevreni souboru *.cz.html v libovolnem');
  39.    writeln(space(5)+'internetovem prohlizeci se po najeti mysi na');
  40.    writeln(space(5)+'anglicke slovo objevi bublina s ceskym prekladem.');
  41. end;
  42.  
  43. {------------------------------------------------------------------------------}
  44.  
  45. function StartFinishTime(start, finish: cas): cas;
  46. var startfinish: cas;
  47.  
  48. begin
  49.    with start do
  50.    begin
  51.       if finish.hod-hod<0 then
  52.       begin
  53.          startfinish.hod:=(24-hod)+finish.hod;
  54.          {dec(startfinish.den); :) }
  55.       end
  56.       else startfinish.hod:=finish.hod-hod;
  57.       {----------------------}
  58.       if finish.min-min<0 then
  59.       begin
  60.          startfinish.min:=(60-min)+finish.min;
  61.          dec(startfinish.hod);
  62.       end
  63.       else startfinish.min:=finish.min-min;
  64.       {----------------------}
  65.       if finish.sec-sec<0 then
  66.       begin
  67.          startfinish.sec:=(60-sec)+finish.sec;
  68.          dec(startfinish.min);
  69.       end
  70.       else startfinish.sec:=finish.sec-sec;
  71.       {----------------------}
  72.       if finish.hun-hun<0 then
  73.       begin
  74.          startfinish.hun:=(100-hun)+finish.hun;
  75.          dec(startfinish.sec);
  76.       end
  77.       else startfinish.hun:=finish.hun-hun;
  78.    end;
  79.    StartFinishTime:=startfinish;
  80. end;
  81.  
  82. {------------------------------------------------------------------------------}
  83.  
  84. procedure preloz_html(cesta:pathStr);
  85. const pismena=['a'..'z','A'..'Z'];
  86. var f,fcz:text; i:integer; vlozeno,neprekladej:boolean;
  87.     ch:char; s,t:string; body:string[4]; u:ukprvek;
  88.     prelozenych,neprelozenych:longint; cesta_cz,cesta_full:pathStr;
  89. begin
  90.    assign(f,cesta);
  91.    {$I-}reset(f);{$I+}
  92.    if IOResult<>0 then writeln('CHYBA - nemohu otevrit soubor: '+cesta)
  93.    else
  94.    begin
  95.       cesta_cz:=cesta;
  96.    
  97.       vlozeno:=false;
  98.       i:=length(cesta_cz);
  99.       repeat
  100.          if cesta_cz[i]='.' then begin insert('.cz',cesta_cz,i); vlozeno:=true; end;
  101.          dec(i);
  102.       until vlozeno;
  103.  
  104.       neprekladej:=true; ch:=chr(0); prelozenych:=0; neprelozenych:=0;
  105.  
  106.       assign(fcz,cesta_cz);
  107.       rewrite(fcz);
  108.       {--------------------prace--s--html-----------------------}
  109.       while not eof(f) do
  110.       begin
  111.          s:=''; body:='';
  112.          if ch<>'<' then read(f,ch);{muze nastat pripad *}
  113.          case ch of
  114.  
  115.            '<': begin
  116.                    repeat
  117.                       write(fcz,ch);
  118.                       read(f,ch);
  119.                       body:=body+ch;
  120.                    until ch='>';
  121.                    write(fcz,ch);
  122.                    body:=lowercase(body);
  123.                    if body='body' then neprekladej:=false;
  124.                    if body='/bod' then neprekladej:=true;
  125.                 end;
  126.  
  127.            'a'..'z','A'..'Z':
  128.                 begin
  129.                    repeat
  130.                       s:=s+ch;
  131.                       read(f,ch);
  132.                    until not(ch in pismena);{ted mam s=angl.slovo a ch=nepismeno}
  133.                    t:=lowercase(s);{ted mam t=s malymi pismeny}
  134.                    hledej(tab,t,u);
  135.  
  136.                    if (u=nil) or neprekladej
  137.                    then
  138.                    begin
  139.                        write(fcz,s);
  140.                        inc(neprelozenych);
  141.                    end
  142.  
  143.                    else
  144.                    begin
  145.                         write(fcz,'<span title="',u^.data.preklad,'">',s,'</span>');
  146.                         inc(prelozenych);
  147.                    end;
  148.  
  149.                    if (ch<>'<') then write(fcz,ch);{muze nastat pripad *}
  150.                 end;
  151.  
  152.            else write(fcz,ch);
  153.          end;
  154.       end;{* kdyby ch bylo < pak by to prelozilo spatne => "<title>Untitled</<span title="nßzev, titul">title</span>>"}
  155.       {---------------------------------------------------------}
  156.       close(fcz);
  157.  
  158.       inc(celkemp,prelozenych);
  159.       inc(celkemn,neprelozenych);
  160.  
  161.       str(prelozenych,t);
  162.       s:=space(5-length(t))+t+' ';
  163.       str(neprelozenych,t);
  164.       s:=s+space(5-length(t))+t;
  165.       s:=s+space(15-length(s));
  166.       cesta_full:=cesta;
  167.       if length(cesta)>55 then
  168.                           begin
  169.                              delete(cesta,1,length(cesta)-55);
  170.                              delete(cesta,1,pos('\',cesta));
  171.                              insert('.. ',cesta,1);
  172.                           end;
  173.       writeln(space(6)+s+cesta);
  174.       
  175.       close(f);
  176.       if del then erase(f);
  177.       if rep then begin erase(f); rename(fcz,cesta_full); end;
  178.    end;
  179. end;
  180.  
  181. {------------------------------------------------------------------------------}
  182.  
  183. procedure preloz_soubory(cesta:pathStr; spec:string);
  184. type ukprvek=^prvek;
  185.        prvek=record
  186.                 dalsi:ukprvek;
  187.                 str:string;
  188.              end;
  189. var f:SearchRec; seznam:ukprvek;
  190.    {---------------------------------------------------------}
  191.    procedure pridej_do_seznamu(var seznam:ukprvek; s:string);
  192.    var u:ukprvek;
  193.    begin
  194.       new(u);
  195.       u^.str:=s;
  196.       u^.dalsi:=seznam;
  197.       seznam:=u;
  198.    end;
  199.    {---------------------------------------------------------}
  200.    function neni_v_seznamu(seznam:ukprvek; s:string):boolean;
  201.    var b:boolean;
  202.    begin
  203.       b:=true;
  204.       while ((seznam<>nil) and b) do if seznam^.str=s then b:=false
  205.                                                       else seznam:=seznam^.dalsi;
  206.       neni_v_seznamu:=b;
  207.    end;
  208.    {---------------------------------------------------------}
  209. begin
  210.   seznam:=nil;
  211.   findfirst(cesta+spec,anyfile,f);
  212.   while doserror=0 do
  213.   begin
  214.     if ((pos('.cz.',f.name)=0) and neni_v_seznamu(seznam,cesta+'\'+f.name)) then
  215.     begin
  216.        preloz_html(cesta+'\'+f.name);
  217.        pridej_do_seznamu(seznam,cesta+'\'+f.name);
  218.     end;
  219.     findnext(f);
  220.   end;
  221. end;
  222.  
  223. {------------------------------------------------------------------------------}
  224.  
  225. procedure preloz_adresar(cesta:pathStr; spec:string);
  226. var adr:SearchRec;
  227. begin
  228.   preloz_soubory(cesta,spec);
  229.   findfirst(cesta+'\*.*',directory,adr);
  230.   while doserror=0 do
  231.   begin
  232.     if (adr.attr=directory) and (adr.name[1]<>'.') then preloz_adresar(cesta+'\'+adr.name,spec);
  233.     findnext(adr);
  234.   end;
  235. end;
  236.  
  237. {------------------------------------------------------------------------------}
  238.  
  239. begin
  240.    if not (paramcount in [1,2]) then vypis_informace
  241.    else
  242.    begin
  243.       del:=paramstr(2)='del';
  244.       rep:=paramstr(2)='rep';
  245.       cesta:=paramstr(1);
  246.       findfirst(cesta,anyfile,f);
  247.       if doserror<>0 then writeln('CHYBA - soubor nebo adresar neexistuje!')
  248.       else
  249.       begin
  250.          assign(fcz,'slovnik.cz');
  251.          {$I-}reset(fcz);{$I+}
  252.          if IOResult<>0 then writeln('CHYBA - html2cz.exe a slovnik.cz musi byt ve stejnem adresari!')
  253.          else
  254.          begin
  255.             {--------------------nacti--slovnik.cz--------------------}
  256.             slov:=0;
  257.             while not eof(fcz) do
  258.             begin
  259.                readln(fcz,s);
  260.                i:=pos(chr(9),s);
  261.                z.slovo:=copy(s,1,i-1);
  262.                z.preklad:=copy(s,i+1,length(s)-i);
  263.  
  264.                pridej_do_hashtable(tab,z);
  265.                inc(slov);
  266.             end;
  267.             {---------------------------------------------------------}
  268.             close(fcz);
  269.             writeln;writeln('pocet slov slovniku: ',slov);writeln;writeln;
  270.             writeln('prelozenych neprelozenych');writeln;
  271.             celkemp:=0; celkemn:=0;
  272.             
  273.             with zacatek do gettime(hod,min,sec,hun);
  274.             {---------------preloz--soubor--nebo--adresar-------------}
  275.             case f.attr of
  276.                32: preloz_html(cesta);             {zadan byl soubor - ten se prelozi}
  277.                16: preloz_adresar(cesta,'\*.htm*');{zadana byla slozka - ta se prelozi vcetne podadresaru}
  278.             end;
  279.             {---------------------------------------------------------}
  280.             with konec   do gettime(hod,min,sec,hun);
  281.             
  282.             celkem:=StartFinishTime(zacatek,konec);
  283.             
  284.             procent:=((100*celkemp)/(celkemp+celkemn));
  285.  
  286.             writeln(space(4)+'--------------');
  287.             writeln(space(5),celkemp,space(2),celkemn,space(5),'za: ',celkem.hod,'h ',celkem.min,'min ',celkem.sec,',',celkem.hun,'sec',space(5),'prelozeno: ',procent:5:2,'% slov');
  288.          end;
  289.       end;
  290.    end;
  291. end.