antp.be forum

Code: Select all

(***************************************************

Ant Movie Catalog importation script
www.antp.be/software/moviecatalog/

[Infos]
Authors=IkE Blaster, MadMaxx, Dmitry501, Inteline, Kalten, kecinzer, MI'RA, xvirusx
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 18.12.2010 - Opraveno stahování obrázků|- Add 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('<br>', 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('<br>', 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('<a href="/film/', Page, LineNr);
          // pokud takovou radku najdeme
          if (LineNr > -1) then
            begin
              // prida vetev se seznamem nalezenych filmu
              PickTreeAdd('Nalezené filmy ' + kat + ' názvech', '');
              // vezme si obsah radku na kterem se vyskytuje prvni tag "a href" na film
              Line := Page.GetString(LineNr);

              // projde vsechny tagy s nalezem filmu a nacpe je do stromu filmu,
              // ktery se pak formou dialogoveho okna pro vyber filmu zobrazi
              repeat
                // najde zacatek a konec tagu s odkazem na aktualne nalezeny film
                BeginPos := Pos('<a href="/film/', Line);
                if (BeginPos > 0) then
                  begin
                    EndPos := Pos('" style="font-size:12px">', 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 <br> tagem
                    EndPos := Pos('<br>', 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: <b>
  LineNr := FindLine('Hledaný výraz: <b>', Page, 0);
  LineNr2 := FindLine('<script language=''javascript''>window.location.href=''/film/', Page, 0);
  // pokud takovy radek neexistuje - jedna se pravdepodobne primo o stranku s
  // filmem a ne o stranku s vysledkem hledani a zanalyzuje se rovnou ta.
  // pokud vsak takovy radek existuje, ale neexistuje zadne slovo "nazvech" -
  // - cili zadna sekce s odkazy => jedna se pravdepodobne o stranku, ktera
  // automaticky forwarduje na stranku s filmem
  if (LineNr2 <> -1) then
    begin
      // hledani forwardu na stranku s filmem
      LineNr := FindLine('<script language=''javascript''>window.location.href=''/film/', Page, 0);
      // pokud existuje forward na stranku s detailem filmu - vytahnu adresu stranky detailu
      if (LineNr <> -1) then
        begin
          Line := Page.GetString(LineNr);
          BeginPos := Pos('/film/', Line);
          if (BeginPos > 0) then
            begin
              EndPos := Pos('/'';</script>', 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</td>', 'v českých', Page, LineNr);
      LineNr:=AnalyzePageLang('ve slovenských názvech</td>', 've slovenských', Page, LineNr);
      LineNr:=AnalyzePageLang('v originálních názvech</td>', 'v originálních', Page, LineNr);
      LineNr:=AnalyzePageLang('v anglických názvech</td>', '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('<table cellpadding=', Line);

        // pokud jej nasel
        if (BeginPos > 0) then
          begin
            // vezme si prvni sloupecek (bunku) z tabulky
            BeginPos := Pos('<td>', 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('</td>', 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('<b>', Line);
      Line := Copy(Line, BeginPos + 3, Length(Line) - (BeginPos - 2));
      MidPos := Pos('<br>', Line);
      EndPos := Pos('</b>', Line);
      PomPos := Pos('min</b>', 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
    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;



  //Info
  Line := Page.Text;
  LineNr := pos('<div style=''float:left;width:425px;padding-top:10px;font-weight:normal''>', Line);

  if (LineNr > 0) then begin
    Value:=copy(Line,LineNr,pos('</tr><tr><td width=''720''><br>',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.