[Cz] CSFD.CZ - Working script

WaVe_99 · Post by **WaVe_99** » 2005-09-01 08:16:38

Don´t work import from csfd.cz, the best Movie Catalog in Czech republic. Structure WWW pages was change. Please, could you somebody to change this script ? Thank you very much.

MI'RA · Post by **MI'RA** » 2005-09-06 06:29:03

Tak jsem se v tom postrachal. Upravil jsem trosku formatovani kodu a pridal komentare, aby to mohl kdokoli opravit poradne.

Predem rikam, ze moje oprava je cistokrevny hotfix :-). Tzn. ze ne vsechny komentare jsou opravdu 100%ne spravne a nektere veci se nedotahuji jak maji. Proste narychlo opravene.

Nicmene to ted funguje a pocitam, ze pokud behem nasledujicich nekolika dnu se k tomu dostanu - optimalizju ten kod poradne.

Zmena struktury CSFD se musi projevit i ve scriptu. Tzn. ze minimalne se musi dopsat do scriptu to jejich hledani v originalnich, ceskych a slovenskych nazvech. Tohle zatim nejede.

Pocitam jeste s tim, ze bych pridal moznost "prilepovani" nalezenych poli za pole, ktera jsou jiz v programu vyplnena (momentalne se predchozi hodnoty premazavaji). To je dobre proto, aby clovek mel jednak popis z CSFD a za nim treba v EN popis z IMDB...

Ale pokud to nekdo udela za me - budu rad, pac nebudu mit uz zadnou praci :-)).

Pripadne piste na ICQ: 126810450 a muzeme se domluvit, ze kazdy udelame/vylepsime kousek.

A ted uz slibeny script:

Code: Select all

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

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

[Infos]
Authors=Dmitry501,Inteline,MI'RA
Title=csfd.cz
Description=Imports from csfd.cz

Site=www.csfd.cz
Language=CZ
Version=
Requires=3.5.0
Comments=
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 Csfd_cz;
const
  BaseAddress = 'http://www.csfd.cz/';

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
    // 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;

//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('<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;

// analyzuje stranku s vysledky hledani
procedure AnalyzePage(Address: String);
var
  Page: TStringList;
  LineNr : Integer;
  Line, Value : String;
  BeginPos, EndPos : Integer;
  FilmName, FilmAddr, dalsi : String;
begin
  Page := TStringList.Create;
  // nacte si stranku s vysledkem hledani
  Page.Text := GetPage(Address);
  // zjisti cislo radky na ktere se nachazi retezec: Hledaný výraz: <b>
  LineNr := FindLine('Hledaný výraz: <b>', 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.
  if (LineNr = -1) then
    begin
      AnalyzeMoviePage(Address);
    end
  else
    begin
      // zjisteni cisla radku, na ktere se naleza text: FILMY</td>
      LineNr := FindLine('v originálních názvech</td>', Page, 0);
      // pokud takova radka neexistuje - nenaslo se nic
      if (LineNr = -1) then
        ShowMessage('No movie found for this search.'+chr(13)+'Nebyly nalezeny zadne zaznamy.')
      else
        begin
          // jinak si najdeme radku na ktere je odkaz na nalezeny film
          LineNr := FindLine('<a href="film.', Page, 0);
          // pokud takovou radku najdeme
          if (LineNr > -1) then
          begin
            // vycisti strom okna se seznamem filmu
            PickTreeClear;
            // prida vetev se seznamem nalezenych filmu
            PickTreeAdd('Filmy: ' + MovieName, '');
            // 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 dany film
              BeginPos := Pos('<a href="film', Line);
              if (BeginPos > 0) then
                begin
                  EndPos := Pos('" >', Line);

                  if (EndPos = 0) then
                    EndPos := Length(Line);

                  // vykopiruje si adresu aktualniho filmu z tagu odkazu
                  FilmAddr := Copy(Line, BeginPos + 9, EndPos - BeginPos - 9);
                  // 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);

                  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 + '&text=1');
                    Delete(Line,1,EndPos+3);
                  end;
            until BeginPos < 1;
            
            // zobrazi okno se stromem nalezenych filmu a pokud uzivatel kliknul
            // na OK -> rozparseruje se adresa s detailem filmu ktery byl vybran
            if PickTreeExec(Address) then
              AnalyzeMoviePage(Address);
            end;
        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;
  Page.Text := GetPage(Address);
  // hleda radek na kterem se nachazi zacatek informaci o filmu
  LineNr := FindLine('<span class="style4"', 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);
      // vykopiruje si obsah radku bez prnich 4 znaku
      Value := Copy(Trim(Line), 4, Length(Trim(Line)) - 3);

      // nazev
      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 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 bunky tabulky
            EndPos := Pos('</td>', Line);

            // pokud neni nastavena pozice posledniho znaku - nastavi se
            if (EndPos = 0) then
              EndPos := Length(Line);

            // vykopirovani nazvu
            if ((MidPos < BeginPos) and (MidPos > 0)) then
              Value := Value + '; ' + Copy(Line, 1, EndPos - 1)
            else
              Value2 := Value2 + Copy(Line, 1, EndPos - 1) + '; ';
          end;
      until BeginPos < 1;

      SetField(fieldTranslatedTitle, Value);
      if (Value2 = '') then
        Value2 := Value
      else
        Value2 := Copy(Value2, 1, length(Value2) - 2);

      SetField(fieldOriginalTitle, Value2);

      //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));
          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));
            SetField(fieldCategory, Value);
          end;

      Value := GetDirector(Line);
      SetField(fieldDirector, Value);
      Value := GetActor(Line);
      SetField(fieldActors, Value);
    end;

    // picture
    LineNr := FindLine('src="posters/', Page, 0);
    if (LineNr > -1) then
      begin
        Line := Page.GetString(LineNr);
        BeginPos := pos('<img src="posters', Line) + 10;

        if (BeginPos > 10) then
          begin
            EndPos := pos('" border="', Line);
            Value := copy(Line, BeginPos, EndPos - BeginPos);
            Value := BaseAddress + Value;
            GetPicture(Value);
          end;
      end;

    // Info
    LineNr := FindLine('<B>Obsah/Info:</B>', Page, 0);
    if (LineNr > -1) then
      begin
        Value := Page.GetString(LineNr+2);
        HTMLDecode(Value);
        HTMLRemoveTags(Value);
        SetField(fieldDescription, Trim(Value));
      end;

   // 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.php?search=jmeno_filmu
          AnalyzePage(BaseAddress + 'search.php?search=' + UrlEncode(MovieName));
        end;
    end
  else
    ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.0)');
end.

Post by **antp** » 2005-09-06 08:45:53

Thanks

In some cases the title seems to be cut, e.g. if you search spider, and select "Spider-Man" (2003)" (one of those with quotes) or Spider-Man 2 (2004)

WaVe_99 · Post by **WaVe_99** » 2005-09-06 13:12:31

Zatim diky moc za upravu :-)

MI'RA · Post by **MI'RA** » 2005-09-06 19:02:44

antp wrote:In some cases the title seems to be cut, e.g. if you search spider, and select "Spider-Man" (2003)" (one of those with quotes) or Spider-Man 2 (2004)

I don't exactly understand what you mean.

This script is ONLY hotfix of latest script version. Now I'm working on the full and functional script whitch will be "OK". But I don't have much time.

After I finish final script - I'll post it here. If you want any comment to this script in EN language - tell me and I'll add some comment in EN :-).

MI'RA · Post by **MI'RA** » 2005-09-06 19:04:09

WaVe_99 wrote:Zatim diky moc za upravu :-)

Takze ti to bezi? Pripadne chyby klido nahlaste (bud me, nebo puvodnimu autorovi). Klidne to nejak opravim, pac programovat v packalu neni nic tezkeho (aspon ne, pokud se programuje takova kravinka jako je tenhle script ;-))

Post by **antp** » 2005-09-06 19:27:55

MI'RA wrote: This script is ONLY hotfix of latest script version.

I did not know that

Since I only understand French & Engish I didn't know what you wrote above the script, I supposed that you rewrote it or tested it more

MI'RA · Post by **MI'RA** » 2005-09-06 20:14:35

antp wrote:I did not know that

yes, I know :-) - and so I've wrote this infos in EN :-)

antp wrote:Since I only understand French & Engish I didn't know what you wrote above the script

French? My brother speaks french (he was working for Sagem - French corporation - made cell phone I think :-))), but I don't speak. BUT Jean Reno is really gooood actor

.

antp wrote:I supposed that you rewrote it or tested it more

In future I'll rewrote this script. But time is no more :-). I'll try to finish it. I promise

MI'RA · Post by **MI'RA** » 2005-09-07 03:39:37

A small bug raised. In the translated movie name script cut first 3 chars. Correction is: line nr. 258 replace with this:

Code: Select all

Value := Copy(Trim(Line), 1, Length(Trim(Line)));

Pri vraceni prelozeneho nazvu script vracel oriznuty nazev o 3 znaky. Opravou je prepsat radek cislo 258 vyse zminenym.

kecinzer · Post by **kecinzer** » 2005-09-07 14:00:28

Pokud by mel nekdo zajem, tak jsem pridal stahovani hodnoceni

Staci nad radek // picture pridat nasledujici radky

Code: Select all

// hodnoceni by kecinzer
    LineNr := FindLine('<td class="style5" >', Page, 0);
    Line := Page.GetString(LineNr);
    BeginPos := pos('<td class="style5" >', Line)+20;
    EndPos := Length(Line)-7-BeginPos+1;
    Value := copy(Line, BeginPos, EndPos);
    if (Length(Value) > 1) then
    begin
      Value2 := copy(Value, 1, 1) + ',' + copy(Value, 2, 1);
    end else
    begin
      Value2 := '0,' + Value;
    end;
    SetField(fieldRating, Value2);

WaVe_99 · Post by **WaVe_99** » 2005-09-07 20:07:56

2Mira - no, co jsem tak zatim vypozoroval - tak to spatne prohledava v nazvech, originalni me nachazi, prelozeny do CZ ne, pak to spatne importuje prelozeny nazev - tam chybi prvni pismena... Jinak me to polozky snad doplnuje spravne. Kazdopadne, to csfd.cz je ted neuveritelne pomaly, strasny :-)
PS: Ted jsem si teprve vsiml, ze jsi tu chybu z chybejicima pismena uz stacil opravit :-)

MI'RA · Post by **MI'RA** » 2005-09-07 20:14:01

kecinzer wrote:Pokud by mel nekdo zajem, tak jsem pridal stahovani hodnoceni
Staci nad radek // picture pridat nasledujici radky

A ja jsem zase pridal option pro vyber zda chce uzivatel stahovat prelozene nazvy ve formatu: cesky nazev; slovensky nazev. Nebo jen ciste cesky nazev. Pro prehlednost diskuze jsem script umistil sem.

MI'RA · Post by **MI'RA** » 2005-09-07 20:16:29

WaVe_99 wrote:PS: Ted jsem si teprve vsiml, ze jsi tu chybu z chybejicima pismena uz stacil opravit :-)

Ja sem rychlik :-). No je pravda, ze tam je spousta veci co nechodi uplne OK. Nicmene CSFD je v takovem stavu, ze ted nema moc vyznam delat nejake finalni verze ... Ale pokud to bude easy, tak chyby klidne opravim.

kecinzer · Post by **kecinzer** » 2005-09-07 20:42:42

Taky doufam, ze CSFD dojde nejake finalni podoby. Nejhorsi jsou ty vypadky a pretizeni serveru.

MI'RA · Post by **MI'RA** » 2005-09-08 04:23:19

Takze jsem opravil to hledani v ceskych nazvech - ted uz si muzete vybrat v jakych nazvech budete hledat. Pridal jsem to stahnuti hodnoceni (thx2 kecinzer). Plus jsem opravil jeste nejaky drobnicky (to ale na script nema vliv).

nevahejte a STAHUJTE.

MI'RA · Post by **MI'RA** » 2005-09-08 12:40:51

Oprava chyby kdy se do originaniho nazvu daval nazev prelozeny.

Pridal jsem moznost hodnoceni vypnout/zapnout.

STAHUJTE.

kecinzer · Post by **kecinzer** » 2005-09-08 13:44:08

MI'RA wrote:Oprava chyby kdy se do originaniho nazvu daval nazev prelozeny.

Pridal jsem moznost hodnoceni vypnout/zapnout.

STAHUJTE.

Perfektní, hned to jdu otestovat

MI'RA · Post by **MI'RA** » 2005-09-12 07:54:21

Dalsi verze :-). Zde je mozne pred jiz existujici prelozeny nazev a popis pridat jeste popis z CFD.

STAHUJTE.

Commanche · Post by **Commanche** » 2005-09-13 06:47:13

porad mam v puvodnim nazvu nazev prelozeny

MI'RA · Post by **MI'RA** » 2005-09-17 04:48:09

Commanche wrote:porad mam v puvodnim nazvu nazev prelozeny

to je divny. Mohl by si mi dat nazev filmu u jakeho ti to dela? A mas opravdu posledni verzi scriptu?

antp.be forum

[Cz] CSFD.CZ - Working script

[Cz] CSFD.CZ - Working script

THX - diky moc

Re: THX - diky moc

2Mira

Re: 2Mira