antp.be forum

Code: Select all

end;


function CINEOL_ListaBusqueda(Address, params: String): string;
var

Code: Select all

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

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

[Infos]
Authors=Icecubix
Title=Cineol (+Culturalia) (ES)
Description=Movie importation script for Cineol (picture from Culturalia).
Site=http://www.cineol.com + http://www.culturalianet.com
Language=ES
Version=1.4
Requires=3.5.0
Comments=La imagen la coje de Culturalia mediante Culturalia+IMDB.ifs, ya que es mucho mas grande y hay muchísimas. Hay código del script de FilmAffinity (ES).ifs. Los autores de ambos son David Arenillas, Antoine Potten and J.M. Folgueira, de Culturalia+IMDB.ifs y aviloria  (aviloria@yahoo.com) de FilmAffinity (ES).ifs
License=The source code of the script can be used in another program only if full credits to script author and a link to Ant Movie Catalog website are given in the About box or in the documentation of the program.
GetInfo=1

[Options]
BuscarCaratula=1|1|0=Sin carátula|1=La busca en CULTURALIA|2=La busca en CANALOCIO (NO IMPLEMENTADO)
ModoBatch=0|0|0=Modo normal|1=Modo automático (batch). No pregunta nada ni muestra mensajes
BuscarMinicartula=1|1|0=No recuperar la caratula en CINEOL, es demasiado pequeña para mi|1=Recuperar la caratula en CINEOL.

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

(***********************************************************************
Que hay de nuevo, viejo:

v 1.1 (28-Enero 2006)
---------------------
-Adaptado a nuevo formato de Cineol
-Recupera la pequeña carátula que tiene Cineol. Igualmente luego la intenta buscar
 en Culturalia (configurable por parámetro BuscarMiniCaratula).
-Se recupera Recaudación y Estreno en campo Comentarios.
-Si hay mas de un director/productor etc también se recuperan

por Icecubix
************************************************************************)

{
v 1.2 (10-Febrero 2008)
---------------------
- Obtengo el listado entero de premios

v 1.3 (19-Julio 2008)
---------------------
- Adaptacion al nuevo formato de Titulo traducido
- Adaptacion al nuevo formato de Interpretes
- Adaptacion al nuevo formato de Curiosidades
- Evito la busqueda de Caratula en Culturalia ya que dejó de funcionar.

v 1.4 (03-Agosto 2008)
---------------------
- Adaptacion al nuevo formato de Id pelicula (URL)

por GlandeMan (JXO)
}

program Cineol;

uses
  StringUtils1;

const
  BaseURLCulturalia = 'http://www.culturalianet.com/bus/catalogo.php';
  BaseURLCineol = 'http://www.cineol.net/pelicula.php?action=';
  BaseURLCineol2 = 'http://www.cineol.net/multisearch.php';
  BaseURLCineolCaratula = 'http://www.cineol.net/mostrarimagen.php';

var
  MovieName: string;
  MovieURL: string;
  Title: string;
  i: integer;
  s11: string;
  buscarCaratulas: string;
  preguntarTitulo: string;
  minicaratula: string;
  BuscarCaratula, BuscarMiniCaratula, ModoBatch: Boolean;
  Page: TStringList;

//------------------------------------------------------------------------------------
(*
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 MiTextBetween(var S: string; StartTag: string; EndTag: string): string;
var
  InitialPos: Integer;
  a,b: string;
begin
  a := ansiLowerCase(StartTag);
  b := AnsiLowerCase(S);

  InitialPos := Pos(AnsiLowerCase(StartTag), AnsiLowerCase(S));
  Delete(S, 1, InitialPos + Length(StartTag) - 1);
  InitialPos := Pos(AnsiLowerCase(EndTag), AnsiLowerCase(S));
  result := copy(S, 1, InitialPos - 1);
  Delete(S, 1, InitialPos + 1);
end;

//------------------------------------------------------------------------------------

function EliminaInicio(S: string; CR: string): string;
begin
  result := S;
  while Pos(CR, result) = 1 do
  begin
    Delete(result, 1, Length(CR));
  end;
end;

function CadenaEntre(var S: string; StartTag: string; EndTag: string): string;
var
  InicioPos: Integer;
begin
  InicioPos := Pos(StartTag, S);
  Delete(S, 1, InicioPos + Length(StartTag) - 1);
  InicioPos := Pos(EndTag, S);
  result := copy(S, 1, InicioPos - 1);
  Delete(S, 1, InicioPos + 1);
end;


procedure BuscarCaratulaCulturalia;
var
  strTemp: string;
  Articles: array of string;
  Index: integer;
begin
  SetArrayLength(Articles,11);
  Articles[0]:='Lo ';
  Articles[1]:='La ';
  Articles[2]:='Le ';
  Articles[3]:='Uno ';
  Articles[4]:='Una ';
  Articles[5]:='Un ';
  Articles[6]:='El ';
  Articles[7]:='Los ';
  Articles[8]:='Las ';
  Articles[9]:='Unos ';
  Articles[10]:='Unas ';

  // Eliminate spanish article if exists
  for Index := 0 to 10 do
  begin
   if Pos(Articles[Index], MovieName) <> 0 then
   MovieName := copy(MovieName, length(Articles[Index]), length(MovieName));
  end;

  // Eliminate point(s) at final of MovieName before search
  strTemp := MovieName;
  if Copy(strTemp, Length(strTemp), Length(strTemp)) = '.' then
    MovieName := Copy(strTemp, 1, Length(strTemp) -1);

  AnalyzePageCulturalia(BaseURLCulturalia + '?catalogo=1&texto=' + UrlEncode(MovieName) + '&donde=1');
end;

procedure AnalyzePageCulturalia(Address: string);
var
  Page, TempTit: TStringList;
  LineNr: Integer;
  Code, Title, TitleOrig, Year: string;
  TitleFound: Boolean;
begin
  Page := TStringList.Create;
  TempTit := TStringList.Create;
  Page.Text := GetPage(Address);
  Page.Text := StringReplace(Page.Text, '<br>', #13#10);
  if Pos('No se ha encontrado ningún artículo por título', Page.Text) = 0 then
  begin
    if not ModoBatch then
    begin
       PickTreeClear;
       LineNr := 1;
       PickTreeAdd('CULTURALIA: Imagenes para: "' + MovieName + '"', '');
       while LineNr + 3 < Page.Count do
       begin
         Code := TextAfter(Page.GetString(LineNr), 'Codigo = ');
         Title := TextAfter(Page.GetString(LineNr+1), 'Titulo = ');
         TitleOrig := TextAfter(Page.GetString(LineNr+2), 'Titulo original = ');
         Year := TextAfter(Page.GetString(LineNr+3), 'Año = ');
         PickTreeAdd(Title + ' (' + TitleOrig + '), ' + Year, BaseURLCulturalia + '?catalogo=1&codigo=' + Code);
         LineNr := LineNr + 5;
       end;
       Page.Free;
       if PickTreeExec(Address) then
         AnalyzeMoviePageCulturalia(Address);
    end else
    begin
      LineNr := 1;
      TitleFound := True;
      Code := TextAfter(Page.GetString(LineNr), 'Codigo = ');
      Address := (BaseURLCulturalia + '?catalogo=1&codigo=' + Code);
      if TitleFound then
        AnalyzeMoviePageCulturalia(Address);
      Page.Free;
    end;
  end else
  if not ModoBatch then
    ShowMessage('No se ha encontrado ninguna coincidencia por título');
end;


procedure AnalyzeMoviePageCulturalia(Address: string);
var
  Page: TStringList;
  Comments: string;
  strTitle: string;
  strSinopsis: string;
  Line: string;
  LineNr: Integer;
  strTemp: string;
begin
  Page := TStringList.Create;
  Page.Text := StringReplace(GetPage(Address), '<br><br>', #13#10);
  Page.Text := StringReplace(Page.Text, '<br>', #13#10);
  LineNr := FindLine('Imagen = ', Page, 0);
  if LineNr <> -1 then
     GetPicture(TextAfter(Page.GetString(LineNr), 'Imagen = '));
  Page.Free;
end;



procedure CINEOL_BuscarInformacion;
var url: String;
  Articles: array of string;
  Index: integer;
begin
  SetArrayLength(Articles,11);
  Articles[0]:='Lo ';
  Articles[1]:='La ';
  Articles[2]:='Le ';
  Articles[3]:='Uno ';
  Articles[4]:='Una ';
  Articles[5]:='Un ';
  Articles[6]:='El ';
  Articles[7]:='Los ';
  Articles[8]:='Las ';
  Articles[9]:='Unos ';
  Articles[10]:='Unas ';

  // Eliminate spanish article if exists
  for Index := 0 to 10 do
  begin
   if Pos(Articles[Index], MovieName) = 1  then
   MovieName := copy(MovieName, length(Articles[Index]), length(MovieName));
  end;

  url := CINEOL_ListaBusqueda(BaseURLCineol2, URLEncode('search=' + MovieName + '&where=movies'));

  if url <> '' then
    CINEOL_RecuperarInformacionPelicula(url);
end;


function CINEOL_ListaBusqueda(Address, params: String): string;
var
  Page, TempTit: TStringList;
  LineNr: Integer;
  Code, Title, tmp: string;
  ini, fin, cont: integer;
  encontradoParaBatch: boolean;
begin
  Page := TStringList.Create;
  TempTit := TStringList.Create;
// Hacemos un post. Hay otro metodo con get, pero si encuentra solo una hace un redireccionamiento raro
// imposible de rastrear y perdo la página.
//  Page.Text := PostPage(Address, params);


  Page.Text := GetPage(Address + '?' + params);
//  Page.Text := PostPage2(Address, params, 'application/xhtml+xml; charset=utf-8' , 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7.7) Gecko/20050414 Firefox/1.0.3', true, true);

  Page.Text := StringReplace(Page.Text, '<br>', #13#10);

  if Pos('>No se encontraron resultados.', Page.Text) = 0 then
  begin
       PickTreeClear;
       PickTreeAdd('CINEOL: Resultados de búsqueda para: "' + MovieName + '"', '');
       LineNr := FindLine('>Resultados de la búsqueda<', Page, 0);
       if LineNr < 1 then
         exit
       else
       begin
         LineNr := LineNr + 4;
         encontradoParaBatch := true; cont := 0;

         //JXO v 1.4
         //while (pos('idpelicula=', Page.GetString(LineNr)) > 0) and (LineNr + 3 < Page.Count) do
         while (pos('href="pelicula/', Page.GetString(LineNr)) > 0) and (LineNr + 3 < Page.Count) do
         begin
           //tmp   := TextAfter(Page.GetString(LineNr), 'idpelicula=');
           tmp   := TextAfter(Page.GetString(LineNr), 'href="pelicula/');
           //Code  := copy(tmp, 1, pos('"', tmp)-1);
           Code  := copy(tmp, 1, pos('_', tmp)-1);

           ini := pos('">', tmp) + 2;
           fin := pos('</a>', AnsiLowerCase(tmp)) - ini;
           Title := copy(tmp, ini, fin);

           if ModoBatch and (AnsiLowerCase(Title) = AnsiLowerCase(MovieName)) then
           begin
             encontradoParaBatch := true;
             Break;
           end;

           PickTreeAdd(Title, BaseURLCineol + 'view&idpelicula=' + Code);
           LineNr := LineNr + 1;
           cont := cont + 1;
         end;

         Page.Free;
         if ModoBatch then
         begin
            if encontradoParaBatch or (cont  = 1) then
              result := BaseURLCineol + 'view&idpelicula=' + Code
         end
         else
         begin
           if PickTreeExec(Address) then result := Address
                                    else result := '';
         end
       end
  end else
  if not ModoBatch then
    ShowMessage('CINEOL: No se ha encontrado ninguna coincidencia de "'+ MovieName +'"');
end;

procedure CINEOL_RecuperarInformacionPelicula(Address: String);
var
  LineNr, aux: Integer;
  Line, Line2: string;
  Item, s_aux: string;
  comentarios: string;
  interpretes: string;
  s, s2: String;
begin
  // URL
  SetField(fieldURL, Address);

  Page := TStringList.Create;
  Page.Text := GetPage(Address);
//  Page.loadfromfile('d:\b.txt');


  // Titulo traducido
  //s := buscaCampo2('class="txPeliTit"', '<' , 0, '>"', '" <');
  //JXO v1.3
  s := buscaCampo2('class="txPeliTit"><H1', '<' , 0, '>"', '"<');
  setField(fieldTranslatedTitle, s);

  // Titulo original
  s := buscaCampo('>Título Original<', 0, 'SPAN>: ', '<BR>');
  setField(fieldOriginalTitle, s);

  // Genero/Categoria

  LineNr := FindLine('> Género<', Page, 0);
  if LineNr > 0 then
  begin
    Line := Page.GetString(LineNr);
    if pos('title="', Line) > 0 then
    begin
      s := buscaCampo('> Género<',         0,'title="', '"');
      s := StringReplace(s, '/', ', ');
    end
    else
      s := buscaCampo('> Género<',         0,'SPAN>: ', '<');
    setField(fieldCategory, s);
  end;

  // País
  s := buscaCampo2('>País<','>Formato<',    0, 'SPAN>: ', '<BR>');
  setField(fieldCountry, s);

  // Duración
  s := buscaCampo('>Duración<',        0, 'SPAN>: ', ' minutos');
  setField(fieldLength, s);

  // Director
  s := buscaCampo('>Dirección<',     0, '">', '<');

  setField(fieldDirector, s);

  // Productor
  s := buscaCampo('>Producción<',     0, '">', '<');
  setField(fieldProducer, s);

  // Sinopsis
  LineNr := FindLine('>Sinopsis<', Page, 0);
  if LineNr > 0 then
  begin
    Item := copy(Page.Text, pos('Sinopsis</SPAN>:<BR>',Page.Text), length(Page.Text));
    Item := MiTextBetween (Item, 'Sinopsis</SPAN>:<BR>', '<BR><BR>');
    Item := StringReplace(Item, '<br>', #13#10);
    Item := StringReplace(Item, '<BR>', #13#10);
    Item := StringReplace(Item, #13#10#13#10#13#10, #13#10);
    Item := StringReplace(Item, #13#10#13#10#13#10, #13#10);
    HTMLDecode(Item);
    SetField(fieldDescription, Trim (Item));
  end;

  // Año
  s := buscaCampo('>Año<',0, 'SPAN>: ', '<BR>');
  setField(fieldYear, s);



  // Comentarios = Premios, Guion, fotografia, Musica, comentario destacado, web oficial
  // Cada cual que se lo monte a su gusto. A mi me gusta así:
  comentarios := '';
  { v1.1
  s := buscaCampo('>Premios<', 0, 'span>:<br>', '<');
  if s <> '' then comentarios := comentarios + 'Premios: '#9#9 + s + #13#10;
  }

  //JXO v1.2
  LineNr := FindLine('>Premios<', Page, 0);
  if LineNr > 0 then
    BEGIN
      Item := copy(Page.Text, pos('Premios</SPAN>:<BR>',Page.Text), length(Page.Text));
      s := MiTextBetween (Item, 'span>:<br>', '</td>');
      //s := StringReplace(s, '<br>', #13#10);
      s := StringReplace(s, #9#9#9#9, #13#10);
      s := StringReplace(s, '<BR>', #9#9);
      if s <> '' then comentarios := comentarios + 'Premios: '#9#9 + s + #13#10;
      { Para Actualizaciones
      if s <> '' then
        BEGIN
           comentarios := comentarios + 'Premios: '#9#9 + s + #13#10 + GetField(fieldComments);
           setField(fieldComments, comentarios);
        END;
      }
    END;

  s := buscaCampo('>Guión<',   0, '">', '<');
  if s <> '' then comentarios := comentarios + 'Guión: '#9#9 + s + #13#10;

  s := buscaCampo('>Música<',  0, '">', '<');
  if s <> '' then comentarios := comentarios + 'Música: '#9#9 + s + #13#10;

  s := buscaCampo('>Fotografía<', 0, '">', '<');
  if s <> '' then comentarios := comentarios + 'Fotografía: '#9 + s + #13#10;

  s := buscaCampo('>Web oficial:<', 0, 'href="', '"');
  if s <> '' then comentarios := comentarios + 'Web oficial: '#9 + s + #13#10;

  LineNr := FindLine('>Recaudación', Page, 0);
  if pos('Recaudación', Page.GetString(LineNr+1)) > 1 then
  begin
    //si hay mas de una recaudación (ej: Silent Hil) las recuperamos por separado.
    // De momento solo españa y usa
    s  := buscaCampo('>Recaudación España', 0, '>: ', ' <');
    if s <> '' then comentarios := comentarios + 'Recaudación Esp.: ' +#9+ s + #13#10;
    s  := buscaCampo('>Recaudación USA', 0, '>: ', ' <');
    if s <> '' then comentarios := comentarios + 'Recaudación USA: ' +#9+ s + #13#10;
  end
  else
  begin
    //si sólo hay una recaudación lo hacemos de forma variable
    s2 := buscaCampo2('>Recaudación', '€', 0, ' ', '<');
    s  := buscaCampo('>Recaudación', 0, '>: ', ' <');
    if s <> '' then comentarios := comentarios + 'Recaudación ' + s2 + ': ' + s + #13#10;
  end;

  s := buscaCampo('>Estreno<', 0, '>: ', '<');
  if s <> '' then comentarios := comentarios + 'Estreno: '#9#9 + s + #13#10;

  s := '> Comentario destacado<';
  LineNr := FindLine(s, Page, 0);
  if LineNr > 0 then
  begin
    Item := copy(Page.Text, pos(s,Page.Text), length(Page.Text));
    Item := MiTextBetween (Item, '<BR>', '</i></td></tr>');
    Item := StringReplace(Item, '<br>', #13#10);
    Item := StringReplace(Item, '<BR>', #13#10);
    Item := StringReplace(Item, #13#10#13#10#13#10, #13#10);
    Item := StringReplace(Item, #13#10#13#10#13#10, #13#10);
    Item := StringReplace(Item, #13#10#13#10#13#10, #13#10);
    HTMLDecode(Item);
    While pos(#13#10, Item) = 1 do Item := Copy(Item, 3, length(item)); //Nos comemos los <BR> iniciales
    s := Trim(Item);
    if s <> '' then
    begin
      comentarios := comentarios + ' _________________________________________________'#13#10;
      comentarios := comentarios + #13#10 + 'COMENTARIO DESTACADO: ' + #13#10 + s + #13#10;
    end
  end;

  s := '>Curiosidades';
  LineNr := FindLine(s, Page, 0);
  if LineNr > 0 then
  begin
    Item := copy(Page.Text, pos(s,Page.Text), length(Page.Text));
    //JXO v1.2
    //Item := MiTextBetween (Item, '<I>', '</i>');
    Item := MiTextBetween (Item, '<I>', '</I>');
    Item := StringReplace(Item, '<br>', #13#10);
    Item := StringReplace(Item, '<BR>', #13#10);
    Item := StringReplace(Item, #13#10#13#10#13#10, #13#10);
    Item := StringReplace(Item, #13#10#13#10#13#10, #13#10);
    Item := StringReplace(Item, #13#10#13#10#13#10, #13#10);
    HTMLDecode(Item);
    While pos(#13#10, Item) = 1 do Item := Copy(Item, 3, length(item)); //Nos comemos los <BR> iniciales
    s := Trim(Item);
    if s <> '' then
    begin
      comentarios := comentarios + ' _________________________________________________'#13#10;
      comentarios := comentarios + #13#10 + 'CURIOSIDADES: ' + #13#10 + s + #13#10;
    end
  end;

  setField(fieldComments, comentarios);

  //Interpretes
  interpretes := '';
  LineNr := FindLine('>Intérpretes<', Page, 0) + 1;
  Line := Page.GetString(LineNr);
  //JXO v1.3
  //While pos('gente.php?idperson', Line) > 0 do
  While pos('href="gente/', Line) > 0 do
  begin
    interpretes := interpretes + MiTextBetween (Line, '">', '</a>') + copy(Line, pos('>', Line)+1, length(Line)) + #13#10;
    LineNr := LineNr + 2;
    Line := Page.GetString(LineNr);
  end;
  if interpretes <> '' then
    SetField(fieldActors, interpretes);

  //Calificación
  s := buscaCampo2('images/iconotablanca.gif', '</B>', 0, '<font size="1">', '<');
  if s <> '' then setField(fieldRating, s);

  //Carátula
  if BuscarMiniCaratula then
    GetPicture(BaseURLCineolCaratula + buscaCampo('mostrarimagen', 0, 'php', '"'));


end;


function buscaCampo2(patronInicial, patronFinal: String; offset: integer; ini, fin: string): String;
var
  LineNr: Integer;
  Line: string;
  Item: string;
  s: string;
  hayMasDeUno: Boolean;
  finalLinea: Integer;
begin
  Result := '';
  LineNr := FindLine(patronInicial, Page, 0);
  if LineNr > 0 then
  begin
    LineNr := LineNr + offset;
    Line := Page.GetString(LineNr);
    if offset = 0 then
       Line := copy(Line, pos(patronInicial ,Line)+length(patronInicial), length(Line));
    if patronFinal <> '' then
       Line := copy(Line, 1, pos(patronFinal ,Line));

    Item := MiTextBetween (Line, ini, fin);
    hayMasDeUno := false;

    While trim(Item) <> '' do
    begin
       if hayMasDeUno then s := s + ' / ';
       hayMasDeUno := true;
       s := s + Item;
       Line := copy(Line, pos(Item ,Line)+length(Item), length(Line));
       Item := MiTextBetween (Line, ini, fin);
    end;
    HTMLDecode(s);
    result := Trim(s);
  end;
end;

function buscaCampo(patron: String; offset: integer; ini, fin: string): String;
begin
  result := buscaCampo2(patron, '', offset, ini, fin);
end;

//------------------------------------------------------------------------------------
//------------------------------------------------------------------------------------


begin
  BuscarCaratula        := getOption('BuscarCaratula') <> 0;
  BuscarMiniCaratula    := getOption('BuscarMiniCaratula') <> 0;
  ModoBatch             := getOption('ModoBatch') = 1; //OJO: SI EL TITULO DE
                 //LA PELICULA NO COINCIDE NO MOSTRARA INFORMACIÓN, POR QUE LOS
                 //RESULTADOS DE LA BUSQUEDA NO LOS ORDENA POR ORDEN DE SEMEJANZA

  { Un modo mas cómodo de asignar las variables es marcando el check de la caratula y
    del titulo traducido, en los "campos modificables". Si me desmarca la imagen no la buscaré
    y si me marca el titulo traducido(por ejemplo) serà un proceso batch.:

    BuscarCaratula        := CanSetPicture();
    ModoBatch             := not CanSetField(fieldTranslatedTitle);
   }

  if CheckVersion(3,5,0) then
  begin
    MovieName := GetField(fieldTranslatedTitle);
    if MovieName = '' then
      MovieName := GetField(fieldOriginalTitle);

    if (MovieName = '') or not (ModoBatch) then
      if not Input('Importar de CINeol + Culturalia', 'Introduzca el titulo de la pelicula:', MovieName) then
        Exit;

    if (MovieName <> '') then
    begin
         CINEOL_BuscarInformacion; // El titulo a buscar siempre está en MovieName

         //JXO v1.3
         { La busqueda de Culturalia dejo de funcionar
         if BuscarCaratula then
            BuscarCaratulaCulturalia;
          }
    end;
  end
  else
    ShowMessage('Este script requiere una version mas reciente de Ant Movie Catalog (por lo menos la version 3.5.0)');
end.