Probablemente la mejor pagina de carteles española.
La página web, no tiene buscador, de modo que la busqueda es secuencial y alfabética; imprescindible, pues, incluir en la busqueda la primera palabra de la película.
La pagina es bastante artesanal con lo cual no hay patrones fijos para los datos técnicos de las películas; por otra parte en el 95 por ciento solo incluye el titulo español, el origina y el año de producción.
Ya contareis.
CartelesMix (ES).ifs
Code: Select all
(***************************************************
Ant Movie Catalog importation script
www.antp.be/software/moviecatalog/
[Infos]
Authors=gilistico
Title=CartelesMix (ES)
Description= Movie importation script for CartelesMix (Spain)
Site=www.cartelesmix.com
Language=ES
Version=1.0
Requires=3.5.0
Comments= La web carece de buscador, en consecuencia la busqueda es secuelcial y alfabética, imprescindible la primera palabra del título.
License=This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. |
GetInfo=1
[Options]
***************************************************)
program CartelesMix;
var
MovieName,MovieName2: string;
L: Char;
NR: Integer;
LineTmp: String;
//------------------------------------------------------------------------------------
function DeleteSpaces(var S: string): string;
var
n,len, tag, space: Integer;
c: char;
t: String;
begin
tag := 0;
space := 0;
t := '';
len := length(s);
for n :=1 to len do
begin
c := Copy(s,n,1);
if (c= #13) OR (c=#10) OR (c= #32) OR (c=#9) then
begin
if space = 1 then
continue;
c := #32;
space := 1;
end
else
begin
space := 0;
end;
t := t + c;
end
s := t;
result := t;
end;
//------------------------------------------------------------------------------------
function PrimeraPalabra(var S: string): string;
var
n,len: Integer;
c: char;
t,tt: String;
begin
t := '';
tt := '';
len := length(s);
for n :=1 to len do
begin
c := Copy(s,n,1);
if c= #32 then
break;
t := t + c;
end
t := AnsiUpFirstLetter(t);
// Descartamos las primeras palabras de una o dos letras
if length(t) <3 then
begin
for n :=n+1 to len do
begin
c := Copy(s,n,1);
if c= #32 then
break;
tt := tt + c;
end;
if length(tt)>length(t) then
t := tt;
end
result := t;
end;
//------------------------------------------------------------------------------------
function GetBase(var s: string): string;
var
n,len: Integer;
c: char;
t: String;
begin
len := length(s);
for n :=len downto 1 do
begin
c := Copy(s,n,1);
if c = '/' then
break;
end;
t := Copy(s,1,n);
result := t;
end;
//------------------------------------------------------------------------------------
function GetFile(var s: string): string;
var
n,len: Integer;
c: char;
t: String;
begin
len := length(s);
for n :=len downto 1 do
begin
c := Copy(s,n,1);
if c = '/' then
break;
end;
t := Copy(s,n+1,len-n-4);
result := t;
end;
//------------------------------------------------------------------------------------
function DeleteTags(var S: string): string;
var
n,len, tag, space: Integer;
c: char;
t: String;
begin
tag := 0;
space := 0;
t := '';
len := length(s);
for n :=1 to len do
begin
c := Copy(s,n,1);
if (c= #13) OR (c=#10) OR (c= #32) OR (c=#9) then
begin
if space = 1 then
continue;
c := #32;
space := 1;
end
else
begin
space := 0;
end;
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 ToAlfa(var S: string): string;
var
i,len: Integer;
numeros: Integer;
valor: Integer;
ValorString: String;
C: Char;
begin
len := length(S);
numeros :=0;
valor :=0;
for i:=1 to len do
begin
C := copy(MovieName, i, 1);
if(C<'0') or (C>'9') then break;
numeros := numeros + 1;
valor := valor * 10 + Ord(C) - Ord('0');
end;
ValorString := Millares(valor);
result := ValorString;
end;
function DigitoUnidades(valor: Integer): string;
begin
if(valor=1) then result := 'uno'
else if(valor=2) then result := 'dos'
else if(valor=3) then result := 'tres'
else if(valor=4) then result := 'cuatro'
else if(valor=5) then result := 'cinco'
else if(valor=6) then result := 'seis'
else if(valor=7) then result := 'siete'
else if(valor=8) then result := 'ocho'
else if(valor=9) then result := 'nueve'
else result :='';
end;
function DigitoUnidadesY(valor: Integer): string;
begin
if(valor=1) then result := ' y uno'
else if(valor=2) then result := ' y dos'
else if(valor=3) then result := ' y tres'
else if(valor=4) then result := ' y cuatro'
else if(valor=5) then result := ' y cinco'
else if(valor=6) then result := ' y seis'
else if(valor=7) then result := ' y siete'
else if(valor=8) then result := ' y ocho'
else if(valor=9) then result := ' y nueve'
else result :='';
end;
function Decenas(valor: Integer): string;
begin
if(valor<10) then result := DigitoUnidades(valor mod 10)
else if(valor=10) then result := 'diez'
else if(valor=11) then result := 'once'
else if(valor=12) then result := 'doce'
else if(valor=13) then result := 'trece'
else if(valor=14) then result := 'catorce'
else if(valor=15) then result := 'quince'
else if(valor=16) then result := 'dieciseis'
else if(valor=17) then result := 'diecisiete'
else if(valor=18) then result := 'dieciocho'
else if(valor=19) then result := 'diecinueve'
else if(valor=20) then result := 'veinte'
else if(valor<30) then result := 'veinti' + DigitoUnidades(valor mod 10)
else if(valor<40) then result := 'treinta' + DigitoUnidadesY(valor mod 10)
else if(valor<50) then result := 'cuarenta' + DigitoUnidadesY(valor mod 10)
else if(valor<60) then result := 'cincuenta'+ DigitoUnidadesY(valor mod 10)
else if(valor<70) then result := 'sesenta' + DigitoUnidadesY(valor mod 10)
else if(valor<80) then result := 'setenta' + DigitoUnidadesY(valor mod 10)
else if(valor<90) then result := 'ochenta' + DigitoUnidadesY(valor mod 10)
else if(valor<100)then result := 'noventa' + DigitoUnidadesY(valor mod 10)
else result :='';
end;
function Centenas(valor: Integer): string;
begin
if(valor<100) then result := Decenas(valor mod 100)
else if(valor=100) then result := 'cien'
else if(valor<200) then result := 'ciento ' + Decenas(valor mod 100)
else if(valor<300) then result := 'doscientos ' + Decenas(valor mod 100)
else if(valor<400) then result := 'trescientos ' + Decenas(valor mod 100)
else if(valor<500) then result := 'cuatrocientos ' + Decenas(valor mod 100)
else if(valor<600) then result := 'quinientos ' + Decenas(valor mod 100)
else if(valor<700) then result := 'seiscientos ' + Decenas(valor mod 100)
else if(valor<800) then result := 'setecientos ' + Decenas(valor mod 100)
else if(valor<900) then result := 'ochocientos ' + Decenas(valor mod 100)
else if(valor<1000)then result := 'novecientos ' + Decenas(valor mod 100)
else result :='';
end;
function Millares(valor: Integer): string;
begin
if(valor=0) then result := 'Cero'
else if(valor<1000) then result := Centenas(valor mod 1000)
else if(valor<2000) then result := 'mil ' + Centenas(valor mod 1000)
else result := Centenas(valor div 1000) + ' mil ' + Centenas(valor mod 1000);
end;
function CarToLow(C: char): Char;
begin
if(C>='A') and (C<='Z') then
begin
C := Chr(Ord(C)-Ord('A')+Ord('a'));
end
else if(C='á') or (C='à') or (C='â') or (c='ä') or (C='Á') or (C='À') or (C='Â') or (c='Ä') then
begin
C :='a';
end
else if(C='é') or (C='è') or (C='ê') or (c='ë') or (C='É') or (C='È') or (C='Ê') or (c='Ë') then
begin
C :='e';
end
else if(C='í') or (C='ì') or (C='î') or (c='ï') or (C='Í') or (C='Ì') or (C='Î') or (c='Ï') then
begin
C :='i';
end
else if(C='ó') or (C='ò') or (C='ô') or (c='ö') or (C='Ó') or (C='Ò') or (C='Ô') or (c='Ö') then
begin
C :='o';
end
else if(C='ú') or (C='ù') or (C='û') or (c='ü') or (C='Ú') or (C='Ù') or (C='Û') or (c='Ü') then
begin
C :='u';
end
else if(C='ñ') or (C='Ñ') then
begin
C :='n';
end
else if(C='ç') or (C='Ç') then
begin
C :='c';
end;
result := C;
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);
end;
end;
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 GetLine(Page: TStringList; TextoBusqueda1: string; TextoBusqueda2: string; Flag: Integer): string;
var
Item: string;
Line: string;
LineNr1: Integer;
LineNr2: Integer;
begin
if flag = 1 then
begin
LineTmp := '';
NR := 0;
end;
Nr := FindLine(TextoBusqueda1, Page, NR);
LineNr2 := FindLine(TextoBusqueda2, Page, Nr);
if (Nr = -1) OR (LineNr2 = -1) then
begin
result := '';
exit;
end
Line := LineTmp;
LineTmp := '';
if Line = '' then
Line := Page.GetString(Nr);
Line := TextoBusqueda1 + TextBetween (Line, TextoBusqueda1, '</html>');
if pos(TextoBusqueda2, Line) = 0 then
while TRUE do
begin
Nr := Nr + 1;
Line := Line + ' '+ Page.GetString(Nr);
if pos(TextoBusqueda2, Line) > 0 then
break;
end;
Item := TextBetween (Line, TextoBusqueda1, TextoBusqueda2);
if pos(TextoBusqueda1, Line) > 0 then
LineTmp := Line;
if flag = 1 then
begin
Item := DeleteTags(Item);
HTMLDecode(Item);
Item := StringReplace(Item,':','');
end
else
begin
if Item <>'' then
Item := TextoBusqueda1+DeleteSpaces(Item)+TextoBusqueda2;
if LineTmp = '' then
NR := Nr+1;
end;
result := Item;
end;
//------------------------------------------------------------------------------------
procedure AnalyzePage(Address: string);
var
Page: TStringList;
LineNr, LineNr1,LineNr2: Integer;
Title,Title2, DirURL, OldURL: string;
Pagina: Integer;
Dir: String;
Count: Integer;
Line,Line2: String;
Year: string;
Primera: String;
superheroesmix: String;
begin
PickTreeClear;
Page := TStringList.Create;
Count := 0;
Pagina := 1;
Dir := Address + IntToStr(Pagina) +'.htm';
Page.Text := GetPage('http://www.cartelesmix.com/lista/' + Dir);
// aceleración - busqueda de la primera palabra del titulo de la pelicula
Primera := PrimeraPalabra(Moviename);
LineTmp := '';
Nr := FindLine('<!-- PICTURE TABLE -->', Page, 0);
//Buscamos la primera linea
While TRUE do
begin
LineNr := FindLine(Primera, Page, NR);
if LineNR <> -1 then
break;
//Si no la encontramos, pasamos pagina
Pagina := Pagina + 1;
Dir := Address+ IntToStr(Pagina) +'.htm';
LineNr := FindLine(Dir, Page, 0);
// si no hay más páginas, abandonamos
if LineNR = -1 then
begin
ShowMessage('No se ha encontrado en ' + Address);
Page.Free;
exit;
end;
Page.Text := GetPage('http://www.cartelesmix.com/lista/' + Dir);
Nr := FindLine('<!-- PICTURE TABLE -->', Page, 0);
end
// Buscamos el inicio de la primera linea
while Linenr >= Nr do
begin
Line := Page.GetString(LineNr);
if pos('href=', Line) > 0 then
break;
LineNR := LineNR-1;
end;
if LineNr> NR then
NR := LineNR;
// Busqueda de todas las entradas que contengan el nombre de la pelicula
while TRUE do
begin
// Leemos la entrada completa
Line := GetLine(Page, 'href=', '</a>',0);
// Si no se encuentra en la pagina actual, pasamos página
if NR = -1 then
begin
Pagina := Pagina + 1;
Dir := Address+ IntToStr(Pagina) +'.htm';
LineNr := FindLine(Dir, Page, 0);
// si no hay más páginas, abandonamos
if LineNR = -1 then
break;
Page.Text := GetPage('http://www.cartelesmix.com/lista/' + Dir);
Nr := FindLine('<!-- PICTURE TABLE -->', Page, 0);
LineTmp := '';
//Buscamos la primera linea
LineNr := FindLine(Primera, Page, NR);
while Linenr >= Nr do
begin
Line := Page.GetString(LineNr);
if pos('href=', Line) > 0 then
break;
LineNR := LineNR-1;
end;
if LineNr> NR then
NR := LineNR;
continue;
end
//Si no la encontramos
if pos(Moviename, AnsiLowerCase(Line)) = 0 then
begin
if count = 0 then
continue;
//Buscamos la primera linea
LineNr := FindLine(Primera, Page, NR);
if LineNR = -1 then
NR := 32000;
while Linenr >= Nr do
begin
Line := Page.GetString(LineNr);
if pos('href=', Line) > 0 then
break;
LineNR := LineNR-1;
end;
if LineNr> NR then
NR := LineNR;
continue;
end;
if pos('href="..', Line) > 0 then
begin
DirURL := 'http://www.cartelesmix.com'+ TextBetween (Line, 'href="..', '"');
end
else if pos('http://', Line) > 0 then
begin
DirURL := 'http://'+ TextBetween (Line, 'http://', '"');
end;
if DirURL = OldURL then
continue;
OldURL := DirURL;
Title := TextBetween (Line,'>', '</a>');
Title := DeleteTags(Title);
Count := Count +1;
PickTreeAdd(Trim(Title), DirURL);
end;
if Count = 0 then
begin
ShowMessage('No se ha encontrado en ' + Address);
Page.Free;
exit;
end;
if PickTreeExec(Address) then
begin
Page.Text := GetPage(Address);
LineNr1 := FindLine('Saltar', Page, 0);
LineNr2 := FindLine('presentación', Page, 0);
if (LineNR1<>-1) AND (LineNr2<>-1) AND ((LineNR1=LineNR2) OR (LineNr2=LineNR1+1)) then
begin
Line := Page.GetString(LineNr1);
Address := GetBase(Address) + TextBetween (Line,'<a href="', '"');
Page.Text := GetPage(Address);
end
LineNr1 := FindLine('CARTELES', Page, 0);
LineNr2 := FindLine('PROMOCIONALES', Page, 0);
if (LineNR1<>-1) AND (LineNr2<>-1) AND ((LineNR1=LineNR2) OR (LineNr2=LineNR1+1)) then
begin
Line := Page.GetString(LineNr1);
Address := GetBase(Address) + TextBetween (Line,'<a href="', '"');
Page.Text := GetPage(Address);
end
LineTmp := '';
LineNr := FindLine('Carteles</option>', Page, 0);
if (LineNr <> -1) then
begin
LineNr1 := FindLine('SuperHeroesMix', Page, 0);
if LineNr1 <> -1 then
begin
Line := Page.GetString(LineNr);
Address := 'http://superheroesmix.iespana.es/'+TextBetween (Line,'value="', '"');
Line := GetLine(Page, '<font face="Verdana, Arial, Helvetica, sans-serif" size="2" color="#FF0000">', '(',1);
if Line <> '' then
SetField(fieldTranslatedTitle, Trim (Line));
Line := GetLine(Page, 'Datos', 'Director',1);
Line2 := Copy(Line,1,Pos(',',Line)-1);
Line := Copy(Line,Pos(',',Line)+1,length(Line)-Pos(',',Line)+1);
if Line2 <> '' then
SetField(fieldOriginalTitle,Trim (Line2));
Line2 := Copy(Line,1,Pos(',',Line)-1);
Line := Copy(Line,Pos(',',Line)+1,length(Line)-Pos(',',Line)+1);
if Line2 <> '' then
SetField(fieldCountry, Trim (Line2));
if Line <> '' then
SetField(fieldYear, Trim (Line));
Line := GetLine(Page, 'Director', 'Intérpretes',1);
if Line <> '' then
SetField(fieldDirector, Trim (Line));
Line := GetLine(Page, 'Intérpretes', 'Argumento',1);
if Line <> '' then
SetField(fieldActors, Trim (Line));
Line := GetLine(Page, 'Argumento', ' </td>',1);
if Line <> '' then
SetField(fieldDescription, Trim (Line));
Page.Text := GetPage(Address);
end;
end
LineTmp := '';
Nr := 0;
// Busqueda del titulo traducido, original y año
Line := GetLine(Page, '<font color="#FFFF99"', '</font>',0);
if Line = '' then
Line := GetLine(Page, '<td valign="top" colspan=', '</td>',0);
if Line = '' then
Line := GetLine(Page, '<p align="center"><font size="4">', '</font>',0);
if Line <> '' then
begin
Line := '>'+ DeleteTags(Line);
Line2 := Line;
Title := TextBetween (Line,'>', '(');
If Title <> '' then
SetField(fieldTranslatedTitle, Trim (Title));
Title2 := TextBetween (Line2,'(', ')');
If Title2 <> '' then
SetField(fieldOriginalTitle,Trim (Title2));
year := TextBetween (Line2,'(', ')');
if year = '' then
begin
SetField(fieldOriginalTitle,Trim (Title));
SetField(fieldYear, Trim (Title2));
end
else
begin
SetField(fieldYear, Trim (Year));
end;
end;
Nr := 0;
Count := 0;
LineTmp := '';
PickTreeClear;
// busqueda de carteles
while TRUE do
begin
Line := GetLine(Page, '<a href=', '</a>',0);
if Line = '' then
break;
if (pos('.jpg', Line) = 0) AND (pos('.JPG', Line) = 0) then
continue;
if pos('http:', Line) > 0 then
begin
DirURL := 'http:' + TextBetween (Line, 'http:', '"');
end
else
begin
DirURL := GetBase(Address) + TextBetween (Line, '<a href="', '"');
end;
Count := Count +1;
Title := TextBetween (Line,' alt="', '"');
If Title = '' then
Title := GetFile(DIRURL);
PickTreeAdd(Trim(Title), DirURL);
end;
// Finalizando en función de los carteles encontrados
if Count = 0 then
begin
ShowMessage('No se han encontrado carteles');
end
else if count = 1 then
begin
GetPicture(DirURL);
end
else if PickTreeExec(Address) then
begin
GetPicture(Address);
end;
end
Page.Free;
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('CartelesMix (Busqueda alfabética)', 'Titulo (Necesaria la primera palabra):', MovieName);
if Trim(MovieName) = '' then
exit;
// Primer caracter del título
L := copy(MovieName, 1, 1);
if (L>='0') AND (L<='9') then
begin
MovieName2 := ToAlfa(Moviename);
L := copy(MovieName2, 1, 1);
end;
L:= CarToLow(L);
MovieName := AnsiLowerCase(MovieName);
AnalyzePage('carteles_' + L);
end.