(*************************************************** Ant Movie Catalog importation script www.antp.be/software/moviecatalog/ [Infos] Authors=IkE Blaster,MadMaxx,Dmitry501,Inteline,Kalten,kecinzer,MI'RA Title=csfd.cz Description=Import dat ze serveru csfd.cz Site=http://amc.thez.info Language=CZ Version=2.9 Requires=3.5.0 Comments=- Update 10.8.2007 - Jiné řazení výsledků (jako na webu), opraveno stahování popisu (více řádků), přesunutí La před film|- Info 5.3.2007 - Proběhlo hodně úprav, chyba u odkazu na film (z csfd) u filmů s jedním výsledkem ve vyhledávání|- Update 3.1.2007 - opraveno zobrazování filmů s jedním výsledkem ve vyhledávání|- Update 31.12.2006 - opraveny vsechny pole :P | - jeden bug - v www adrese jsou pred film dve lomitka (//), nema vliv na funkci|- Update 4.12.2006 - zmena podle noveho csfd, vcetne importu hodnoceni License=This file is part of Ant Movie Catalog (AMC).|| AMC is free software; you can redistribute it and/or modify| it under the terms of the GNU General Public License as published by| the Free Software Foundation; either version 3 of the License, or| (at your option) any later version.|| AMC is distributed in the hope that it will be useful,| but WITHOUT ANY WARRANTY; without even the implied warranty of| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the| GNU General Public License for more details.|| You should have received a copy of the GNU General Public License| along with this program. If not, see http://www.gnu.org/licenses/ GetInfo=1 [Options] getSlovakNames=0|0|0=Nepřidávat za český název ještě nazev slovenský|1=Přidávat za český název ještě nazev slovenský hodnoceni=1|1|0=Nedotahovat hodnoceni|1=Dotahovat hodnoceni addCZdescr=1|1|0=Nepridavat cesky popis filmu pred stavajici.|1=Pridavat cesky popis filmu pred stavajici addCZname=0|0|0=Nepridavat cesky nazev filmu pred stavajici|1=Pridavat cesky nazev filmu pred stavajici allowDuplicateNames=0|0|0=Pokud je originalni nazev stejny jako prelozeny - prelozeny se nedoplni|1=Prelozeny nazev se doplni i v pripade, ze je stejny jako originalni nazev theEnd=1|1|0=Zachovat "The" na konci nazvu filmu|1=Presunout "The" z konce nazvu filmu na zacatek ***************************************************) program Csfd_cz; const BaseAddress = 'http://www.csfd.cz/'; ///////////////////////////////////////////// // upraveno mnohokrát po aktualizaci CSFD // // by IkE Blaster ikeblaster@centrum.cz // // http://amc.thez.info // ///////////////////////////////////////////// //////////////////////////////////////////// // upraveno 4.12.2006 po aktualizaci CSFD // // by MadMaxx madmaxx.cz@gmail.com // //////////////////////////////////////////// var MovieName: string; // vraci cislo radku s prvnim nalezem hledaneho textu function FindLine(Pattern: String; List: TStringList; StartAt: Integer): Integer; var i: Integer; begin result := -1; // vzdy se zacne hledat od nuly if (StartAt < 0) then StartAt := 0; // cyklus od prvniho do posledniho radku stranky for i := StartAt to List.Count - 1 do begin // pokud byl nalezen vyskyt, if (Pos(Pattern, List.GetString(i)) <> 0) then begin // vrati se cislo radku na kterem byl text nalezen result := i; // a ukonci se cyklus hledani Break; end; end; end; //rozdeleni statu, roku a delky zavisle na carkou oddelenych hodnotach procedure RozdelStat(Line: String); var CarkaPos1, CarkaPos2, minPos: Integer; begin // najde si prvni carku na textu radky CarkaPos1 := Pos(',', Line); // pokud ji nasel if (CarkaPos1 > 0) then begin // pokusi se najit druhou carku CarkaPos2 := Pos(',', copy(Line, CarkaPos1+1, length(Line))); // pokud nasel druhou carku if (CarkaPos2 > 0) then begin // urci si minPos := Pos('min', copy(Line, CarkaPos1+CarkaPos2+1, length(Line))); // kdyz pozici zna if (minPos > 0) then // nastavi zemi, rok a stat do prislusnych poli begin SetField(fieldCountry, trim(copy(Line, 0, CarkaPos1-1))); SetField(fieldYear, trim(copy(Line, CarkaPos1+1, CarkaPos2-1))); SetField(fieldLength, trim(copy(Line, CarkaPos1+CarkaPos2+1, minPos-1))); end end end end; // vraci rejzu //TODO tahle fce by chtela doresit, pac se muze stavat, ze rezie je na stejnem // radku stejne jako seznam hercu function GetDirector(Line: String): String; var BeginPos: Integer; begin result := ''; // zjisti si na kolikatem znaku od zacatku radku se vyskytuje text "Režie:" //TODO: doresil bych hledani diakritiky v textu - mozna by to v nekterych pripadech mohlo delat potize BeginPos := Pos('Režie:', Line); // jestli pozici nasel if (BeginPos > 0) then begin // smaze vse pred nalezem Delete(Line, 1, BeginPos + 5); // najde si konec radku BeginPos := Pos('
', Line); if (BeginPos = 0) then BeginPos := Length(Line); // vrati z obsahu radku rezisera result := copy(Line, 1, BeginPos); // odstrani diakritiku a specialni znaky HTMLDecode(result); // odstrani HTML tagy HTMLRemoveTags(result); end; // pokud pozici nenasel - vrati prazdny retezec result := Trim(result); end; // vraci seznam hercu function GetActor(Line: String): String; var BeginPos: Integer; begin // komentare jsou stejne jako v predchozi fci result := ''; BeginPos := Pos('Hrají:', Line); if (BeginPos > 0) then begin Delete(Line,1,BeginPos + 5); BeginPos := Pos('
', Line); if (BeginPos = 0) then BeginPos := Length(Line); result := copy(Line, 1, BeginPos); HTMLDecode(result); HTMLRemoveTags(result); end; result := Trim(result); end; // analyzuje stranku s vysledky hledani procedure AnalyzePage(Address: String); var Page: TStringList; LineNr : Integer; LineNr2 : Integer; LineMr : Integer; Line, Value : String; BeginPos, EndPos, i : Integer; FilmName, FilmAd, FilmAddr, dalsi, oNazvy, aNazvy, cNazvy, sNazvy : String; begin Page := TStringList.Create; // nacte si stranku s vysledkem hledani - kazda radka je poloza StringListu // Page.Text := GetPage(Address); Page.Text := UTF8Decode(GetPage(Address)); // zjisti cislo radky na ktere se nachazi retezec: Hledaný výraz: LineNr := FindLine('Hledaný výraz: ', Page, 0); LineNr2 := FindLine('', Line); if (EndPos = 0) then EndPos := Length(Line); // vykopiruje si adresu aktualniho filmu z radku FilmAddr := Copy(Line, BeginPos +1, EndPos - BeginPos -1); AnalyzeMoviePage(BaseAddress + FilmAddr + '&text=1rec=&top=&kom=1'); end; end else // jinak (pokud forward neexistuje) se asi vazne jedna primo o stranku s filmem begin AnalyzeMoviePage(Address); end; end else begin // zjisteni cisla radku, na kterem se naleza informace v ktere sekci nazvu hledat oNazvy := 'v originálních názvech'; aNazvy := 'v anglických názvech'; cNazvy := 'v českých názvech'; sNazvy := 've slovenských názvech'; // tento algoritmus funguje tak, ze postupne hleda ve vsech jazykach, dokud neco nenajde LineNr := FindLine(cNazvy, Page, 0); i := 0; if (LineNr = -1) then begin LineNr := FindLine(sNazvy, Page, 0); i := 1; end; if (LineNr = -1) then begin LineNr := FindLine(oNazvy, Page, 0); i := 2; end; if (LineNr = -1) then LineNr := FindLine(aNazvy, Page, 0); // pokud zadna takova sekce neexistuje - nenaslo se nic if (LineNr = -1) then ShowMessage('No movie found for this search.'+chr(13)+chr(13)+'Nebyly nalezeny zadne zaznamy.') else begin // jinak si najdeme radku na ktere je v dane sekci odkaz na nalezeny film LineNr := FindLine('', Line); // tady to bylo spatne, proto se nacitala ta adresa blbe if(EndPos = 0) then EndPos := Pos('">', Line); if (EndPos = 0) then EndPos := Length(Line); // vykopiruje si adresu aktualniho filmu z tagu odkazu FilmAddr := Copy(Line, BeginPos + 10, EndPos - BeginPos - 11); // dekoduje specialni ceske znaky z adresy odkazu na film HTMLDecode(FilmAddr); // odstrani vsechny HTML TAGY HTMLRemoveTags(FilmAddr); // vezme konec radku identifikovany
tagem EndPos := Pos('
', Line); FilmAddr := FilmAddr + '&text=1'; if (EndPos = 0) then EndPos := Length(Line); // vykopiruje se z tagu odkazu jmeno filmu FilmName := Copy(Line, BeginPos, EndPos - BeginPos); HTMLDecode(FilmName); HTMLRemoveTags(FilmName); // hledani znacky urcujici, ze na strance je odkaz na dalsi hledani dalsi := Copy(FilmName, 0, 25); // jestli se na strance vyskytuje odkaz na dalsi seznam filmu if (dalsi = '...další nalezené záznamy') then FilmName := Copy(FilmName, 26, Length(FilmName) - 25); if (FilmName <> '') then PickTreeAdd(FilmName, BaseAddress + FilmAddr); Delete(Line,1,EndPos+3); end else // tohle to upravil hard-corove kecinzer, doma jen na koleni, pac delphi vubec neumi, je to humus, ja vim :) begin case i of 0: begin // hledam anglicky nazev, pokud nenajdu, tak hledam postupne dalsi nazvy LineNr := FindLine(sNazvy, Page, 0); i := 1; if (LineNr = -1) then begin LineNr := FindLine(oNazvy, Page, 0); if (LineNr = -1) then begin BeginPos := 0; i := 2; end; end; if (i = 1) or (i = 2) then begin LineNr := FindLine('
-1) then begin Line := Page.GetString(LineNr); BeginPos := pos('table background="http://img.csfd.cz/posters', Line) + 18; if (BeginPos > 10) then begin EndPos := pos('" border="', Line); Value := copy(Line, BeginPos, EndPos - BeginPos); GetPicture(Value); end; end; // Info // LineNr := FindLine(' ', Page, 0); // if (LineNr > -1) then // begin // Line := Page.GetString(LineNr+1); // BeginPos := pos('float:left', Line); // EndPos := pos('
', Page.GetString(LineNr)); // Value := copy(Line, BeginPos, EndPos - BeginPos); // HTMLDecode(Value); // HTMLRemoveTags(Value); // if (getOption('addCZdescr') = 1) then // SetField(fieldDescription, Trim(Value) + #13#10 + #13#10 + GetField(fieldDescription)) // else // SetField(fieldDescription, Trim(Value)); // end //Info Line := UTF8Decode(GetPage(Address)); //Line := GetPage(address); Value:=copy(Line,pos('
',Line), pos('
',Line) - pos('
',Line)); HTMLRemoveTags(Value); HTMLDecode(Value); SetField(fieldDescription, Value); // URL SetField(fieldURL, Address); //DisplayResults; end; begin // kontrola verze movie catalogu if CheckVersion(3,5,0) then begin MovieName := GetField(fieldOriginalTitle); // pokud je originalni jmeno filmu prazdne, vem jmeno prelozene if (MovieName = '') then MovieName := GetField(fieldTranslatedTitle); // zadani z inputu if Input('Import movie from www.csfd.cz', 'Enter the title of the movie:', MovieName) then begin // analyzuj stranku http://www.csfd.cz/search_pg.php?search=jmeno_filmu AnalyzePage(BaseAddress + 'search_pg.php?search=' + UrlEncode(UTF8Encode(MovieName))); end; end else ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.0)'); end.