nuevo script Caratulin(ES)

If you made a script you can offer it to the others here, or ask help to improve it. You can also report here bugs & problems with existing scripts.
Post Reply
legrad
Posts: 109
Joined: 2006-02-11 09:46:06
Location: Lerida-Spain

nuevo script Caratulin(ES)

Post by legrad »

Pagina con caratulas de peliculas

Code: Select all

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

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

[Infos]
Authors=Legrad
Title=Caratulin.ifs
Description=Sitio con caratulas DVD
Site=www.caratulin.com
Language=ES
Version=1.0
Requires=3.5.0
Comments=
License=
GetInfo=1

[Options]

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

 program Caratulin;



  

var
  MovieName: string;
  MovieURL: string;
//----------------------------------------------------------------------------------
function Acentos(str1: string) :string;
begin


	str1 := StringReplace(str1, 'En caché', '***');
	str1 := StringReplace(str1, 'Cartel de A - ', '');
 str1 := StringReplace(str1, 'Cartel de B - ', '');
 str1 := StringReplace(str1, 'Cartel de C - ', '');
 str1 := StringReplace(str1, 'Cartel de D - ', '');
 str1 := StringReplace(str1, 'Cartel de E - ', '');
 str1 := StringReplace(str1, 'Cartel de F - ', '');
 str1 := StringReplace(str1, 'Cartel de G - ', '');
 str1 := StringReplace(str1, 'Cartel de H - ', '');
 str1 := StringReplace(str1, 'Cartel de I - ', '');
 str1 := StringReplace(str1, 'Cartel de J - ', '');
 str1 := StringReplace(str1, 'Cartel de K - ', '');
 str1 := StringReplace(str1, 'Cartel de L - ', '');
 str1 := StringReplace(str1, 'Cartel de M - ', '');
 str1 := StringReplace(str1, 'Cartel de N - ', '');
 str1 := StringReplace(str1, 'Cartel de Ñ - ', '');
 str1 := StringReplace(str1, 'Cartel de O - ', '');
 str1 := StringReplace(str1, 'Cartel de P - ', '');
 str1 := StringReplace(str1, 'Cartel de Q - ', '');
 str1 := StringReplace(str1, 'Cartel de R - ', '');
 str1 := StringReplace(str1, 'Cartel de S - ', '');
  str1 := StringReplace(str1, 'Cartel de T - ', '');
 str1 := StringReplace(str1, 'Cartel de U - ', '');
 str1 := StringReplace(str1, 'Cartel de V - ', '');
 str1 := StringReplace(str1, 'Cartel de W - ', '');
 str1 := StringReplace(str1, 'Cartel de X - ', '');
 str1 := StringReplace(str1, 'Cartel de Y - ', '');
 str1 := StringReplace(str1, 'Cartel de Z - ', '');
 str1 := StringReplace(str1, 'Cartel de', '');
 str1 := StringReplace(str1, 'Poster', '');
 str1 := StringReplace(str1, '- Caratulas de ...', '');
 str1 := StringReplace(str1, '- Caratulas de Audio, Cine ...', '');
 str1 := StringReplace(str1, ' - Caratulas de Audio, Cine, Dvd ...', '');
 str1 := StringReplace(str1, ' - Caratulas de Audio ...', '');
 str1 := StringReplace(str1, ' - Caratulas de Audio, Cine, Dvd, Divx ...', '');
	result := str1;
end;
//--------------------------------------------------------------------------------

            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;

//------------------------------------------------------------------------------------
                               function DeleteTags(var S: string): string;
var
   n,len, tag: Integer;
   c: char;
   t: String;
begin

   tag := 0;
   t := '';
   len := length(s);

   for n :=1 to len do
   begin
      c := Copy(s,n,1);

      if c = #9 then
         c := ' ';

      if(tag=1) then
      begin
         if(c='>') then tag := 0;
         continue;
      end
      else
      begin
         if(c='<') then
         begin
            tag := 1;
            continue;
         end;
         t := t + c;
      end;
   end;
   s := t;
   result := t;
end;


//------------------------------------------------------------------------------------
                      function TextBetween(var S: string; StartTag: string; EndTag: string): string;
var
  InitialPos: Integer;
begin
  InitialPos := Pos(StartTag, S);
  if InitialPos = 0 then
    result := ''
  else
  begin
    Delete(S, 1, InitialPos + Length(StartTag) - 1);
    InitialPos := Pos(EndTag, S);
    if InitialPos = 0 then
      result := S
    else
    begin
      result := copy(S, 1, InitialPos - 1);
      Delete(S, 1, InitialPos + 1);
    end;
  end;
end;


//------------------------------------------------------------------------------------
procedure AnalyzePage(Address: string);
var
  strPage, MovieAddr, MovieTitle, MovieDate, MovieID, Movie: string;
  BeginPos, EndPos: Integer;
  BeginPoss, EndPoss: Integer;
begin
  strPage := GetPage(Address);
  BeginPos := Pos('www.caratulin.com/cine/details.php?image_id=', strPage);
  if(BeginPos > -1)then
    begin
      PickTreeClear;
      Delete(strPage, 1, BeginPos);
      BeginPos := Pos('www.caratulin.com/cine/details.php?image_id=', strPage);
      EndPos := 1;
      while ((BeginPos > 0) and (EndPos > 0)) do
      
        begin
          Delete(strPage, 1, BeginPos);
          EndPos := Pos('" clas', strPage);
          MovieId := Copy(strPage,+44, EndPos-44);
          MovieAddr := 'http://www.caratulin.com/cine/details.php?image_id=' + MovieId;
          BeginPoss := Pos(')"',strPage);
          EndPoss := Pos('</h2>', strPage);
          MovieTitle := Copy(strPage,BeginPoss, EndPoss);
          MovieTitle := TextBetween (MovieTitle, '>', '</a>');
          DeleteTags(MovieTitle);
          MovieTitle :=Acentos (MovieTitle);
          PickTreeAdd(MovieTitle, MovieAddr);
          BeginPos := Pos('www.caratulin.com/cine/details.php?image_id=', strPage);
          if(Pos('</body>', strPage) < BeginPos) then
           BeginPos := -1;
        end;

    end;
    PickTreeExec(Address)
    AnalyzeMoviePage(Address);
end;
//------------------------------------------------------------------------------------

procedure AnalyzeMoviePage(Address: string);
var
  Page: TStringList;
  LineNr: Integer;
  Line: string;
  Item: string;

begin

  // URL
  SetField(fieldURL, Address);
  Page := TStringList.Create;
  Page.Text := GetPage(Address);

// Caratula
  LineNr := FindLine('<img src="./data/media/', Page, 0);
  if LineNr <> -1 then
  begin
     Line := Page.GetString(Linenr);
     Item := TextBetween (Line, '<img src="', '" border');
     GetPicture (Item);
  end;
 end;

 //-------------------------------------------------------------------------
begin
       if (CheckVersion(3,5,0)=FALSe) then
   begin
      ShowMessage('Se requiere Ant Movie Catalog versión 3.5 o superior');
      exit;
   end;

   MovieName := GetField(fieldTranslatedTitle);
   if MovieName = '' then
            MovieName := GetField(fieldOriginalTitle);
Input('Caratulin', 'Buscar:', MovieName);

     if(GetOption('No se ha encontrado') = 0) then  Input('Caratulin', 'Buscar:', MovieName);

   AnalyzePage('http://www.google.es/search?as_q=matrix&hl=es&num=' + 

UrlEncode(MovieName)+'&hl=es&num=100&btnG=Buscar+con+Google&as_epq=&as_oq=&as_eq=&lr=&as_ft=i&as_filetype=&as_qdr=all&as_occt=any&as_dt=i&as_sitesea

rch=www.caratulin.com%2Fcine&as_rights=&safe=images');

end.
antp
Site Admin
Posts: 9629
Joined: 2002-05-30 10:13:07
Location: Brussels
Contact:

Post by antp »

Thanks for all the scripts that you make ;)
Bandid©
Posts: 7
Joined: 2006-03-05 19:11:26

Post by Bandid© »

Saludos.
Me da error en:
"MAIN" string error en linea 212

Gracias por el esfuerzo.
legrad
Posts: 109
Joined: 2006-02-11 09:46:06
Location: Lerida-Spain

?

Post by legrad »

Comprueba que has copiado bien el script
sin añadir espacios en blanco por delante del script ni por detras

tienes que copiar justoa hsat el ultimo end y en el inicio que no haya espacios e delante de la primera linea que empieza con (********

yo he probado y me va bien
la linea 212 es donde acaba el ultimo end. verifica que no te has comido el punto tras el end

un saludo
legrad
Posts: 109
Joined: 2006-02-11 09:46:06
Location: Lerida-Spain

Error en el script

Post by legrad »

Excuses to everybody, some prejudiced.
error is not confirm deeply the guión.
In the future I verify scripts in depth that I can realize Excuse the botherments caused to ANTP.
ANTP, the final script is this, when you have the desire can you change on him.

Excuses for everybody.
And pardon by me idiom.
I wait understand him it written.
//---------------------------------------------------------------
Disculpas a todo el mundo, algun perjudicado.
Mi error ha sido no probar en profundidad el script.
En lo sucesivo probare en mas profundidad los scripts que pueda hacer.
Intento con mi ingles cavernicola, esplicar a ANTP que el script esta arreglado y cuando desee puede cambiarlo.

Si alguien con conocimiento mas profundo de ingles desea corregir lo de arriba lo agrdaceria.
Un saludo.

Code: Select all

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

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

[Infos]
Authors=Legrad
Title=Caratulin.ifs
Description=Sitio con caratulas DVD
Site=www.caratulin.com
Language=ES
Version=1.0
Requires=3.5.0
Comments=
License=
GetInfo=1

[Options]

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

 program Caratulin;



  

var
  MovieName: string;
  MovieURL: string;
//----------------------------------------------------------------------------------
function Acentos(str1: string) :string;
begin


	str1 := StringReplace(str1, 'En caché', '***');
	str1 := StringReplace(str1, 'Cartel de A - ', '');
 str1 := StringReplace(str1, 'Cartel de B - ', '');
 str1 := StringReplace(str1, 'Cartel de C - ', '');
 str1 := StringReplace(str1, 'Cartel de D - ', '');
 str1 := StringReplace(str1, 'Cartel de E - ', '');
 str1 := StringReplace(str1, 'Cartel de F - ', '');
 str1 := StringReplace(str1, 'Cartel de G - ', '');
 str1 := StringReplace(str1, 'Cartel de H - ', '');
 str1 := StringReplace(str1, 'Cartel de I - ', '');
 str1 := StringReplace(str1, 'Cartel de J - ', '');
 str1 := StringReplace(str1, 'Cartel de K - ', '');
 str1 := StringReplace(str1, 'Cartel de L - ', '');
 str1 := StringReplace(str1, 'Cartel de M - ', '');
 str1 := StringReplace(str1, 'Cartel de N - ', '');
 str1 := StringReplace(str1, 'Cartel de Ñ - ', '');
 str1 := StringReplace(str1, 'Cartel de O - ', '');
 str1 := StringReplace(str1, 'Cartel de P - ', '');
 str1 := StringReplace(str1, 'Cartel de Q - ', '');
 str1 := StringReplace(str1, 'Cartel de R - ', '');
 str1 := StringReplace(str1, 'Cartel de S - ', '');
  str1 := StringReplace(str1, 'Cartel de T - ', '');
 str1 := StringReplace(str1, 'Cartel de U - ', '');
 str1 := StringReplace(str1, 'Cartel de V - ', '');
 str1 := StringReplace(str1, 'Cartel de W - ', '');
 str1 := StringReplace(str1, 'Cartel de X - ', '');
 str1 := StringReplace(str1, 'Cartel de Y - ', '');
 str1 := StringReplace(str1, 'Cartel de Z - ', '');
 str1 := StringReplace(str1, 'Cartel de', '');
 str1 := StringReplace(str1, 'Poster', '');
 str1 := StringReplace(str1, '- Caratulas de ...', '');
 str1 := StringReplace(str1, '- Caratulas de Audio, Cine ...', '');
 str1 := StringReplace(str1, ' - Caratulas de Audio, Cine, Dvd ...', '');
 str1 := StringReplace(str1, ' - Caratulas de Audio ...', '');
 str1 := StringReplace(str1, ' - Caratulas de Audio, Cine, Dvd, Divx ...', '');
	result := str1;
end;
//--------------------------------------------------------------------------------

            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;

//------------------------------------------------------------------------------------
                               function DeleteTags(var S: string): string;
var
   n,len, tag: Integer;
   c: char;
   t: String;
begin

   tag := 0;
   t := '';
   len := length(s);

   for n :=1 to len do
   begin
      c := Copy(s,n,1);

      if c = #9 then
         c := ' ';

      if(tag=1) then
      begin
         if(c='>') then tag := 0;
         continue;
      end
      else
      begin
         if(c='<') then
         begin
            tag := 1;
            continue;
         end;
         t := t + c;
      end;
   end;
   s := t;
   result := t;
end;


//------------------------------------------------------------------------------------
                      function TextBetween(var S: string; StartTag: string; EndTag: string): string;
var
  InitialPos: Integer;
begin
  InitialPos := Pos(StartTag, S);
  if InitialPos = 0 then
    result := ''
  else
  begin
    Delete(S, 1, InitialPos + Length(StartTag) - 1);
    InitialPos := Pos(EndTag, S);
    if InitialPos = 0 then
      result := S
    else
    begin
      result := copy(S, 1, InitialPos - 1);
      Delete(S, 1, InitialPos + 1);
    end;
  end;
end;


//------------------------------------------------------------------------------------
procedure AnalyzePage(Address: string);
var
  strPage, MovieAddr, MovieTitle, MovieDate, MovieID, Movie: string;
  BeginPos, EndPos: Integer;
  BeginPoss, EndPoss: Integer;
begin
  strPage := GetPage(Address);
  BeginPos := Pos('en el dominio <b>www.caratulin.com', strPage);
  if(BeginPos > -1)then
    begin
      PickTreeClear;
      Delete(strPage, 1, BeginPos);
      BeginPos := Pos('www.caratulin.com/cine/details.php?image_id=', strPage);
      EndPos := 1;
      while ((BeginPos > 0) and (EndPos > 0)) do
      
        begin
          Delete(strPage, 1, BeginPos);
          EndPos := Pos('" clas', strPage);
          MovieId := Copy(strPage,+44, EndPos-44);
          MovieAddr := 'http://www.caratulin.com/cine/details.php?image_id=' + MovieId;
          BeginPoss := Pos(')"',strPage);
          EndPoss := Pos('</h2>', strPage);
          MovieTitle := Copy(strPage,BeginPoss, EndPoss);
          MovieTitle := TextBetween (MovieTitle, '>', '</a>');
          DeleteTags(MovieTitle);
          MovieTitle :=Acentos (MovieTitle);
          PickTreeAdd(MovieTitle, MovieAddr);
          BeginPos := Pos('www.caratulin.com/cine/details.php?image_id=', strPage);
          if(Pos('</body>', strPage) < BeginPos) then
           BeginPos := -1;
        end;

    end;
    PickTreeExec(Address)
    AnalyzeMoviePage(Address);
end;
//------------------------------------------------------------------------------------

procedure AnalyzeMoviePage(Address: string);
var
  Page: TStringList;
  LineNr: Integer;
  Line: string;
  Item: string;

begin

  // URL
  SetField(fieldURL, Address);
  Page := TStringList.Create;
  Page.Text := GetPage(Address);

// Caratula
  LineNr := FindLine('<img src="./data/media/', Page, 0);
  if LineNr <> -1 then
  begin
     Line := Page.GetString(Linenr);
     Item := TextBetween (Line, '<img src="', '" border');
     GetPicture (Item);
  end;
 end;

 //-------------------------------------------------------------------------
begin
       if (CheckVersion(3,5,0)=FALSe) then
   begin
      ShowMessage('Se requiere Ant Movie Catalog versión 3.5 o superior');
      exit;
   end;

   MovieName := GetField(fieldTranslatedTitle);
   if MovieName = '' then
            MovieName := GetField(fieldOriginalTitle);
Input('Caratulin', 'Buscar:', MovieName);

     if(GetOption('No se ha encontrado') = 0) then  Input('Caratulin', 'Buscar:', MovieName);

   AnalyzePage('http://www.google.es/search?num=100&hl=es&as_qdr=all&q=+%22' + UrlEncode(MovieName)+'%22+site%3Awww.caratulin.com&btnG=B%C3%BAsqueda&meta=');

end.
Bandid©
Posts: 7
Joined: 2006-03-05 19:11:26

Post by Bandid© »

Saludos otra vez.
Pues ya que lo dices y estamos de buen rollo :)))
El script de decine21
error en linea 104 MovieTitle := UpFirstLetterWord(MovieTitle );

y en el de Todocine

error en linea 103 MovieTitle := UpFirstLetterWord(MovieTitle );

Ambas con la busqueda de la pelicula "el tren"

Abusando de tu tiempo y paciencia podrías revisar el script de La Butaca. estaba muy bien pero dejo de funcionar y ya no lo han revisado

Gracias por la labor.
Post Reply