(*************************************************** 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=3.0.6 Requires=3.5.0 Comments=- Fix 17.12.2010 - Opraveno stahování celých popisů|- Add 16.12.2010 - Přidána možnost automat. aktualizace dle URL|- Fix 16.12.2010 - Opraveno stahování údajů|- Fix 16.6.2010 - Opraveno stahování popisu pro filmy bez popisu|- Add 16.6.2010 - Přidána možnost nahrazení oddělovače zemí za "/"|- Fix 12.5.2010 - Opravena chyba nestahování popisů|- Add 9.2.2009 - Možnost zadat URL filmu na ČSFD pro přímé získání informací|- Fix 16.9.2008 - Jedna malá chybka při hledání filmu s jedním výsledkem |- ReUpdate 8.9.2008 - Za pomoci zkušenějšího předěláno rozřezávání|- Update 28.8.2008 - implentace rozřezání do kategorií - byl to boj :D|- Fix 6.8.2008 - Oprava chyby ve výsledcích|- Update 30.7.2008 - oprava kódování|- 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 |- Update 4.12.2006 - zmena podle noveho csfd, vcetne importu hodnoceni License=This file is standalone 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 NahraditLomeno=1|1|1=Nahrazovat "/" u kategorie a země filmu|0=Nenahrazovat "/" u kategorie a země filmu AutoUpdateFromURL=0|0|0=Neaktualizovat automaticky|1=Pokud existuje URL, tak automaticky aktualizovat; jinak se zeptá getPicture=1|1|0=Nestahovat obrázky|1=Stahovat obrázky ***************************************************) program Csfd_cz; const BaseAddress = 'http://www.csfd.cz/'; ///////////////////////////////////////////// // upraveno mnohokrát :) // // IkE Blaster ike@thez.info // // 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 if (getOption('NahraditLomeno') = 1) then SetField(fieldCountry, trim(copy(StringReplace(Line, ' /', ', '), 0, CarkaPos1-1))) else 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; //Funkce nacte a prida vetev se seznamem nalezenych filmu Function AnalyzePageLang(Nazvy, Kat: String; Page: TStringList; LineNrOld : Integer) : Integer; var LineNr : Integer; Line, FilmAddr, FilmName, dalsi : String; BeginPos, EndPos : Integer; begin LineNr := FindLine(Nazvy, Page, 0); // pokud zadna takova sekce neexistuje - nenaslo se nic if (LineNr = -1) then result := LineNrOld else begin result := 1; // 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; until (BeginPos < 1); end; end; end; // analyzuje stranku s vysledky hledani procedure AnalyzePage(Address: String); var Page: TStringList; LineNr, LineNr2 : Integer; Line, FilmAddr : String; BeginPos, EndPos : Integer; 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); end; end else // jinak (pokud forward neexistuje) se asi vazne jedna primo o stranku s filmem begin AnalyzeMoviePage(Address); end; end else begin // vycisti strom okna se seznamem filmu PickTreeClear; PickTreeAdd('Hledaný výraz: ' + MovieName, ''); LineNr:=-1; LineNr:=AnalyzePageLang('v českých názvech', 'v českých', Page, LineNr); LineNr:=AnalyzePageLang('ve slovenských názvech', 've slovenských', Page, LineNr); LineNr:=AnalyzePageLang('v originálních názvech', 'v originálních', Page, LineNr); LineNr:=AnalyzePageLang('v anglických názvech', 'v anglických', Page, LineNr); if (LineNr = -1) then ShowMessage('Nebyl nalezen žádný film podle zadaného výrazu: ' + MovieName) else begin if PickTreeExec(Address) then AnalyzeMoviePage(Address); end; end; end; // analyzuje stranku s detaily filmu procedure AnalyzeMoviePage(Address: string); var Page: TStringList; LineNr : Integer; Line, Value, Value2 : String; LinePos, BeginPos, EndPos, MidPos, PomPos : Integer; begin Page := TStringList.Create; // pridani parametru stranky, ktere dovoli zobrazit kompletni popisek filmu //film.php?text=1&id=88025&rec=&top=&kom=1 // Page.Text := GetPage(Address + '&text=1rec=&top=&kom=1'); LineNr := pos('&', Address); if (LineNr > 0) then Address := copy(Address,0,LineNr-1); LineNr := pos('/text=1', Address); if (LineNr > 0) then Address := copy(Address,0,LineNr-1); Page.Text := UTF8Decode(GetPage(Address + '/text=1/')); // hleda radek na kterem se nachazi zacatek informaci o filmu LineNr := FindLine('font-size: 18px;font-weight:bold;color: #000000;font-family: Tahoma', Page, 0); // pokud ho nasel if (LineNr > -1) then begin LinePos := 1; // vezme si aktualni radek Line := Page.GetString(LineNr + LinePos); // odstrani specialni znaky z prelozeneho nazvu HTMLDecode(Line); // odstrani HTML tagy HTMLRemoveTags(Line); // ziska si jmeno filmu Value := Copy(Trim(Line), 1, Length(Trim(Line))); LinePos := LinePos + 1; Line := Page.GetString(LineNr + LinePos); Value2 := ''; repeat // najde si zacatek tabulky ve ktere se nachazi nazev filmu BeginPos := Pos('', Line); // najde si pozici obrazku ceske vlajky MidPos := Pos('flag_52.gif', Line); // vykopiruje si cely radek bez prnich 4 znaku Line := Copy(Line, BeginPos + 4, Length(Line) - (BeginPos + 3)); // urci si konec sloupecku (bunky) tabulky EndPos := Pos('', Line); // pokud neni nastavena pozice posledniho znaku - nastavi se if (EndPos = 0) then EndPos := Length(Line); // vykopirovani nazvu (a to jak ceskeho, tak slovenskeho) // v zavislosti na tom co uzivatel vybral if (getOption('getSlovakNames') = 1) then begin // pokud ma film v popisu nejen cesky nazev - prda jej za cesky if ((MidPos < BeginPos) and (MidPos > 0)) then Value := Value + '; ' + Copy(Line, 1, EndPos - 1) else Value2 := Value2 + Copy(Line, 1, EndPos - 1) + '; '; end; if (getOption('getSlovakNames') = 0) then begin // pokud ma film v popisu nejen cesky nazev - prda jej za cesky if ((MidPos < BeginPos) and (MidPos > 0)) then else Value2 := Value2 + Copy(Line, 1, EndPos - 1) + '; '; end; end; until (BeginPos < 1); if (getOption('theEnd') = 1) then // jestli na konci nazvu filmu je clen The -> presune se na zacatek nazvu filmu if (Pos(', The', Value2) > 0) then begin Value2 := 'The ' + Copy(Value2, 1, Pos(', The', Value2) + 1); end; if (getOption('addCZname') = 1) then begin // jestli neni prelozeny nazev, tak jej bez stredniku dpln // jinak jej dopln se strednikem if (GetField(fieldTranslatedTitle) = '') then SetField(fieldTranslatedTitle, Value) else SetField(fieldTranslatedTitle, Value + '; ' + GetField(fieldTranslatedTitle)); end else SetField(fieldTranslatedTitle, Value); if (Value2 = '') then Value2 := Value else Value2 := Copy(Value2, 1, length(Value2) - 2); SetField(fieldOriginalTitle, Value2); // primitivni kontrola zda je originalni nazev stejny jako prelozeny // pokud jsou stejne - prelozeny nazev se v zavislosti na nastaveni smaze if (getOption('allowDuplicateNames') = 0) then begin if (getField(fieldOriginalTitle) = getField(fieldTranslatedTitle)) then begin SetField(fieldTranslatedTitle, ''); end; end; //kategorie BeginPos := Pos('', Line); Line := Copy(Line, BeginPos + 3, Length(Line) - (BeginPos - 2)); MidPos := Pos('
', Line); EndPos := Pos('
', Line); PomPos := Pos('min', Line); //existuji oba radky - kategorie i stat,rok,delka if ((MidPos < EndPos) and (MidPos > 0)) then begin Value := Trim(Copy(Line, 1, MidPos - 7)); if (getOption('NahraditLomeno') = 1) then SetField(fieldCategory, StringReplace(Value, ' /',', ')) else SetField(fieldCategory, Value); Value := Trim(Copy(Line, MidPos + 4, EndPos - MidPos - 4)); RozdelStat(Value); end else //existuje jen jeden radek if ((PomPos < EndPos) and (PomPos > 0)) then begin Value := Trim(Copy(Line, 1, EndPos - 1)); RozdelStat(Value); end else begin Value := Trim(Copy(Line, 1, EndPos - 7)); if (getOption('NahraditLomeno') = 1) then SetField(fieldCategory, StringReplace(Value, ' /',', ')) else SetField(fieldCategory, Value); end; Value := GetDirector(Line); SetField(fieldDirector, Value); Value := GetActor(Line); SetField(fieldActors, Value); end; if (getOption('hodnoceni') = 1) then begin // hodnoceni by MadMaxx LineNr := FindLine('padding:10px;text-align:center;font-weight:bold;font-size:36px;color:white;', Page, 0); Line := Page.GetString(LineNr + 1); BeginPos := 14; EndPos := Pos('%', Line); Value := copy(Line, BeginPos, EndPos); if ( EndPos <> BeginPos + 1 ) then //(Length(Value) > 1) then begin Value2 := copy(Value, 1, 1) + ',' + copy(Value, 2, 1); end else begin Value2 := '0,' + copy(Value, 1, 1); end; SetField(fieldRating, Value2); end; // picture if (getOption('getPicture') = 1) then begin LineNr := FindLine('table background="http://img.csfd.cz/posters/', Page, 0); if (LineNr > -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; end; //Info Line := Page.Text; LineNr := pos('
', Line); if (LineNr > 0) then begin Value:=copy(Line,LineNr,pos('

',Line) - LineNr); HTMLRemoveTags(Value); HTMLDecode(Value); SetField(fieldDescription, Value); end else begin SetField(fieldDescription, ''); end; // URL SetField(fieldURL, Address); //DisplayResults; end; begin // kontrola verze movie catalogu if CheckVersion(3,5,0) then begin MovieName := GetField(fieldTranslatedTitle); // pokud je originalni jmeno filmu prazdne, vem jmeno prelozene if (MovieName = '') then MovieName := GetField(fieldOriginalTitle); if ((getOption('AutoUpdateFromURL') = 1) and (GetField(fieldURL) <> '')) then MovieName := GetField(fieldURL) else if Input('Import movie from www.csfd.cz', 'Zadejte název filmu:', MovieName) = false then Exit; // zadani z inputu if pos('csfd.cz', MovieName) > 0 then begin AnalyzeMoviePage(MovieName); end else 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.