[ antp.be > Forum ]

[ FAQFAQ - SearchSearch - MemberlistMemberlist - UsergroupsUsergroups - ]

[ RegisterRegister - ProfileProfile - Log in to check your private messagesLog in to check your private messages - Log inLog in ]


[Cz] CSFD.CZ - Working script
Goto page 1, 2, 3, 4, 5, 6, 7, 8, 9, 10  Next
 
Post new topic   Reply to topic    www.antp.be Forum Index -> Ant Movie Catalog > Scripts
Author Message
WaVe_99
PostPosted: 2005-09-01 09:16:38    Post subject: [Cz] CSFD.CZ - Working script Reply with quote
View user's profile Send private message 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
PostPosted: 2005-09-06 07:29:03    Post subject: Reply with quote
View user's profile Send private message 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:
(***************************************************

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.
antp
Site Admin
PostPosted: 2005-09-06 09:45:53    Post subject: Reply with quote
View user's profile Send private message Visit poster's website Thanks wink
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
PostPosted: 2005-09-06 14:12:31    Post subject: THX - diky moc Reply with quote
View user's profile Send private message Zatim diky moc za upravu :-)
MI'RA
PostPosted: 2005-09-06 20:02:44    Post subject: Reply with quote
View user's profile Send private message
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
PostPosted: 2005-09-06 20:04:09    Post subject: Re: THX - diky moc Reply with quote
View user's profile Send private message
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 ;-))
antp
Site Admin
PostPosted: 2005-09-06 20:27:55    Post subject: Reply with quote
View user's profile Send private message Visit poster's website
MI'RA wrote:

This script is ONLY hotfix of latest script version.

I did not know that grin 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 wink
MI'RA
PostPosted: 2005-09-06 21:14:35    Post subject: Reply with quote
View user's profile Send private message
antp wrote:
I did not know that grin

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 grin kind.

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

In future I'll rewrote this script. But time is no more :-). I'll try to finish it. I promise wink
MI'RA
PostPosted: 2005-09-07 04:39:37    Post subject: Reply with quote
View user's profile Send private message A small bug raised. In the translated movie name script cut first 3 chars. Correction is: line nr. 258 replace with this:
Code:
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
PostPosted: 2005-09-07 15:00:28    Post subject: Reply with quote
View user's profile Send private message Pokud by mel nekdo zajem, tak jsem pridal stahovani hodnoceni smile
Staci nad radek // picture pridat nasledujici radky
Code:

// 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
PostPosted: 2005-09-07 21:07:56    Post subject: 2Mira Reply with quote
View user's profile Send private message 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
PostPosted: 2005-09-07 21:14:01    Post subject: Reply with quote
View user's profile Send private message
kecinzer wrote:
Pokud by mel nekdo zajem, tak jsem pridal stahovani hodnoceni smile
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. cool
MI'RA
PostPosted: 2005-09-07 21:16:29    Post subject: Re: 2Mira Reply with quote
View user's profile Send private message
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
PostPosted: 2005-09-07 21:42:42    Post subject: Reply with quote
View user's profile Send private message Taky doufam, ze CSFD dojde nejake finalni podoby. Nejhorsi jsou ty vypadky a pretizeni serveru.
MI'RA
PostPosted: 2005-09-08 05:23:19    Post subject: Reply with quote
View user's profile Send private message 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. cool
MI'RA
PostPosted: 2005-09-08 13:40:51    Post subject: Reply with quote
View user's profile Send private message Oprava chyby kdy se do originaniho nazvu daval nazev prelozeny.

Pridal jsem moznost hodnoceni vypnout/zapnout.

STAHUJTE. cool
kecinzer
PostPosted: 2005-09-08 14:44:08    Post subject: Reply with quote
View user's profile Send private message
MI'RA wrote:
Oprava chyby kdy se do originaniho nazvu daval nazev prelozeny.

Pridal jsem moznost hodnoceni vypnout/zapnout.

STAHUJTE. cool

Perfektní, hned to jdu otestovat smile
MI'RA
PostPosted: 2005-09-12 08:54:21    Post subject: Reply with quote
View user's profile Send private message Dalsi verze :-). Zde je mozne pred jiz existujici prelozeny nazev a popis pridat jeste popis z CFD.

STAHUJTE. cool
Commanche
PostPosted: 2005-09-13 07:47:13    Post subject: Reply with quote
View user's profile Send private message porad mam v puvodnim nazvu nazev prelozeny sad
MI'RA
PostPosted: 2005-09-17 05:48:09    Post subject: Reply with quote
View user's profile Send private message
Commanche wrote:
porad mam v puvodnim nazvu nazev prelozeny sad


to je divny. Mohl by si mi dat nazev filmu u jakeho ti to dela? A mas opravdu posledni verzi scriptu?
Display posts from previous:   
View previous topic :: View next topic  
Post new topic   Reply to topic    www.antp.be Forum Index -> Ant Movie Catalog > Scripts All times are GMT + 1 Hour
Goto page 1, 2, 3, 4, 5, 6, 7, 8, 9, 10  Next
Page 1 of 10

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2006 phpBB Group
Template made by antp