home *** CD-ROM | disk | FTP | other *** search
- {$H+}
- program html2cz;
- {html2cz je siren pod licenci GNU GPL - gpl.txt
- slovnik.cz je siren pod licenci GNU FDL - fdl.txt}
- uses dos,uhash;
- type cas=record
- hod, min, sec, hun: word;
- end;
- var cesta:pathStr; f:SearchRec; fcz:text; s:string; del,rep:boolean;
- slov:longint; z:zaznam; i:integer; procent:real;
- celkemp,celkemn:longint; zacatek,konec,celkem: cas;
-
- {------------------------------------------------------------------------------}
-
- procedure vypis_informace;
- begin
- writeln;
- writeln(space(5)+'html2cz je program ktery obohati html stranky v anglickem jazyce');
- writeln(space(5)+'o jejich cesky preklad - vice viz README.');
- writeln;
- writeln(space(5)+'Parametry programu jsou nasledujici:');
- writeln(space(5)+'html2cz.exe [cesta] [del | rep]');
- writeln;
- writeln(space(5)+'kde [cesta] je povinny parametr a muze znamenat:');
- writeln(space(5)+'"html2cz c:\slozka" - prelozi se zadana slozka');
- writeln(space(5)+'"html2cz c:\soubor" - prelozi se zadany soubor');
- writeln(space(5)+'"html2cz slozka" - prelozi se slozka, ktera je v html2cz adresari');
- writeln(space(5)+'"html2cz soubor" - prelozi se soubor, ktery je v html2cz adresari');
- writeln;
- writeln(space(5)+'a [del | rep] jsou nepovinne vylucujici se parametry kde:');
- writeln(space(5)+'del = smaze anglicke soubory a ponecha ".cz.html" soubory');
- writeln(space(5)+'rep = prepise anglicke soubory ceskymi');
- writeln;
- writeln(space(5)+'Priklad:');
- writeln(space(5)+'html2cz.exe c:\html40 rep');
- writeln(space(5)+'prepise vsechny anglicke soubory ve slozce c:\html40.');
- writeln;
- writeln(space(5)+'Po otevreni souboru *.cz.html v libovolnem');
- writeln(space(5)+'internetovem prohlizeci se po najeti mysi na');
- writeln(space(5)+'anglicke slovo objevi bublina s ceskym prekladem.');
- end;
-
- {------------------------------------------------------------------------------}
-
- function StartFinishTime(start, finish: cas): cas;
- var startfinish: cas;
-
- begin
- with start do
- begin
- if finish.hod-hod<0 then
- begin
- startfinish.hod:=(24-hod)+finish.hod;
- {dec(startfinish.den); :) }
- end
- else startfinish.hod:=finish.hod-hod;
- {----------------------}
- if finish.min-min<0 then
- begin
- startfinish.min:=(60-min)+finish.min;
- dec(startfinish.hod);
- end
- else startfinish.min:=finish.min-min;
- {----------------------}
- if finish.sec-sec<0 then
- begin
- startfinish.sec:=(60-sec)+finish.sec;
- dec(startfinish.min);
- end
- else startfinish.sec:=finish.sec-sec;
- {----------------------}
- if finish.hun-hun<0 then
- begin
- startfinish.hun:=(100-hun)+finish.hun;
- dec(startfinish.sec);
- end
- else startfinish.hun:=finish.hun-hun;
- end;
- StartFinishTime:=startfinish;
- end;
-
- {------------------------------------------------------------------------------}
-
- procedure preloz_html(cesta:pathStr);
- const pismena=['a'..'z','A'..'Z'];
- var f,fcz:text; i:integer; vlozeno,neprekladej:boolean;
- ch:char; s,t:string; body:string[4]; u:ukprvek;
- prelozenych,neprelozenych:longint; cesta_cz,cesta_full:pathStr;
- begin
- assign(f,cesta);
- {$I-}reset(f);{$I+}
- if IOResult<>0 then writeln('CHYBA - nemohu otevrit soubor: '+cesta)
- else
- begin
- cesta_cz:=cesta;
-
- vlozeno:=false;
- i:=length(cesta_cz);
- repeat
- if cesta_cz[i]='.' then begin insert('.cz',cesta_cz,i); vlozeno:=true; end;
- dec(i);
- until vlozeno;
-
- neprekladej:=true; ch:=chr(0); prelozenych:=0; neprelozenych:=0;
-
- assign(fcz,cesta_cz);
- rewrite(fcz);
- {--------------------prace--s--html-----------------------}
- while not eof(f) do
- begin
- s:=''; body:='';
- if ch<>'<' then read(f,ch);{muze nastat pripad *}
- case ch of
-
- '<': begin
- repeat
- write(fcz,ch);
- read(f,ch);
- body:=body+ch;
- until ch='>';
- write(fcz,ch);
- body:=lowercase(body);
- if body='body' then neprekladej:=false;
- if body='/bod' then neprekladej:=true;
- end;
-
- 'a'..'z','A'..'Z':
- begin
- repeat
- s:=s+ch;
- read(f,ch);
- until not(ch in pismena);{ted mam s=angl.slovo a ch=nepismeno}
- t:=lowercase(s);{ted mam t=s malymi pismeny}
- hledej(tab,t,u);
-
- if (u=nil) or neprekladej
- then
- begin
- write(fcz,s);
- inc(neprelozenych);
- end
-
- else
- begin
- write(fcz,'<span title="',u^.data.preklad,'">',s,'</span>');
- inc(prelozenych);
- end;
-
- if (ch<>'<') then write(fcz,ch);{muze nastat pripad *}
- end;
-
- else write(fcz,ch);
- end;
- end;{* kdyby ch bylo < pak by to prelozilo spatne => "<title>Untitled</<span title="nßzev, titul">title</span>>"}
- {---------------------------------------------------------}
- close(fcz);
-
- inc(celkemp,prelozenych);
- inc(celkemn,neprelozenych);
-
- str(prelozenych,t);
- s:=space(5-length(t))+t+' ';
- str(neprelozenych,t);
- s:=s+space(5-length(t))+t;
- s:=s+space(15-length(s));
- cesta_full:=cesta;
- if length(cesta)>55 then
- begin
- delete(cesta,1,length(cesta)-55);
- delete(cesta,1,pos('\',cesta));
- insert('.. ',cesta,1);
- end;
- writeln(space(6)+s+cesta);
-
- close(f);
- if del then erase(f);
- if rep then begin erase(f); rename(fcz,cesta_full); end;
- end;
- end;
-
- {------------------------------------------------------------------------------}
-
- procedure preloz_soubory(cesta:pathStr; spec:string);
- type ukprvek=^prvek;
- prvek=record
- dalsi:ukprvek;
- str:string;
- end;
- var f:SearchRec; seznam:ukprvek;
- {---------------------------------------------------------}
- procedure pridej_do_seznamu(var seznam:ukprvek; s:string);
- var u:ukprvek;
- begin
- new(u);
- u^.str:=s;
- u^.dalsi:=seznam;
- seznam:=u;
- end;
- {---------------------------------------------------------}
- function neni_v_seznamu(seznam:ukprvek; s:string):boolean;
- var b:boolean;
- begin
- b:=true;
- while ((seznam<>nil) and b) do if seznam^.str=s then b:=false
- else seznam:=seznam^.dalsi;
- neni_v_seznamu:=b;
- end;
- {---------------------------------------------------------}
- begin
- seznam:=nil;
- findfirst(cesta+spec,anyfile,f);
- while doserror=0 do
- begin
- if ((pos('.cz.',f.name)=0) and neni_v_seznamu(seznam,cesta+'\'+f.name)) then
- begin
- preloz_html(cesta+'\'+f.name);
- pridej_do_seznamu(seznam,cesta+'\'+f.name);
- end;
- findnext(f);
- end;
- end;
-
- {------------------------------------------------------------------------------}
-
- procedure preloz_adresar(cesta:pathStr; spec:string);
- var adr:SearchRec;
- begin
- preloz_soubory(cesta,spec);
- findfirst(cesta+'\*.*',directory,adr);
- while doserror=0 do
- begin
- if (adr.attr=directory) and (adr.name[1]<>'.') then preloz_adresar(cesta+'\'+adr.name,spec);
- findnext(adr);
- end;
- end;
-
- {------------------------------------------------------------------------------}
-
- begin
- if not (paramcount in [1,2]) then vypis_informace
- else
- begin
- del:=paramstr(2)='del';
- rep:=paramstr(2)='rep';
- cesta:=paramstr(1);
- findfirst(cesta,anyfile,f);
- if doserror<>0 then writeln('CHYBA - soubor nebo adresar neexistuje!')
- else
- begin
- assign(fcz,'slovnik.cz');
- {$I-}reset(fcz);{$I+}
- if IOResult<>0 then writeln('CHYBA - html2cz.exe a slovnik.cz musi byt ve stejnem adresari!')
- else
- begin
- {--------------------nacti--slovnik.cz--------------------}
- slov:=0;
- while not eof(fcz) do
- begin
- readln(fcz,s);
- i:=pos(chr(9),s);
- z.slovo:=copy(s,1,i-1);
- z.preklad:=copy(s,i+1,length(s)-i);
-
- pridej_do_hashtable(tab,z);
- inc(slov);
- end;
- {---------------------------------------------------------}
- close(fcz);
- writeln;writeln('pocet slov slovniku: ',slov);writeln;writeln;
- writeln('prelozenych neprelozenych');writeln;
- celkemp:=0; celkemn:=0;
-
- with zacatek do gettime(hod,min,sec,hun);
- {---------------preloz--soubor--nebo--adresar-------------}
- case f.attr of
- 32: preloz_html(cesta); {zadan byl soubor - ten se prelozi}
- 16: preloz_adresar(cesta,'\*.htm*');{zadana byla slozka - ta se prelozi vcetne podadresaru}
- end;
- {---------------------------------------------------------}
- with konec do gettime(hod,min,sec,hun);
-
- celkem:=StartFinishTime(zacatek,konec);
-
- procent:=((100*celkemp)/(celkemp+celkemn));
-
- writeln(space(4)+'--------------');
- 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');
- end;
- end;
- end;
- end.