(*************************************************** Ant Movie Catalog importation script www.antp.be/software/moviecatalog/ [Infos] Authors=Lrrr, georgeso Title=fdb.cz Description=Import dat ze serveru fdb.cz Site=www.fdb.cz Language=CZ Version=1.0 RC2 Requires=3.5.0 Comments=ReUpdate 13.9.2008 - georgeso: Opraveno načítání herců u animovaných filmů|10.9.2008 - georgeso: Zprovoznění skriptu pro načítání z aktuálního designu stránek|skript na ziskavani dat z www.fdb.cz License=This program 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 2 of the License, or (at your option) any later version. GetInfo=1 [Options] ***************************************************) program fdb_cz; const BaseAddress = 'http://fdb.cz/'; var MovieName,osoby_address,popis_Address,Line: string; LineNr : integer; // 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; function Min(A, B : Integer) : Integer; begin if (A < B) then result := A else result := B; if (B=0) then result := A; if (A=0) then result := B; end; // analyzuje stranku s vysledky hledani procedure AnalyzePage(Address: String); var Page: TStringList; LineNr : Integer; Line, Value : String; BeginPos, EndPos, i : Integer; FilmName, FilmAddr : String; begin Page := TStringList.Create; // nacte si stranku s vysledkem hledani - kazda radka je poloza StringListu Page.Text := GetPage(Address); // najdeme radku na ktere je odkaz na nalezeny film LineNr := FindLine('',Line)+5,Min(pos('
',Line) - 5); PickTreeAdd(FilmName, BaseAddress + FilmAddr); until pos('',stranka)+6); nazev:=copy(stranka,1,pos('(',stranka)-1); SetField(fieldTranslatedTitle, nazev); //rok value:=copy(stranka,pos('(',stranka)+1,4); SetField(fieldYear, trim(value)); //obrazek if pos('"http://img.fdb.cz/obrazky/',stranka) <> 0 then begin delete(stranka,1,pos('"http://img.fdb.cz/obrazky/',stranka)); value:=copy(stranka,0,pos('" />',stranka)-1); GetPicture(value); end; // orig. nazev if pos('

',stranka) <> 0 then begin delete(stranka,1,pos('

',stranka)+28); value := copy(stranka,1,pos('

',stranka)-1) end else value:=nazev; SetField(fieldOriginalTitle, Value); //kategorie delete(stranka,1,pos('Žánr:',stranka)+19); value:= copy(stranka,1,pos('
',stranka)-1); SetField(fieldCategory, Value); //zeme delete(stranka,1,pos('Země:',stranka)+19); value:= copy(stranka,1,pos('
',stranka)-1); SetField(fieldCountry, Value); //delka delete(stranka,1,pos('Délka:',stranka)+15); value:= copy(stranka,1,pos('min.',stranka)-1); SetField(fieldLength, trim(Value)); end; procedure getPopis(address:string); var stranka:string; i:integer; begin stranka := GetPage(address); i := pos('Popis / Obsah / Info:
',stranka); delete(stranka,1,pos('Popis / Obsah / Info:
',stranka)+33); stranka:=copy(stranka, 1, pos('

',stranka)); HTMLRemoveTags(stranka); HTMLDecode(stranka); SetField(fieldDescription, stranka); end; procedure GetActors(address:string); var Page : Tstringlist; stranka,tmp, value: string; hrany :boolean; begin Page := TStringList.Create; Page.Text := GetPage(address); // najdeme radku na ktere jsou herci LineNr := FindLine('
', Page, LineNr); // pokud takovou radku najdeme if (LineNr > -1) then begin Line := Page.GetString(LineNr); //HTMLRemoveTags(Line); HTMLDecode(Line); stranka:=Line; if pos('hraje:',stranka)=0 then hrany := false else hrany:= true; //reziser delete(stranka,1,pos('režie:',stranka)); tmp := copy(stranka, 1, pos('',stranka)); value:= ''; repeat delete(tmp,1,pos('alt="',tmp)+4); value := value + copy(tmp,0, min(pos('" align',tmp),pos('" heigh',tmp)) - 1) + ', '; until (pos('alt="',tmp) = 0); delete(value,length(value)-1,1); SetField(fieldDirector, trim(Value)); //herci if hrany then delete(stranka,1,pos('hraje:',stranka)) else delete(stranka,1,pos('mluví:',stranka)); tmp := copy(stranka, 1, pos('',stranka)); value:= ''; repeat delete(tmp,1,pos('alt="',tmp)+4); value := value + copy(tmp,0, min(pos('" align',tmp),pos('" heigh',tmp)) - 1) + ', '; until (pos('alt="',tmp) = 0); delete(value,length(value)-1,1); SetField(fieldActors, trim(Value)); end; end; begin // kontrola verze movie catalogu if CheckVersion(3,5,0) then begin MovieName := GetField(fieldTranslatedTitle); // pokud je prelozene jmeno filmu prazdne, vem jmeno originalni if (MovieName = '') then MovieName := GetField(fieldOriginalTitle); // zadani z inputu if Input('Import movie from www.fdb.cz', 'Enter the title of the movie:', MovieName) then begin // analyzuj stranku http://fdb.cz/vyhledavani.php?hledat=nazev_filmu&co=filmy AnalyzePage(BaseAddress + 'vyhledavani.html?hledat=' + UrlEncode(MovieName)); end; end else ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.0)'); end.