PC Professionell 2005 June/PCpro_2005_06.ISO/files/opensource/amc/amc_install.exe/{app}/Scripts/Amazon (FR).ifs

Text File | 2005-03-12 | 18.7 KB | 598 lines

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

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

[Infos]
Authors=ScorEpioN
Title=Amazon.fr
Description=RΘcupΦre lse informations DVD d'Amazon.fr
Site=http://www.amazon.fr
Language=FR
Version=02 du 07/03/2005
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]
Type de Lancement=0|0|0=Demande le titre avant de lancer le script|1=Ne demande pas le titre avant de lancer le script|2=Cherche le meilleur rΘsultat sans confirmation
Casse Choisie=3|3|0=Titre et Nom en minuscule|1=Titre et Nom en majuscule|2=PremiΦre lettre en majuscule|3=PremiΦre lettre de chaque mot en majuscule
Recherche sur le titre=0|0|0=Traduit|1=Original

***************************************************)

program Amazon_FR;
const
    AmazonUrl = 'http://www.amazon.fr/exec/obidos/ASIN/';
    AmazonSearch = 'http://www.amazon.fr/exec/obidos/search-handle-url/index=dvd-fr&field-keywords=';
var
  MovieName, Address : string;
  i, premiereExecution: Integer;
  listeResultat: TStringList;

//------------------------------------------------------------------------------
// VERIFIER LA VERSION DU SCRIPT
//------------------------------------------------------------------------------

procedure verifVersion();
var
   Line, NewVersion : String;
   BeginPos, EndPos : Integer;
begin
  Line := GetPage('http://forum.antp.be/phpbb2/viewtopic.php?t=1453');
  BeginPos := pos('TELECHARGER LE SCRIPT AMAZON.FR v', Line);
  delete(Line,1, BeginPos+32);
  EndPos := pos('du', Line);
  NewVersion := copy(Line, 1, EndPos - 2);
  if (ShowConfirmation('La derniΦre version est la '+NewVersion+'. Cliquer sur ''''OUI'''' pour la tΘlΘcharger.') = True) then
  begin
    Launch('iexplore.exe','http://www.ifrance.com/ricoland/Amazon%20(FR).ifs');
  end else
    exit;
end;

//------------------------------------------------------------------------------
// MET LE TITRE AU BON FORMAT
//------------------------------------------------------------------------------

function formatTitre(titre : String; option : Integer) : string;
begin
  if (option = 0) then
  begin
     titre := AnsiLowerCase(titre);
  end else if (option = 1) then
  begin
     titre := AnsiUpperCase(titre);
  end else if (option = 2) then
  begin
     titre := AnsiUpFirstLetter(titre);
  end else if (option = 3) then
  begin
     titre := AnsiMixedCase(titre,' -');
  end;
  result := titre;
end;

//------------------------------------------------------------------------------
// TROUVE LA CHAINE VOULUE
//------------------------------------------------------------------------------

function findInfo(Debut, Fin, Line, Option : String) : string;
var
   infos : String;
   BeginPos, EndPos : Integer;
begin
   infos := '';
   BeginPos := pos(Debut, Line);
   if BeginPos > 0 then
   begin
    delete(Line, 1, BeginPos+length(Debut)-1);
    EndPos := pos(Fin, Line);
    infos := copy(Line,0,EndPos-1);
    if option = '-1' then
    begin
      infos := StringReplace(infos, '<BR>', #13#10);
      infos := StringReplace(infos, '<br>', #13#10);
      infos := StringReplace(infos, '–', '-');
    end;
    HTMLRemoveTags(infos);
    HTMLDecode(infos);
    if option = '0' then
      infos := StringReplace(infos, #13#10, '');
   end;
   result := Trim(infos);
end;

//------------------------------------------------------------------------------
// STOCKE LA VALEUR DANS LE CHAMP SP╔CIFI╔ SI LA VALEUR EST NON NULLE
//------------------------------------------------------------------------------

procedure MonSetField(field: Integer; value: string);
begin
if value <> '' then
  SetField(field,value);
end;

//------------------------------------------------------------------------------
// RECUPERE LES RESULTATS AMAZON.FR
//------------------------------------------------------------------------------

procedure imageAmazon(title : String);
var
  adresseRecherche, Line : String;
  StartPos: Integer;
begin
  PickTreeClear;
  adresseRecherche := AmazonSearch+UrlEncode(title);
  Line := GetPage(adresseRecherche);
  if pos('satisfaisante pour votre recherche sur', Line) > 0 then
  begin
    exit;
  end else
  if (pos('Sur ce DVD', Line) > 0) or (pos('Amazon.fr : DVD:', Line) > 0) then
  begin
      recupInfo(Line);
  end else
  if pos('résultats au total pour', Line) > 0 then
  begin
      StartPos := pos('résultats au total pour', Line);
      delete(Line, 1, StartPos);
      recupAmazon(Line, title);
  end;
end;

//------------------------------------------------------------------------------
// CREATION DE LA LISTE DE RESULTAT
//------------------------------------------------------------------------------

procedure recupAmazon(Line, title : String);
var
   StartPos: Integer;
   couple, titre, adresse : String;
begin

  listeResultat := TStringList.Create;

  StartPos := pos('<a href=/exec/obidos/ASIN/', Line);
  repeat
     delete(Line, 1, StartPos+length('<a href=/exec/obidos/ASIN/')-1);
//ajoute les films
     listeResultat.Add(recupTitle(Line)+'|'+AmazonUrl+copy(Line,0,pos('qid', Line)-1));
     StartPos := pos('http://images-eu.amazon.com/images/P/', Line);
     delete(Line, 1, StartPos-1);
     StartPos := pos('<b>', Line);
     delete(Line, 1, StartPos-1);
     StartPos := pos('<a href=/exec/obidos/ASIN/', Line);
  until (StartPos = 0);

  if (GetOption('Type de Lancement') = 0) or (GetOption('Type de Lancement') = 1) then
  begin
   PickTreeAdd('Films trouvΘs pour ' + title + ' :', '');
   for i:=0 to listeResultat.Count-1 do
   begin
     couple := listeResultat.GetString(i);
     titre := copy(couple,0,pos('|',couple)-1);
     adresse := copy(couple,pos('|',couple)+1,length(couple)-1);
     PickTreeAdd(titre , adresse);
   end;

    PickTreeAdd(' ', '');
    PickTreeAdd('Verifier si vous avez la derniΦre version', 'version');
    PickTreeAdd('Pour me contacter', 'contact');

    if listeResultat.Count = 1 then
    begin
     recupInfo(adresse);
     exit;
    end;

    begin
      if PickTreeExec(Address)=true then
      begin
        if (Address = 'version') then
        begin
          verifVersion();
        end else if (Address = 'contact') then
        begin
          Launch('iexplore.exe','http://forum.antp.be/phpbb2/viewtopic.php?t=1453');
        end else
        begin
          recupInfo(Address);
        end;
      end;
    end;
  end else if (GetOption('Type de Lancement') = 2) then
  begin
     trouveTitle(title);
  end;
end;

//------------------------------------------------------------------------------
// RECUPERE LES INFOS
//------------------------------------------------------------------------------

procedure recupInfo(Adresse : String);
var
   Value, Value2, Line: String;
   StartPos: Integer;
begin
   Value := copy(Adresse,0,4);
   if Value = 'http' then
   begin
        Line := GetPage(Adresse);
   end else
   begin
       line := Adresse;
   end;
   StartPos := pos('<b class="sans">', Line);
   delete(Line, 1, StartPos-1);
// Jaquette DVD
   if CanSetPicture then
     GetPicture(recupImage(Line));
// Titre Traduit
   if CanSetField(fieldTranslatedTitle) then
   begin
      Value := formatTitre(findInfo('<b class="sans">', '</b>', Line,'0'),GetOption('Casse Choisie'));
      delete(Value, pos(' - ',Value), length(Value));
      if (pos('(',Value) > 0) then
        delete(Value, pos('(',Value), length(Value));
      MonSetField(fieldTranslatedTitle, Value);
   end;
// Acteurs
   if CanSetField(fieldActors) then
      MonSetField(fieldActors, formatTitre(findInfo('Avec :', '<br>', Line,'0'),GetOption('Casse Choisie')));
// RΘalisateur
   if CanSetField(fieldDirector) then
      MonSetField(fieldDirector, formatTitre(findInfo('Réalisateur :', '<br>', Line,'0'),GetOption('Casse Choisie')));
// Date de parution
   if CanSetField(fieldYear) then
   begin
      Value := findInfo('Date de parution :', '<br>', Line,'0');
      MonSetField(fieldYear, copy(Value,length(Value)-4,length(Value)));
   end;
// Editeur
   if CanSetField(fieldProducer) then
      MonSetField(fieldProducer, findInfo('Éditeur :', '<br>', Line,'0'));
// Line α partir de Zone et Formats son
   StartPos := pos('Zone et formats son :', Line);
   delete(Line, 1, StartPos-1);
// Zone
   if CanSetField(fieldVideoFormat) then
      MonSetField(fieldVideoFormat, 'DVD '+findInfo('Zone :', '<BR>', Line,'0'));
// Langue
   if CanSetField(fieldLanguages) then
      MonSetField(fieldLanguages, findInfo('Langues et formats sonores :', '<BR>', Line,'0'));
// Sous-titre
   if CanSetField(fieldSubtitles) then
      MonSetField(fieldSubtitles, findInfo('Sous-titres :', '<br>', Line,'0'));
// Line α partir de DΘtails de l'Θdition
   StartPos := pos('Détails', Line);
   delete(Line, 1, StartPos-1);
// Titre Original
   if CanSetField(fieldOriginalTitle) then
      MonSetField(fieldOriginalTitle, findInfo('Titre Original :', '<br>', Line,'0'));
// Line α partir de Bonus
   StartPos := pos('Bonus', Line);
   delete(Line, 1, StartPos-1);
// Bonus
   if CanSetField(fieldComments) then
   begin
      Value := findInfo('Bonus :', '• ASIN', Line,'-1');
      if Value <> '' then
        Value := 'Bonus :'+Value;
      MonSetField(fieldComments, Value);
   end;
// Line α partir de Bonus
   StartPos := pos('Chroniques et points de vue', Line);
   delete(Line, 1, StartPos-1);
// Synopsis
   if CanSetField(fieldDescription) then
   begin
      if pos('Liste complète des chroniques et points de vue',Line) <> 0 then
      begin
        StartPos := Pos('href=/exec/obidos/tg/detail',Line);
        delete(Line,1,StartPos+5);
        Value := copy(Line,1,Pos('/ref',Line)-1);
        Line := GetPage('http://www.amazon.fr/'+Value);
      end;
      Value := findInfo('Synopsis</i></b></span><br>', '</span>', Line,'-1');
      if Value <> '' then
        Value := 'Synopsis :'+#13#10+Value+#13#10#13#10;
      Value2 := Value;
      Value := findInfo('Amazon.fr</i></b></span><br>', '</span>', Line,'-1')+findInfo('Amazon.fr </i></b></span><br>', '</span>', Line,'-1');
      if Value <> '' then
        Value := 'Avis Amazon.fr :'+#13#10+Value;
      MonSetField(fieldDescription, Value2+Value);
   end;
// Adresse Web
   if CanSetField(fieldURL) then
      SetField(fieldURL, Adresse);
end;

//------------------------------------------------------------------------------
// RECUPERE L'ADRESSE DE L'IMAGE
//------------------------------------------------------------------------------

function recupImage(Line : String) : String;
var
   ImageAddress : String;
   StartPos: Integer;
begin
     StartPos := pos('http://images-eu.amazon.com/images/P/', Line);
     delete(Line, 1, StartPos-1);
     ImageAddress := copy(Line, 0, pos('"', Line) - 1);
     ImageAddress := StringReplace(ImageAddress, 'THUMBZZZ', 'LZZZZZZZ');
     result := ImageAddress;
end;

//------------------------------------------------------------------------------
// RECUPERE LE TITRE
//------------------------------------------------------------------------------

function recupTitle(Line : String) : String;
var
   title : String;
   StartPos: Integer;
begin
     StartPos := pos('http://images-eu.amazon.com/images/P/', Line);
     delete(Line, 1, StartPos-1);
     StartPos := pos('<b>', Line);
     delete(Line, 1, StartPos-1);
     title := copy(Line, 1, pos('</b></a>', Line)-1);
     HTMLRemoveTags(title);
     title := StringReplace(title, #13#10, '');
     result := title;
end;

//------------------------------------------------------------------------------
// IMPORTE L'IMAGE AMAZON
//------------------------------------------------------------------------------

procedure importAmazon(Line : String);
var
   ImageAddress : String;
   StartPos: Integer;
begin
     StartPos := pos('http://images-eu.amazon.com/images/P/', Line);
     delete(Line, 1, StartPos-1);
     ImageAddress := copy(Line, 0, pos('"', Line) - 1);
     ImageAddress := StringReplace(ImageAddress, 'THUMBZZZ', 'LZZZZZZZ');
     Sleep(500);
     GetPicture(ImageAddress);
end;


//------------------------------------------------------------------------------
// SUPPRIME LES ACCENTS
//------------------------------------------------------------------------------

function supprimeAccents(NomFilm : String) : String;
begin
     NomFilm := StringReplace(NomFilm, 'Θ', 'e');
     NomFilm := StringReplace(NomFilm, 'Φ', 'e');
     NomFilm := StringReplace(NomFilm, 'α', 'a');
     NomFilm := StringReplace(NomFilm, 'τ', 'c');
     NomFilm := StringReplace(NomFilm, '∙', 'u');
     NomFilm := StringReplace(NomFilm, 'δ', 'e');
     NomFilm := StringReplace(NomFilm, 'Ω', 'e');
     NomFilm := StringReplace(NomFilm, '⌠', 'o');
     delete(NomFilm, pos(' - ',NomFilm), length(NomFilm));
     if (pos(', ',NomFilm) > 0) then
        delete(NomFilm, 1, pos(', ',NomFilm)+1);
     if (pos('(',NomFilm) > 0) then
        delete(NomFilm, pos('(',NomFilm), length(NomFilm));
     if (pos(':',NomFilm) > 0) then
        delete(NomFilm, pos(':',NomFilm), length(NomFilm));
     result := trim(NomFilm);
end;

//------------------------------------------------------------------------------
// VERIFIE LE RESULTAT AMAZON
//------------------------------------------------------------------------------

function compareTitle(titleAllo, title : String) : String;
begin
     title := supprimeAccents(trim(AnsiLowerCase(title)));
     titleAllo := supprimeAccents(trim(AnsiLowerCase(titleAllo)));
     if (title = titleAllo) then
     begin
       result := 'OK';
     end else
     begin
       result := 'KO';
     end;
end;

//------------------------------------------------------------------------------
// TROUVE LE BON TITRE SI LE PREMIER N'EST PAS LE BON
//------------------------------------------------------------------------------

procedure trouveTitle(title : String);
var
   oK, couple, titre, adresse : String;
begin
   for i:=0 to listeResultat.Count-1 do
   begin
     couple := listeResultat.GetString(i);
     titre := copy(couple,0,pos('|',couple)-1);
     adresse := copy(couple,pos('|',couple)+1,length(couple)-1);
     oK := compareTitle(title,titre);
     if oK = 'OK' then
     begin
       recupInfo(adresse);
       exit;
     end;
   end;
   listeResultat.Free;

end;

//------------------------------------------------------------------------------
// NETTOIE LE TITRE DU FICHIER POUR AVOIR LE TITRE DE FILM
//------------------------------------------------------------------------------

function cleanTitle(title : String) : string;
var
  i,j, fin : Integer;
  temp : String;

begin
  title := AnsiUpperCase(title);

  if title <> '' then
  begin
// Nettoie les tags fichiers, merci Atmosfear pour les tags
  i:=pos('.DVD',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;
  i:=pos('.DIVX',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;
  i:=pos('.FREN',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;
  i:=pos('.GERM',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;
  i:=pos('.INT',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;
  i:=pos('.LIM',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;
  i:=pos('.PROP',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;
  i:=pos('.REPACK',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;
  i:=pos('.SUBB',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;
  i:=pos('.UNSUB',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;
  i:=pos('.WS',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;
  i:=pos('.XVID',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;
  i:=pos('.AC3',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;
  i:=pos('.UNRAT',title);
  if i <> 0 then
  begin
    title := copy(title,1,i-1);
  end;

   title := StringReplace(title, '.', ' ');
   title := StringReplace(title, ',', ' ');
   title := StringReplace(title, ':', '');
   title := StringReplace(title, '-', '');
   title := StringReplace(title, '  ', ' ');

   i := 0;
// Nettoie les tags de team
   if (pos('(',title) <> 0) then
   begin
     i := pos('(',title);
     temp := copy(title,0,i-1);
     j := pos(')',title);
     fin := Length(title);
     title := temp + copy(title,j+1,fin);
   end;

   if (pos('[',title) <> 0) then
   begin
     i := pos('[',title);
     temp := copy(title,1,i-1);
     j := pos(']',title);
     fin := Length(title);
     title := temp + copy(title,j+1,fin);
   end;

   title := AnsiLowerCase(title);
   title := AnsiUpFirstLetter(title);
   title := AnsiMixedCase(title,' -');
  end;
   result := title;
end;

//------------------------------------------------------------------------------
// PROGRAMME PRINCIPAL
//------------------------------------------------------------------------------

begin
  if CheckVersion(3,5,0) then
  begin
    if (GetOption('Recherche sur le titre') = 0) then
    begin
      MovieName := GetField(fieldTranslatedTitle);
      if MovieName = '' then
        MovieName := GetField(fieldOriginalTitle);
    end else
    if (GetOption('Recherche sur le titre') = 1) then
    begin
      MovieName := GetField(fieldOriginalTitle);
      if MovieName = '' then
        MovieName := GetField(fieldTranslatedTitle);
    end;
    MovieName := cleanTitle(MovieName);
    if (GetOption('Type de Lancement') = 0) then
    begin
      if Input('Amazon.fr by ScorEpioN', 'Entrez le titre du film :', MovieName) then
      begin
        if Pos('amazon.', MovieName) > 0 then
        begin
          recupInfo(MovieName);
        end else
          imageAmazon(MovieName);
      end;
    end else
    begin
      if (premiereExecution = 0) then
      begin
          premiereExecution := -1;
          if (ShowConfirmation('Vous allez executer le script sans confirmation, cliquer sur ''''OUI'''' pour continuer') = True) then
          begin
            imageAmazon(MovieName);
          end else
            exit;
      end else
      begin
          imageAmazon(MovieName);
      end;
    end;
  end else
    ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.0)');
end.