antp.be forum

Code: Select all

// GETINFO SCRIPTING
// Moviecovers (base DIVX) Achille

(***************************************************
 *                                                 *
 *             MOVIECOVERS extraction              *
 *                by ACHILLE                       *
 *                                                 *
 *  Ce script est baser sur le site movie cover    *
 *  il permet d'aller cherché le Titre fr          *
 *  nom du réalisateur                             *
 *  année de sortie / nationalité du film / genre  *
 *  la durée / liste des nom d'acteurs / résumé    *
 *  distributeur en francee/ titre original /      *
 *  mots clef                                      *
 *                                                 *
 *  Pour ceux quii esite encor a quiter basedivx   *
 *  Voici un script qui ce raproche de sa méthode  *
 ***************************************************)

program MovieCovers;



var
  MovieName: string;
  LineNr: Integer;

function FindLine(Pattern: string; List: TStringList; StartAt: Integer): Integer;
var
  i: Integer;
begin
  result := -1;
  if StartAt < 0 then
    StartAt := 0;
  for i := StartAt to List.Count-1 do
    if Pos(Pattern, List.GetString(i)) <> 0 then
    begin
      result := i;
      Break;
    end;
end;
(*

Cettee fonction ne marche pas elle est sencé  transformé les codes uurl ( type %20 pour l'espace )
en caracter ascii ( type espace a la place de %20 )

exemple :

 urldeencode('bonjour%20achille') devrais renvoyer 'bonjour achille'
 
 voilla son fonctionnemennt
 on teste les chr un par un
 si le chhr = % alors on prend  les 2 chr suivant
 on transforme ce codee hexadecimal en entier (code ascii )
 on transforme cette entier en chr par ll'inverse du code ascii
 
 faacile a dire mais pas  a faire quand on ne connais pass les subtiilité du pascal ou ddu delphi
 
 
 

function urldeencode(STR : string): string;
var
URLED_STR, num : string;
i, xl: integer;
begin
        URLED_STR := '';
        for i := 1 to length(STR) do
                begin
                        xl := ord(MidStr(STR,i,1));
                        if (xl=25) then
                          num:=MidStr(STR,i + 1,2);
                          num:=chr(hexaToInt(num));
                          URLED_STR := URLED_STR + num;
                          i:=i+3
                        else
                          URLED_STR := URLED_STR + MidStr(STR,i,1);
                end;
        Result := URLED_STR;
end;

*)



function urldecod(STR : string): string;
var
  urd: string;
begin
(* fonction inverce  de URLencode un peut artizanale*)
  urd:=stringreplace(STR,'%20',' ');
  urd:=stringreplace(urd,'%23','#');
  urd:=stringreplace(urd,'%22','"');
  urd:=stringreplace(urd,'%27','''');
  urd:=stringreplace(urd,'%25','%');
  result:=urd;

end;



procedure AnalyzePage(Address: string);
var
  Line, Value: string;
  LastLine, BeginPos, EndPos: Integer;
  Page: TStringList;
begin
  Line := GetPage(Address);
  if Pos('il n''y a pas de film correspondant à ce(s) critère(s) dans <B>MOVIECOVERS</B>', Line) > 0 then
  begin
    ShowMessage('No movie found');
    Exit;
  end;
  PickTreeClear;
  BeginPos := Pos('<FONT size="+1" color="#000000"><B>', Line);
  Delete(Line, 1, BeginPos - 1);
  EndPos := Pos('</FONT>', Line);
  Value := Copy(Line, 1, EndPos - 1);
  HTMLRemoveTags(Value);
  HTMLDecode(Value);
  BeginPos := Pos(' <TABLE border=0 cellspacing=0 cellpadding=6 align="center" width="100%">', Line) + 1;
  Delete(Line, 1, BeginPos);
  EndPos := Pos(' <TABLE border=0 cellspacing=0 cellpadding=6 align="center" width="100%">', Line) + 1;
  Delete(Line, EndPos, Length(Line));
  Page := TStringList.Create;
  Page.Text := Line;
  Value := Trim(Value) + ' : ' + Trim(Page.GetString(2));
  PickTreeAdd(Value, '');
  for LineNr := 3 to Page.Count-1 do
  begin
    Line := Page.GetString(LineNr);
    if Pos('<LI><A', Line) > 0 then
    begin
      BeginPos := Pos('/film/titre', Line);
      EndPos := Pos('">', Line);
      Value := 'http://www.moviecovers.com' + Copy(Line, BeginPos, EndPos - BeginPos);
      (*Picktreeadd(value, value);*)
      HTMLRemoveTags(Line);
      PickTreeAdd(Trim(Line), Value);
    end;
  end;
  if PickTreeExec(Address) then
    (*AnalyzeMoviePage(Address);*)
    resume(Address);
  Page.Free;
end;

function TwoLinesAfter(Pattern: string; Page: TStringList): string;
begin
  LineNr := FindLine(Pattern, Page, LineNr);
  Result := Page.GetString(LineNr+2);
  HTMLRemoveTags(Result);
  HTMLDecode(Result);
  Result := Trim(Result);
end;



procedure resume (Adress: string);
(*
Proccedure de remplacement pour aller cherché les textes directement suur la page de traitement a programme
ajouter par ACHILLE le 15 / 08 / 2004


*)
var
  nouvelleadr, idcm, dure : string;
  lestx: TStringList;
  BeginPos, EndPos, IntValue: Integer;

begin
SetField(fieldURL, Adress);
nouvelleadr:=stringreplace(Adress,'http://www.moviecovers.com/film/titre_','');
idcm:=stringreplace(nouvelleadr,'.html','');
(*idcm:= HTMLDecode(idcm);  je ne commprend pas pourquoi sa ne fonctionnne pas
HTMLDecode(idcm); ni sa non plus dailleur*)
idcm:=urldecod(idcm);
(*pour plus de détaiilles sur mooviie cover aller voir http://www.moviecovers.com/interfacage.html *)
Adress:='http://www.moviecovers.com/getfilm.html' ;
nouvelleadr:='idmc=' + idcm;
  lestx := TStringList.Create;
  lestx.text:= postpage(Adress,nouvelleadr);
Adress:=lestx.getstring(5);
(*SetField(fieldComments, idcm); (*vue qu'il ny a  pas de comentaire sur moovie cover je me seert des commentairre pour
tester  mes variables*)

SetField(fieldTranslatedTitle, lestx.getstring(0));
SetField(fieldDirector,lestx.getstring(1));
SetField(fieldYear, lestx.getstring(2));
SetField(fieldCountry, lestx.getstring(3));
SetField(fieldCategory, lestx.getstring(4));
 (* vv passage de l'heure du format hhHmm au format mmm vv*)
 
    dure:= lestx.getstring(5);
    BeginPos := Pos('H', dure);
    IntValue := (StrToInt(Copy(dure, 1, BeginPos - 1), 0) * 60) + (StrToInt(Copy(dure, BeginPos + 1, Length(dure)), 0));
 (* ^^ passage de l'heure du format hhHmm au format mmm ^^*)
SetField(fieldLength, IntToStr(IntValue));
SetField(fieldActors, lestx.getstring(6));
SetField(fieldDescription, lestx.getstring(7));
SetField(fieldProducer, lestx.getstring(8));
SetField(fieldOriginalTitle, lestx.getstring(9));
if GetField(fieldOriginalTitle) = '' then
    SetField(fieldOriginalTitle, GetField(fieldTranslatedTitle));
    
    GetLargePicture(idcm);


  DisplayResults;
end;

procedure GetLargePicture(Address: string);
(* procedure refaite par acchille pour aller recherché l'affiche du film en grand format *)
begin
Address :=urlencode(address);
GetPicture('http://www.moviecovers.com/getjpg.html/' + Address, False);
end;

begin
  if CheckVersion(3,4,2) then
  begin
    MovieName := GetField(fieldTranslatedTitle);
    if MovieName = '' then
      MovieName := GetField(fieldOriginalTitle);
    if Input('MovieCovers Achille', 'Entrez le titre du film :', MovieName) then
    begin
      AnalyzePage('http://www.moviecovers.com/multicrit.html?titre=' + UrlEncode(MovieName) + '&slow=1&listes=1');
    end;
  end else
    ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.4.2)');
end.program NewScript;
begin
end.