antp.be forum

Official Forum
https://forum.antp.be/phpbb3/

CartelesPeliculas (ES) v1.1

https://forum.antp.be/phpbb3/viewtopic.php?t=5892

Page 1 of 1

CartelesPeliculas (ES) v1.1

Posted: 2014-07-21 11:10:23
by carlosmg2
Hi, I just updated this script to work a bit better as I like the updated HQ posters of this web.

I just modified a bit the original code. Credits go to original creator Raulsara

--

He actualizado este script para que funcione un poco mejor, porque me gustan los buenos posters de esta pagina.
Solo lo he modificado un poco. Los creditos van para el creator original del script Raulsara

Code: Select all

program CartelesPeliculasImportar;

//
// Creado por Raulsara
// updated by carlosmg2
//

uses
  StringUtils1;

var
  Title: string;
  Titleorig: string;
  c: Char;
  Index: Integer;


//
// Función que suprime los acentos
//

function Sinacento(Conacento : String): String;

var
  Acento, Noacento : String;
  i : integer;
begin
  Acento := 'ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿ';
  Noacento := 'AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuy';
 for i := 1  to Length(Acento) do
    Conacento := StringReplace(Conacento,copy(Acento, i, 1),copy(Noacento, i, 1));
  result := Conacento;
end;

//
// Función para convertir a ascii
//

function Caracter(str1: string) : string;
begin
  str1 := StringReplace(str1, 'á' , 'á');
  str1 := StringReplace(str1, 'é' , 'é');
  str1 := StringReplace(str1, 'í' , 'í');
  str1 := StringReplace(Str1, 'ó' , 'ó');
  str1 := StringReplace(str1, 'ú' , 'ú');
  str1 := StringReplace(str1, 'ñ' , 'ñ');
  str1 := StringReplace(str1, 'É' , 'É');
  str1 := StringReplace(str1, 'Ã?' , 'Í');
  str1 := StringReplace(str1, 'Ó' , 'Ó');
  str1 := StringReplace(str1, 'Ú' , 'Ú');
  str1 := StringReplace(str1, 'Ñ' , 'Ñ');
  str1 := StringReplace(str1, 'Â'  ,  '');
  str1 := StringReplace(str1, 'â' , 'â');
  str1 := StringReplace(str1, 'ê' , 'ê');
  str1 := StringReplace(str1, 'î' , 'î');
  str1 := StringReplace(str1, 'ô' , 'ô');
  str1 := StringReplace(str1, 'û' , 'û');
  str1 := StringReplace(str1, 'è' , 'è');
  str1 := StringReplace(str1, 'ì' , 'ì');
  str1 := StringReplace(str1, 'ò' , 'ò');
  str1 := StringReplace(str1, 'ù' , 'ù');
  str1 := StringReplace(str1, 'ä' , 'ä');
  str1 := StringReplace(str1, 'ë' , 'ë');
  str1 := StringReplace(str1, 'ï' , 'ï');
  str1 := StringReplace(str1, 'ö' , 'ö');
  str1 := StringReplace(str1, 'ü' , 'ü');
  str1 := StringReplace(str1, 'Ã￾' , 'Á');
  str1 := StringReplace(str1, 'Ã' ,  'à');
  str1 := StringReplace(str1, '¥' ,  'å');
  str1 := StringReplace(str1 , '“' , '"'  );
  str1 := StringReplace(str1 , '”' , '"'  );
  str1 := StringReplace(str1 , '’' , '''' );
  str1 := StringReplace(str1 , '‘' , '''' );
  str1 := StringReplace(str1 , '&'   , '&'  );
  str1 := StringReplace(str1 , '–' , '-'  );
  str1 := StringReplace(str1 , '&'  , '&'  );
  str1 := StringReplace(str1 , '″' , '"'  );
  str1 := StringReplace(str1 , '…' , '...');
  str1 := StringReplace(str1 , ' ' , '');
//  Str1 := Sinacento (Str1);
  result := str1;

end;


//
// Funcion que borra signos y quita acentos
//

function PreparaTitulo(T: string): string;

var
  i: Integer;

begin
  HTMLDecode(result);
  result := AnsiLowerCase(T);
  result := StringReplace(result, chr(146), '');
  result := StringReplace(result, chr(39), '');
  result := StringReplace(result, '´', '');
  result := StringReplace(result, '`', '');
  result := StringReplace(result, '"', '');
  result := StringReplace(result, '¿', '');
  result := StringReplace(result, '?', '');
  result := StringReplace(result, '¡', '');
  result := StringReplace(result, '!', '');
  result := StringReplace(result, '.', '');
  result := StringReplace(result, ':', '');
  result := StringReplace(result, ';', '');
  //result := StringReplace(result, '-', '');
  result := StringReplace(result, '/', '');
  result := StringReplace(result, '\', '');
  result := StringReplace(result, '_', '');
  result := StringReplace(result, 'á', 'a');
  result := StringReplace(result, 'Á', 'a');
  result := StringReplace(result, 'À', 'a');
  result := StringReplace(result, 'é', 'e');
  result := StringReplace(result, 'í', 'i');
  result := StringReplace(result, 'ó', 'o');
  result := StringReplace(result, 'ú', 'u');
  result := StringReplace(result, 'ä', 'a');
  result := StringReplace(result, 'ë', 'e');
  result := StringReplace(result, 'ï', 'i');
  result := StringReplace(result, 'ö', 'o');
  result := StringReplace(result, 'ü', 'u');
  result := StringReplace(result, '–', '-'  );
  result := StringReplace(result, '…', '...');
  result := Caracter (result);
end;

//
//
//   P R O C E D U R E
//
//


//
// Crea la lista de las peliculas que contengan el titulo introducido
//

procedure PaginasCartelesPeliculas (Titulo: string);

var

  CPPage : TStringList;
  Line, PageWeb, TitleWeb, Encontrado, SwFin, TitleWebSin, Any, PageWebList : string;
  LineNr, ContPagina, i, j,  PosAny : Integer;

begin
    Encontrado := '0';  // Si encontrado = '0' es que no se encuentra la pelicula
    PickTreeClear;
    PickTreeAdd('Resultados de la búsqueda para "' + Titulo + '" (www.CartelesPeliculas.com):', '');
    Titulo := UrlEncode (Titulo);
    PageWeb := 'http://www.cartelespeliculas.com/wp/?s=' + titulo;        // Se crea la URL para ver todas las peliculas que contengan el texto introducido
    CPPage := TStringList.Create;
    CPPage.Text := GetPage(PageWeb);
    CPPage.Text := Caracter (CPPage.Text);
    LineNr := 1;
    SwFin := '0';
    ContPagina := 1;
    Repeat                                                               // Para cada pelicula que contenga el texto mira a ver si coincide con el titulo
        If FindLine ('bookmark' , CPPage , LineNr) > 0 then              // Puede haber coincidencias con otros campos de la web (Sinopsis, ...)
          begin
            LineNr := FindLine('bookmark', CPPage, LineNr);
            Line  := CPPage.GetString(LineNr);
            TitleWeb := TextBetween (Line, 'bookmark">' , '<');          // Estrae el titulo
            LineNr := LineNr + 1;
            TitleWebSin := Sinacento(Titleweb);
            Titulo := UrlDecode (Titulo);
            TitleWebSin  := PreparaTitulo(TitleWebSin);
            PageWebList := TextBetween (Line, '<a href="' , '" rel="');    // Extrae la direccion Web
            if Pos(AnsiLowerCase(Titulo), TitleWebSin) > 0 then                           // Verifica si el titulo de la web coincide con el texto
              begin
                LineNr := FindLine('quick-read-more', CPPage, LineNr);
                Line  := CPPage.GetString(LineNr);
                Delete (Line, 1, 4);
                For i := 1 to 5 do                                         // Extrae el año para mostrar en la PickList
                  begin
                    PosAny := Pos(',' , Line);
                    Any := Copy (Line, PosAny - 4 , 4);
                    If (Any > '0000') and (Any < '9999') then
                      begin
                        Any:= ' (' + Any + ')';
                        break
                      end
                    else
                      begin
                        Any := '';
                        Delete (Line , PosAny, 1);
                        end;
                  end;

                PickTreeAdd(TitleWeb + Any, PageWebList);                   // Añade el titulo, año y direccion Web
                Encontrado := '1';
              end
            else															//si no coincide el titulo miramos el primer AKAS
				begin
					LineNr := LineNr - 1;
					LineNr := FindLine('akas', CPPage, LineNr);
					Line  := CPPage.GetString(LineNr);
					TitleWeb := TextBetween (Line, 'alt="akas: ' , ',');          // Estrae el titulo
					LineNr := LineNr + 1;
					TitleWebSin := Sinacento(Titleweb);
					Titulo := UrlDecode (Titulo);
					TitleWebSin  := PreparaTitulo(TitleWebSin);
					PageWebList := TextBetween (Line, '<a href="' , '" rel="');    // Extrae la direccion Web
					if Pos(AnsiLowerCase(Titulo), TitleWebSin) > 0 then                           // Verifica si el titulo de la web coincide con el texto
						begin
							LineNr := FindLine('quick-read-more', CPPage, LineNr);
							Line  := CPPage.GetString(LineNr);
							Delete (Line, 1, 4);
							For i := 1 to 8 do                                         // Extrae el año para mostrar en la PickList
							  begin
								PosAny := Pos(',' , Line);
								Any := Copy (Line, PosAny - 4 , 4);
								If (Any > '0000') and (Any < '9999') then
								  begin
									Any:= ' (' + Any + ')';
									break
								  end
								else
								  begin
									Any := '';
									Delete (Line , PosAny, 1);
								  end;
							  end;


						PickTreeAdd(TitleWeb + Any, PageWebList);                   // Añade el titulo, año y direccion Web
						Encontrado := '1';
						end
					else
						begin
							SwFin:= '1';
						end
				end
        end
        else
          begin
            If FindLine ('Entradas Anteriores' , CPpage, LineNr) > 0 then    // Si 'Entradas Anteriores' es que hay mas paginas con coincidencia
              begin
                ContPagina := ContPagina + 1;
                Titulo := UrlEncode (Titulo);
                PageWeb := 'http://www.cartelespeliculas.com/wp/page/' + (inttostr(ContPagina)) + '/?s=' + titulo;
                CPPage := TStringList.Create;                                // Lee las paginas con coincidencia
                CPPage.Text := GetPage(PageWeb);
                CPPage.Text := Caracter (CPPage.Text);
                LineNr := 1;
              end
            else
              begin
                SwFin := '1';
              end;
          end;

     until (SwFin = '1');

    if (Encontrado = '1') then
      begin

        PickTreeSort;

        if PickTreeExec(pageweb) then                                    // Selecciona que nos interese y va a buscar la caratula
          begin
            AnalyzeMoviePage (PageWeb); // Muestra los carteles seleccionados
          end
      end
   else
     ShowMessage('Titulo ' + Titulo + ' no encontrado en CartelesPeliculas');

end;

//
// Caratula.
//
//Accede a la web para extraer la caratula, Primero va a una web intermedia y despues accede a la caratula
//

procedure AnalyzeMoviePage(PageWeb: string);

var
   Page: TStringList;
   LineNr : Integer;
   Line : string;

begin
   Page := TStringList.Create;                                        // Accede a la Web donde están todas las caratulas y los datos de la pelicula
   Page.Text := GetPage(PageWeb);
   RemovePicture;
   LineNr := 1;
   If FindLine ('./../../pgrande3' , Page , LineNr) > 0 then
     begin
       LineNr := FindLine('./../../pgrande3', Page, LineNr);
       Line  := Page.GetString(LineNr);
       PageWeb := TextBetween (Line, '<a href="./../../' , '" target');    // Forma la Web con la primera caratula que encuentra
       PageWeb := 'http://www.cartelespeliculas.com/' + PageWeb;
       PageWeb := StringReplace(pageWeb , 'amp;'   , '&'  );
       Page.Free
       Page := TStringList.Create;                                         // Accede a la Web intermedia
       Page.Text := GetPage(PageWeb);
       LineNr := 1;
       LineNr := FindLine('galeria/albums/', Page, LineNr);
       If FindLine ('galeria/albums/' , Page , LineNr) > 0 then
         begin
           Line  := Page.GetString(LineNr);
           PageWeb := TextBetween (Line, 'id="imagen" src="' , '" width'); // Forma la Web donde esta la caratula
           PageWeb := 'http://www.cartelespeliculas.com/' + PageWeb;
           Getpicture (PageWeb);                                           // Envía la caratula al programa.
         end
       else
         ShowMessage('Titulo no encontrado en CartelesPeliculas')
     end
   else
     ShowMessage('Titulo no encontrado en CartelesPeliculas');
end;

//
// Inicio
//

begin
  if CheckVersion(3,5,0) then
  begin
    Title := GetField(fieldTranslatedTitle);
    if Title = '' then
      Title := GetField(fieldOriginalTitle);
      Title := PreparaTitulo(Title);
    if Input('Importar de CartelesPeliculas', 'Por favor, introduce el titulo:', Title) then
      begin
        Titleorig := Title;
        PaginasCartelesPeliculas(Title);
      end;
  end
    else
      ShowMessage('Este script necesita una versión superior de Ant Movie Catalog (al menos la version 3.5.0)');
end.

Posted: 2014-07-21 12:53:58
by antp
Thanks, I updated it on the server as version 1.1

For those that update it from here rather than via "update scripts" or from the server, be careful with the function "Caracter": in the one here special characters are interpreted by the forum and so will not work properly.

Posted: 2014-07-28 22:41:00
by magol
Hola, cómo puedo cargar los script? He copiado y pegado el código en su archivo de script correspondiente y me da error interno al ejecutarlo.

Gracias

Posted: 2014-07-29 13:21:34
by raulsara
Hola magol, para cargar los scripts lo puedes hacer desde el programa
Herramientas/Scripting y le das a la primera opcion UPDATE SCRIPTS, también puedes ir directamente a la web http://update.antp.be/amc/scripts/
y desde alli te descargas el sript y lo mueves a la carpeta SCRIPTS del programa.
A lo mejor lo que te ha pasado es que al copiar el codigo de un script a otro no se copian las propiedades y por eso te puede dar problemas.

Lo mejor es machacar el sript entero con el que te hayas bajado y actualizarlo en la web.

Saludos

Posted: 2014-07-30 09:12:58
by magol
Gracias por la respuesta raulsara.
He cargado el script como me dices y me sigue dando el mismo error, esto me pasa con algunos script. Sale este cartel:

HTTP/1.1 500 Internal Server Error

luego busca el título y no lo encuentra.

Estoy intentando utilizar algún script con carteles en español y todos me dan problemas.

Saludos

Posted: 2014-07-30 16:19:53
by magol
Solucionado el problema al reiniciar el equipo.

Cartelespeliculas va de lujo, también me funcionan cartelesmMix y CaratulasDeCine. Covercaratulas localiza perfectamente el cartel pero luego no lo captura.

Raulsara muchísimas gracias por este excelente trabajo.

Saludos

Posted: 2014-07-30 18:38:35
by raulsara
Hola magol, llevas razón acerca de la web Covercaratulas, lo he probado y no funcionaba, lo he estado mirando y he visto que el webmaster ha cambiado la web por lo que el script ha dejado de funcionar.

Ya lo he arreglado, ahora se lo subo a antp para que la publique. En cuanto esté actualizado enviaré un post.

Si vieras cualquier cosa en esta web o en el resto, házmelo saber para poder arreglarlo.

Gracias por tu colaboración.

Posted: 2014-07-30 20:58:42
by raulsara
Ya esta actualizado en la web el script Covercaratulas. Os lo podeis bajar directamente de la web o via Update script en el programa.

Saludos
All times are UTC
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited