Je propose ce petit script qui va chercher les infos sur Amazon pour les BD. Pas de bugs à signaler apparemment
Je suis en train de chercher quel site a les meilleures infos en matière de BD pour en faire un deuxième plus précis.
Merci à vous
Code: Select all
program Amazon_FR;
const
AmazonUrl = 'http://www.amazon.fr/exec/obidos/ASIN/';
AmazonSearch = 'http://www.amazon.fr/exec/obidos/search-handle-url/index=books-fr&field-keywords=';
var
BookName, 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/phpbb3/viewtopic.php?t=1453');
BeginPos := pos('TELECHARGER LE SCRIPT AMAZON.FR (Livres) 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://tibo.netultim.com/Amazon%20(Livres)%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('Livres 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/phpbb3/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('Personnages :', '<br>', Line,'0'),GetOption('Casse Choisie')));
// Réalisateur
if CanSetField(fieldDirector) then
MonSetField(fieldDirector, formatTitre(findInfo('de ', '<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, findInfo('Format :', '<br/>', Line,'0'));
// Langue
if CanSetField(fieldLanguages) then
MonSetField(fieldLanguages, findInfo('Langue :', '<b>', 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('<b>Dimensions (en cm) :', '</font>', Line,'0');
if Value <> '' then
Value := 'Dimensions (en cm) : '+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
Value := findInfo('Collection :', '<br/>', Line,'0');
if Value <> '' then
Value := 'Collection : '+Value;
MonSetField(fieldDescription, 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
BookName := GetField(fieldTranslatedTitle);
if BookName = '' then
BookName := GetField(fieldOriginalTitle);
end else
if (GetOption('Recherche sur le titre') = 1) then
begin
BookName := GetField(fieldOriginalTitle);
if BookName = '' then
BookName := GetField(fieldTranslatedTitle);
end;
BookName := cleanTitle(BookName);
if (GetOption('Type de Lancement') = 0) then
begin
if Input('Amazon.fr for Books by Tibo', 'Entrez le titre du livre cherché :', BookName) then
begin
if Pos('amazon.', BookName) > 0 then
begin
recupInfo(BookName);
end else
imageAmazon(BookName);
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(BookName);
end else
exit;
end else
begin
imageAmazon(BookName);
end;
end;
end else
ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.0)');
end.
