)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.