antp.be forum

Code: Select all

// GETINFO SCRIPTING
// Cinefil (FR) import avec grande Image

(***************************************************
 *  Script d'importation de film pour :            *
 *  Cinéfil.com , http://www.cinefil.com           *
 *                                                 *
 * correction suite à changement du site (v2)      *
 *  (c) 2004 scorpion7552                          *
 * script original par                             *   
 *  (c) 2003 Danone-KiD                            *
 *                                                 *
 *  A utiliser avec Ant Movie Catalog 3.4.2        *
 *  www.antp.be/software/moviecatalog              *
 *                                                 *
 *  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.                     *
 ***************************************************)

program cinefil;
const
  CinefilBase = 'http://www.cinefil.com';
  CinefilUrl  = CinefilBase + '/cinefil2005/';
  crlf = #13#10;             
  ExternalPictures = False;
  {  True: Les images seront stockées en tant que fichiers dans le même dossier que le catalogue
     False: Les images seront stockées dans le catalogue (seulement pour les fichiers .amc)  }  

var
  MovieName, Line: string;
  BeginPos, EndPos: Integer;
  filmok: Boolean; 

//------------------------------------------------------------------------------
// RECHERCHE DU FILM (cinéfil)
//------------------------------------------------------------------------------
procedure AnalyzePageCinefil(Address: string);
var
  Page: TStringList;
  Value,Value2,page_film,titre_film, annee_film,PagePrev,PageNext: string;

begin
  filmok := False;
  PageNext := '';
  PagePrev := '';
  PickTreeClear;                                       //vide la liste des films
  PickTreeAdd('Films (Cinéfil)', '');
  Line := GetPage(Address);
// SavePage('d:\Temp\choixCinefil.txt', Line);    // debug
  Value := ExtrStr(Line, '<B> Résultat ', '</B>');
  if Value = '' then
  begin
    ShowMessage('Cinéfil: erreur lecture page');          // non trouvé = erreur
    exit;
  end;
  if Copy(Value, 1, 1) = '0' then                              // 0 = aucun film
  begin
    ShowMessage('Cinéfil: aucun film trouvé pour "' + MovieName + '"');   
    exit;  
  end;  
  
// recherche pages précédente et suivante
  Line := ExtrStr(Line, 'Résultat', '');
  Value := ExtrStr(Line, '', '</TD>');              // Value = les url des pages
  if Pos('HREF', UpperCase(Value)) = 0 then
    Value := '';                                     // 1 seule page  
  while Value <> '' do
  begin    
  Value2 := ExtrStr(Value, '', '/a>');               // Value2 = url page xxx
  Delete(Value, 1, Pos('</a>', Value)+4);            // Value = les suivantes
// ignorer les "retours rapides" (<< et >>) pour ne pas confondre avec < et >  
  if Pos('><<<', Value2) > 0 then
    continue;  
  if Pos('>>><', Value2) > 0 then
    continue;  
  if Pos('><<', Value2) > 0 then           
  begin                                          // Value2 = url page précédente
    PagePrev := GetUrl('', Value2, CinefilBase);
    PickTreeAdd('<<< page précédente', PagePrev);
  end; 
  if Pos('>><', Value2) > 0 then
    PageNext := GetUrl('', Value2, CinefilBase);   // Value2 = url page suivante  
  end;                                             // end do while value <> ''
// mémo des films de cette page
  Value := '<font class=noir>';                           // séparateur de films
  repeat
// cherche le lien de la page du film
  BeginPos := Pos(Value, Line);                              // description film
  if BeginPos > 0 then                                          // 1 film trouvé
  begin 
    Delete(Line, 1, BeginPos-1);
// url de la page
    page_film := GetUrl('HREF=''../fichefilm.cfm?ref=', Line, CinefilUrl);
// année
    annee_film := FormatTitre(ExtrStr(Line, Value, ' '));
// nom du film et réalisateur
   BeginPos := Pos('TITLE="', UpperCase(Line));
   Delete(Line, 1, BeginPos);
   titre_film := ExtrStr(Line, '">', '</TD>'); 
   titre_film := StringReplace(titre_film, '</a>', ',');   // titre, réalisateur
   titre_film := FormatTitre(titre_film);
// ajoute le film
    PickTreeAdd(titre_film + ' ' + annee_film , page_film);
  end;
  until BeginPos = 0;
  if PageNext <> '' then 
    PickTreeAdd('>>> page suivante', PageNext);      
  if PickTreeExec(Address) then
  begin
    if (Address = PageNext) or (Address = PagePrev) then
      AnalyzePageCinefil(Address)                    // page suivante/précédente
    else  
    begin     
      SetField(fieldURL, Address);
      AnalyzePageFilmCinefil(Address);                            // page film
    end;
  end else
    ShowMessage('Cinéfil: aucune page sélectionnée');
end;

//------------------------------------------------------------------------------
// ANALYSE DE LA PAGE DU FILM (Cinéfil)
//------------------------------------------------------------------------------
procedure AnalyzePageFilmCinefil(Address: string);
var
  Value,Value2,Value3,img: string;
 
begin
  filmok := True;
  Line := GetPage(Address);
  Line := ExtrStr(Line, 'Référence film cinefil', '');          // vire le début
// SavePage('d:\Temp\filmCinefil.txt', Line);    // debug
// affiche: test s'il y a un grand format
  img := ExtrStr(Line, 'javascript:ZoomPhoto(''', '''');
  if img = '' then                        // sinon test s'il y a un petit format
    img := ExtrStr(Line, '<IMG class=photo SRC=''', '''');     
  if img <> '' then  
    GetPicture(img, ExternalPictures);
// pays année et durée
  Value := ExtrStr(Line, '<font class="smallnoir">', '<BR>');
  Value := StringReplace(Value, '- ', '|');      // sépare les champs par |
  HTMLRemoveTags(Value);
  HTMLDecode(Value);
  BeginPos := Pos('|', Value);                       
  Value2 := Copy(Value, 1, BeginPos-1);            // pays (plusieurs possibles)
  Delete(Value, 1, BeginPos);
  if Value2 <> '' then 
    SetField(fieldCountry, FormatTitre(Value2));
  BeginPos := Pos('|', Value);
  Value2 := Copy(Value, 1, BeginPos-1);                                 // année
  Delete(Value, 1, BeginPos);
  if Value2 <> '' then 
    SetField(fieldYear, FormatTitre(Value2));
  BeginPos := Pos('|', Value);
  Value2 := FormatTitre(Copy(Value, 1, BeginPos-1));                    // durée
  BeginPos := Pos('H', UpperCase(Value2));
  Value2 := IntToStr(StrToInt(Copy(Value2, 1, BeginPos-1), 0) * 60 + StrToInt(Copy(Value2, BeginPos+1, 2), 0));
  if Value2 <> '' then 
    SetField(fieldLength, FormatTitre(Value2));
// titre original ou traduit
  Value3 := '<font class="noir"><font class="rouge16"><B>';
  BeginPos := Pos(Value3, Line) + Length(Value3);
  Value := ExtrStr(Line, Value3, '</B>');
// titre original éventuel
  Value3 := '<BR>Titre original :<font class="smallrouge"> <B>';
  Value2 := ExtrStr(Line, Value3, '</B>');
  if Value2 = '' then                                    // 1er titre = original
  begin
    SetField(fieldOriginalTitle, FormatTitre(Value));
    SetField(fieldTranslatedTitle, '');   
  end else
  begin                                                  // traduit + original
    BeginPos := Pos(Value3, Line) + Length(Value3); 
    SetField(fieldOriginalTitle, FormatTitre(Value2)); 
    SetField(fieldTranslatedTitle, FormatTitre(Value));  
  end;  
  Delete(Line, 1, BeginPos-1); 
  EndPos := Pos('</B>', Line);
  Delete(Line, 1, EndPos + 4);
// catégorie
  Value := ExtrStr(Line, '<BR>', crlf);
  Value := Trim(Value);
  BeginPos := Pos(' ', Value);                // virer l'article ('un' ou 'une')
  if Pos('UN', UpperCase(Copy(Value, 1, BeginPos))) > 0 then
    Delete(Value, 1, BeginPos); 
  if Value <> '' then
    SetField(fieldCategory, FormatTitre(Value));
// réalisateur
  Value := ExtrStr(Line, '<B>', '</B>'); 
  if Value <> '' then
    SetField(fieldDirector, FormatTitre(Value));
// acteurs
  BeginPos := Pos('AVEC', UpperCase(Line));
  Delete(Line, 1, BeginPos);
  Value := ExtrStr(Line, '<B>', crlf);
  if Value <> '' then
    SetField(fieldActors, FormatTitre(Value));    
// description
  Value := ExtrStr(Line, '<font class=smallnoir><BR><font class=noir>', '<BR>');
  if Value <> '' then
    SetField(fieldDescription, FormatText(Value));
{ on s'en fout, non?      
  if img = '' then                       
    ShowMessage('Cinéfil: pas d''affiche prévue pour "' + MovieName + '"');
}    
end;

//------------------------------------------------------------------------------
// formatage d'un texte pour affichage
// suppression des tags html, remplacement des caractères bizarres
//------------------------------------------------------------------------------
function FormatText(str1: string) :string;
var
  s: string;
  
begin
  str1 := StringReplace(str1, '<p>', '|');  // remplace temporairement <P> par |
  HTMLRemoveTags(str1);                     // supprime les tags HTML
  HTMLDecode(str1);                         // et les caractères spéciaux
// supprimer les caractères de formatage en début de chaine (code ASCII <= x'20')
  repeat
  s := Copy(str1, 1, 1);                                // 1er caractère de str1
  if s <= #32 then
    Delete(str1, 1, 1);                                 // on le vire
  until s > #32;
// remet paragraphe = crlf
  str1 := StringReplace(str1, '|', crlf); 
// caractères qui s'affichent mal
  str1 := StringReplace(str1, 'œ', 'oe');       
  str1 := StringReplace(str1, #150, '-');      // le vrai tiret
  str1 := StringReplace(str1, #133, '...');    // les vrais points de suspension 
  str1 := StringReplace(str1, #147, '"');      // citation ouvrante = "" ou #171
  str1 := StringReplace(str1, #148, '"');      // citation fermante = "" ou #187
  result := Trim(str1);
end;

//------------------------------------------------------------------------------
// formatage d'un titre (sur 1 seule ligne)
//------------------------------------------------------------------------------
function FormatTitre(str1: string) :string;
begin
  HTMLDecode(str1);
  HTMLRemoveTags(str1);
  str1 := StringReplace(str1, crlf, '');                    // sur 1 seule ligne 
  result := Trim(str1);
end;

//------------------------------------------------------------------------------
// extraction d'une url contenue dans une chaine de caractères sans édition
// adr := GetUrl(texte_HREF_cherché,chaine,url_de_base)
//------------------------------------------------------------------------------
function GetUrl(strfrom,str1,urlb: string) :string;
var
 i: Integer; 
 delim: String;

begin
  if strfrom <> '' then                        // si from = '' on part du début
  begin
    i := Pos(strfrom, str1);                   // position href cherché
    if i = 0 then                              // rien trouvé
    begin
      result := '';
      exit;
    end;  
    Delete(str1,1, i -1);
  end;  
  i := Pos('HREF=', UpperCase(str1));        // debut url: href=  
  delim := Copy(str1, i+5, 1);               // fin = " ou '
  Delete(str1,1, i +5);
  i := Pos(delim, str1);   
  if i > 0 then 
    Delete(str1,i, Length(str1));
// il y a parfois des trucs en plus après l'url: donc à supprimer      
  i := Pos('&mc=', str1);
  if i > 0 then                           
    Delete(str1, i, Length(str1));
  str1 := StringReplace(str1, '../', '');    // cf adresse relative 
  str1 := StringReplace(str1, './', '');     
  str1 := urlb + str1;                       // ajoute url de base   
  result := Trim(str1);
end;

//------------------------------------------------------------------------------
// extraction de la chaine délimitée par from et to dans str1 
//------------------------------------------------------------------------------
function ExtrStr(str1,strfrom,strto: string) :string;
var
 i: Integer; 

begin
  if strfrom <> '' then                         // si from = '' on part du début
  begin
    i := Pos(strfrom, str1); 
    if i = 0 then                                             // from non trouvé
    begin
      result := '';
      exit;
    end;  
    Delete(str1, 1, i + Length(strfrom) -1);
  end;  
  i := Pos(strto, str1);                                     // fin de la chaine
  Delete(str1, i, Length(str1)); 
  result := Trim(str1);
end;

//------------------------------------------------------------------------------
// écriture d'une chaine sur disque (pour debug...)
// SavePage(chemin_du_fichier,chaine) 
// chemin_du_fichier = chemin complet ex: 'c:\temp\monfichier.txt'
//------------------------------------------------------------------------------
procedure SavePage(fic, str1: string);
var
  Page2: TStringList;
  
begin
  page2 := TStringList.Create;
  page2.Text := str1;
  page2.SaveToFile(fic);
end;

//------------------------------------------------------------------------------
//  c'est ici que ça commence  
//------------------------------------------------------------------------------                                                
begin
  if CheckVersion(3,4,2) then
  begin
// cinéfil préfère les titres en français (peut-être plus vrai,, mais bon...)
    MovieName := GetField(fieldTranslatedTitle);
    if MovieName = '' then 
       MovieName := GetField(fieldOriginalTitle);
    if Input('cinéfil.com Import avec image', 'Entrez le titre du film :', MovieName) then
    begin
      AnalyzePageCinefil(CinefilUrl + 'CFM_Recherches/films.cfm?lachaine2=' + UrlEncode(MovieName));        
      if filmok then
        DisplayResults;
    end;    
  end else
    ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.4.2)');
end.