(*************************************************** Ant Movie Catalog importation script www.antp.be/software/moviecatalog/ [Infos] Authors=Dedej Title=Cinemapassion.com Description=infos de Cinemapassion - mode normal/batch: voir l'onglet Commentaires Site=http://www.cinemapassion.com/ Language=FR Version=1.2 du 28/02/2010 Requires=3.5.0 Comments=mode batch: 2 modes possibles: d'après l'url mémorisée (Cinemapassion) ou d'après le nom du film + réalisateur (résultats non garantis!)|N'oubliez pas de sauvegarder votre base actuelle avant de lancer le mode batch|Conseils: sélectionnez un nombre raisonnable de films et triez la liste des films par numéros|à la fin de chaque mise à jour, un fichier log est créé (informations et erreurs - attention ce fichier est recréé à chaque lancement du mode batch) 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] Mise à jour du Script=1|1|0=Pas de mise à jour|1=Mise à jour du script Mode=0|0|0=mode normal|1=mode batch (url)|2=mode batch (nom) Affiche=2|1|0=aucune affiche|1=affiche grand format|2=cover DVD FormatTitre=0|0|0=laisser les titres des films tels quels|1=tout en minuscules|2=tout en majuscules|3=1ère lettre en majuscule le reste en minuscules|4=toutes les 1ères lettres en majuscules ***************************************************) // nécessite les modules suivants // BatchCommon7552.pas (qui inclut StringUtils1.pas et StringUtils7552.pas) program cinemapassion; uses BatchCommon7552; const debug = False; // mode debug on/off debugrep = 'c:\temp\'; // répertoire de stockage des fichiers // Url = 'http://www.cinemapassion.com/'; id_Cinemapassion = 'Cinemapassion'; // ident VersionScript = '1.2 du 28/02/2010'; ScriptName = 'Cinemapassion.com (FR).ifs'; SiteUrl = 'http://joel.desseaux.free.fr/Cinemapassion.com/'; var // note FormatUTF8 est déclaré dans StringUtils7552 (integer) movieok, pageko: Boolean; MovieName, firstcall, entete, onglets, infos, PremiereLettre: String; pgacteurs, idacteurs, pgavis, idavis, pgphotos, idphotos: String; ImportPicture: integer; //------------------------------------------------------------------------------ // recherche du film (cinéfil) // MovieName = nom du film cherché (tel que saisi, cad non formaté) //------------------------------------------------------------------------------ procedure AnalysePage; var Address, Page, Line, Value, realisateur, PageFilm, urlfilm: string; pagenum, filmnum, i, Temp: integer; memo: TStringList; found: Boolean; begin pagenum := 0; // compteur de pages batchList := TStringList.Create; // init liste de mémo // init adresse 1ere recherche Address := Url+'les-films-'; PremiereLettre:= left(MovieName,1); repeat found := False; PickTreeClear; // init list PickTreeAdd('Films (Cinemapassion)', ''); if PageCover then Begin Page := PostPage(Url+'moteur.php','&recherche='+(FormatMovieName3(MovieName))+'&categorie='+'covers'+'&recherchecomplete='+'Envoyez'); end else begin Page := GetPage(Address + PremiereLettre + '.html'); end; if debug then DumpPage(debugrep+id_Cinemapassion+' choix'+IntToStr(pagenum)+'.txt', Page); // debug // vérif page OK // pas de film 'Aucun résultat pour la recherche' // sinon 'xxx résultats pour la recherche' FormatUtf8 := 0; if (Pos('

', Page) = 0) and (Pos('resultat(s) dans les covers', Page) = 0) then begin LogMessage(id_Cinemapassion+': erreur lecture page de recherche '+IntToStr(pagenum)); // non trouvé = erreur batchList.Free; exit; end; if PageCover then begin if Pos('n''a donné aucun résultat.', Page) <> 0 then begin LogMessage(id_Cinemapassion+': aucun cover trouvé pour "'+MovieName+'"'); Lien := Url; batchList.Free; Value := TextBetween(infos, ' 0) then GetPicture(Value); exit; end; Page := TextBetween(Page, '

'); // infos utiles pour cover DVD end; if Not PageCover then Page := TextBetween(Page, 'résultat(s)', '


'); // infos utiles if Page <> '' then begin // mémo des films de cette page Page := StringReplace(Page, '
', crlf); // separe lignes urlfilm := 'href='''; memo := TStringList.Create; memo.Text := Page; for filmnum := 0 to memo.Count-1 do begin Line := memo.GetString(filmnum); if PageCover then begin PageFilm := TextBetween(Line, 'href="/', '" target='); Value := TextBetween(Line, 'target=''_blank''>', ''); // titre cover end else begin PageFilm := GetUrl(Line, urlfilm, Url); // extraire le nom Value := TextBetween(Line, 'title=''''>', ''); // titre end; if PageFilm = '' then continue; // pas d'url = autre chose ou ligne vide Line := Value; if BatchMode = 0 then if Pos(FormatMovieName3(MovieName), FormatMovieName3(Value)) <> 0 then begin PickTreeAdd(Line, PageFilm) found := True; end else else begin // valorisation batchList : url + film + réalisateur batchList.Add(PageFilm+sepchar1+Value+sepchar1+realisateur+sepchar1); end; end; {for filmnum} memo.Free; if (not found) and (Importpicture <> 2) then begin LogMessage(id_Cinemapassion+': aucun film trouvé pour "'+MovieName+'"'); batchList.Free; exit; end; if BatchMode > 0 then begin // *** mode batch : recherche du meilleur poids pour les films trouvés // 2 possibilités: // 1) on reste avec cette liste // 2) on continue à valoriser batchList // pour l'instant, on travaille sur cette page uniquement LookBest; if bestWeight > 0 then // on a trouvé quelque chose AnalysePageFilm(bestAddr); // page film break; // on sort end else begin // *** mode normal if (not found) and (Importpicture = 2) then begin LogMessage(id_Cinemapassion+': aucun film trouvé pour "'+MovieName+'"' + ' choisir "OK" pour chercher les covers'); Lien := Url + Address ; GetCoverDVD ; exit; end; if found then if PickTreeExec(Address) then begin if not PageCover then AnalysePageFilm(Address); // page film Lien := Url + Address ; break; // on sort end else LogMessage(id_Cinemapassion+': aucun film sélectionné'); if (Importpicture = 2) and (not PageCover) then GetCoverDVD; exit; end; end; until (Address = ''); if not PageCover then batchList.Free; end; //------------------------------------------------------------------------------ // analyse de la page du film //------------------------------------------------------------------------------ procedure AnalysePageFilm(Address: string); var Table, Value, Value2, str, Page, Lien: string; i, j, FormatTitre: Integer; notep: Real; memo: TStringList; begin FormatTitre := GetOption('FormatTitre'); Page := Getpage(Address); Begin if debug then DumpPage(debugrep+id_Cinemapassion , Page); // debug // infos spécifiques de la page courante infos := TextBefore(Page, '
', ''); // test si l'onglet actif est bien celui qu'on cherche if Pos(FormatMovieName3(MovieName), FormatMovieName3(TextBetween(Page, ' ', ''))) = 0 then begin LogMessage(id_Cinemapassion+': erreur lecture page '+ MovieName); // pas la bonne exit; end; pageko := False; // page ok end; if pageko then exit; movieok := True; // ça y est, c'est bon SetField(fieldURL, Address); // titre original ou traduit Value := TextBetween(infos, 'Titre : ', '
'); Value := TranslateText(FormatLine(Value), FormatTitre); Value2 := TextBetween(infos, 'Titre Original : ', '
'); Value2 := TranslateText(FormatLine(Value2), FormatTitre); if (Value2 = '') or (Value = Value2) then // 1er titre = original begin SetField(fieldOriginalTitle, Value); SetField(fieldTranslatedTitle, Value); end else begin // traduit + original SetField(fieldOriginalTitle, Value2); SetField(fieldTranslatedTitle, Value); end; // note notep := -1; Value := TextBetween(infos, 'note moyenne : ', ' / 5'); if Value <> '' then notep := StrToFloat(Value) * 2; // note sur 10 SetField(fieldRating, FloatToStr(notep)); // extraire les lignes: // 0 vide // 1(titre original) pays - année - durée - // 4 date de sortie // 5 Un film de: XXX Avec : XXX // 6 Distribué par : // 7 site officiel // 8 // réalisateur(s) Value := FormatText3(TextBetween(infos, 'Réalisateur : ', '
')); SetField(fieldDirector, FormatLine(Value)); // acteurs Value := FormatText3(TextBetween(infos, 'Avec : ', '
')); Value := StringReplace(Value, '...', ''); // supprime les points de suspension Value := Left(Value, Length(Value) -4); SetField(fieldActors, Value); // distributeur Value := FormatText3(TextBetween(infos, 'Distributeur : ', '
')); Value := FormatLine(Value); SetField(fieldProducer, Value); // Budget Value := FormatText3(TextBetween(infos, 'Budget : ', '
')); if Value <> '' then SetField(fieldComments, 'Budget: ' + Value); if Value = '' then SetField(fieldComments, Value); // (titre original) pays - année - durée - Value := FormatText3(TextBetween(infos, 'Pays : ', '
')); // pays SetField(fieldCountry, FormatLine(Value)); Value := FormatText3(TextBetween(infos, 'Année : ', '
')); // année SetField(fieldYear, FormatLine(Value)); Value := FormatText3(TextBetween(infos, 'Durée : ', ' min
')); // durée heuresHminutes SetField(fieldLength, Value); // description Table := TextBetween(infos, 'Résumé :
', '

'); SetField(fieldDescription, FormatText3(Table)); // Infos Cinémapassion Table := Textbetween(infos, '
Scénario :', '


'); if Table <> '' then begin if GetField(fieldComments) <> '' then Table := GetField(fieldComments) + #13#10 + 'Scénario : ' + FormatText3(Table) else Table := 'Scénario : ' + FormatText3(Table); SetField(fieldComments, Table); end; // test s'il y a une affiche Value := TextBetween(infos, ''); // test s'il y a une affiche Value := TextBetween(Page, '', crlf); str := StringReplace(str, #13#10, ''); str := StringReplace(str, '
', #13#10); str := StringReplace(str, '
', #13#10); str := StringReplace(str, '
', crlf); str := StringReplace(str, ' ', ' '); str := StringReplace(str, '''', ' '); // formattage 'classique' result := str; end; //------------------------------------------------------------------------------ // formatage du nom du film //------------------------------------------------------------------------------ function FormatMovieName3(str: string) :string; begin // une petite édition avant de formater str := StringReplace(str, ' & ', ' et '); // remplacer les apostrophes, tirets et points par des blancs str := StringReplace(str, '''', ' '); str := StringReplace(str, '.', ' '); str := StringReplace(str, '-', ' '); result := FormatMovieName(str); end; //------------------------------------------------------------------------------ // CONVERTI LES CHIFFRES ROMAINS EN NOMBRE ET INVERSEMENT //------------------------------------------------------------------------------ function conversionNR(NomFilm, Sens : String) : string; // Sens = RvN ou NvR var nombresR, nombresN : array of string; i: integer; begin NomFilm := AnsiLowerCase(NomFilm); NomFilm := NomFilm+' '; SetArrayLength(nombresR,5); nombresR[0]:=' i '; nombresR[1]:=' ii '; nombresR[2]:=' iii '; nombresR[3]:=' iv '; nombresR[4]:=' v '; SetArrayLength(nombresN,5); nombresN[0]:=' 1 '; nombresN[1]:=' 2 '; nombresN[2]:=' 3 '; nombresN[3]:=' 4 '; nombresN[4]:=' 5 '; if (Sens = 'RvN') then begin for i := 0 to GetArrayLength(nombresR)-1 do begin if Pos(nombresR[i], NomFilm) <> 0 then begin NomFilm := StringReplace(NomFilm, nombresR[i], nombresN[i]); Break; end; end; end else if (Sens = 'NvR') then begin for i := 0 to GetArrayLength(nombresN)-1 do begin if Pos(nombresN[i], NomFilm) <> 0 then begin NomFilm := StringReplace(NomFilm, nombresN[i], nombresR[i]); Break; end; end; end; NomFilm := Trim(NomFilm); result := NomFilm; end; //------------------------------------------------------------------------------ // traitement mode batch //------------------------------------------------------------------------------ procedure Batch; begin SetField(fieldChecked, ''); // init film en traitement initBatchLook; // test et init if batchLookOK then begin; case BatchMode of 1: AnalysePageFilm(GetField(fieldUrl)); // recherche par url 2: begin; MovieName := GetMovieName; AnalysePage; // recherche par nom end; end; {case} if movieok then SetField(fieldChecked, 'x'); // film ok end; // on attend un peu pour ne pas stresser le site et pouvoir arrêter le script Sleep(500); end; //------------------------------------------------------------------------------ // traitement mode normal //------------------------------------------------------------------------------ procedure Norm; begin MovieName := GetMovieName; MovieName := conversionNR(MovieName, 'RvN'); MovieName := AnsiUpFirstLetter(MovieName); repeat if not Input('Cinemapassion.com Import', 'Entrez le titre du film', MovieName) or (MovieName = '') then exit; AnalysePage; until movieok; end; //------------------------------------------------------------------------------ // Vérifie s'il existe une nouvelle version du script // et propose de la télécharger //------------------------------------------------------------------------------ procedure CheckScriptVersion(); var Page, Script: TStringList; Line, ScriptsDirectory, FileName, ScriptText, Fich: string; LineNr, BeginPos, EndPos: Integer; CurrentVersion, NewVersion: real; begin Page := TStringList.Create; FileName := UrlEncode(ScriptName); FileName := StringReplace(FileName, '%2E', '.'); FileName := StringReplace(FileName, '+', '%20'); Page.Text := GetPage(SiteUrl + FileName); ScriptsDirectory := GetStatic('path'); //SetStatic('path', ScriptsDirectory); LineNr := FindLine('Version=', Page, 0); if LineNr > -1 then begin Line := Page.GetString(LineNr); BeginPos := pos('Version=', Line) + 8; EndPos := pos(' du', Line); CurrentVersion := StrToFloat(copy(VersionScript, 1, pos('du', VersionScript) - 2)); NewVersion := StrToFloat(copy(Line, BeginPos, EndPos - BeginPos)); if (NewVersion > CurrentVersion) then begin if ShowConfirmation('Une nouvelle version du script est disponible : ' + copy(Line, BeginPos, EndPos - BeginPos)+ #13#10#13#10 + '- Cliquez sur ''''Oui'''' pour effectuer la mise à jour.' + #13#10#13#10 + '- Cliquez sur ''''Non'''' dans le cas contraire.') = True then begin FileName := ScriptName; Sleep(500); ScriptText := GetPage(SiteUrl + FileName); Script := TStringList.Create; Script.Add(ScriptText); FileName := StringReplace(FileName, '%20', ' '); Script.SaveToFile(ScriptsDirectory + FileName); ShowInformation('Vous avez mis à jour le script, quitter la fenêtre de scripts et relancez la.'); Script.Free; end; end else end; end; //------------------------------------------------------------------------------ // c'est ici que ça commence //------------------------------------------------------------------------------ var PageCover: Boolean; Lien : string; begin if (GetOption('Mise à jour du Script') = 1) then CheckScriptVersion(); PageCover := False; Lien := ''; if batchAbort <> '' then exit; // mode batch non confirmé if firstcall <> 'done' then begin // 1er appel: init paramètres firstcall := 'done'; if not CheckVersion(3,5,0) then begin ShowMessage('Ce script requiert une version plus récente de Ant Movie Catalog (au moins la version 3.5.0)'); batchAbort := 'y'; exit; end; batchCaller := id_Cinemapassion; // identifiants Cinefil batchUrl := Url; batchField2 := fieldDirector; // récupère les variables user (utilisées plus d'une fois) BatchMode := GetOption('Mode'); ImportPicture := GetOption('Affiche'); if not CanSetPicture then ImportPicture := 0; // champ image non modifiable: inutile de lire // if BatchMode > 0 then // mode batch: confirmer le choix begin initBatchLog('FR'); // init log if batchAbort <> '' then exit; end; end; // c'est parti movieok := False; if BatchMode = 0 then Norm else Batch; end.