[REL] La Butaca [ES] - Versión 100% nueva
Posted: 2005-12-12 18:16:16
He intentado que sea rapida y lo más completa posible.
La he probado en un par de centenares de peliculas.
Ya contareis lo que os parece.
LaButaca (ES).ifs
La he probado en un par de centenares de peliculas.
Ya contareis lo que os parece.
LaButaca (ES).ifs
Code: Select all
(***************************************************
Ant Movie Catalog importation script
www.antp.be/software/moviecatalog/
[Infos]
Authors=gilistico
Title=LaButaca (ES)
Description= Movie importation script for "La Butaca + Google" (Spain)
Site=www.labutaca.net
Language=ES
Version=2.1
Requires=3.5.0
Comments= new version (Version totalmente nueva)
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 labutaca;
var
MovieName: string;
//------------------------------------------------------------------------------------
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 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;
//------------------------------------------------------------------------------------
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;
//------------------------------------------------------------------------------------
procedure AnalyzePage(Address: string);
var
Page: TStringList;
LineNr, Count: Integer;
PosIni, PosFin: Integer;
Line, Line2, SubLine: string;
Title, DirURL: string;
txtTemp: string;
begin
Page := TStringList.Create;
Page.Text := GetPage(Address);
LineNr := FindLine('</b> - no produjo ningún documento.<br>', Page, 0);
if LineNr <> -1 then
begin
ShowMessage('No se ha encontrado ningún registro');
Page.Free;
exit;
end;
PickTreeClear;
Count := 0;
LineNr := 0;
While TRUE do
begin
LineNr := FindLine('<p class=g><a class=l href="', Page, LineNR+1);
if LineNr = -1 then
begin
LineNr := FindLine('<b> Siguiente </b>', Page, 0);
if LineNr = -1 then
break;
Line := Page.GetString(LineNr);
Line := TextBetween (Line, '<td nowrap nowrap>', '>');
Address := TextBetween (Line, 'href=', '>');
if Address = '' then
break;
Address := 'http://www.google.com' + Address;
Page.Text := GetPage(Address);
LineNr := 0;
continue;
end;
Line := Page.GetString(LineNr);
Line2 := Line;
DirURL := TextBetween (Line, '<p class=g><a class=l href="', '">');
Line := Line2;
Title := TextBetween (Line,'<p class=g>', '</a>');
Line := TextBetween (Line2,'LA BUTACA -', '</a>');
if Line <>'' then
Title := Line;
DeleteTags(Title);
HTMLDecode(Title);
PickTreeAdd(Title, DirURL);
Count := Count +1;
end;
if Count = 0 then
begin
ShowMessage('No se han encontrado registros');
Page.Free;
exit;
end;
if PickTreeExec(Address) then
AnalyzeMovie(Address);
Page.Free;
end;
function GetLine(Page: TStringList; TextoBusqueda1: string; TextoBusqueda2: string; flag: Integer): string;
var
Item: string;
Line: string;
LineNr: Integer;
begin
LineNr := FindLine(TextoBusqueda1, Page, 0);
if LineNr = -1 then
begin
result := '';
end
else
begin
Line := Page.GetString(LineNr);
while TRUE do
begin
LineNr := LineNr + 1;
Line := Line + Page.GetString(LineNr);
if pos(TextoBusqueda2, Line)> 0 then
break;
end;
Item := TextBetween (Line, TextoBusqueda1, TextoBusqueda2);
Item := DeleteTags(Item);
HTMLDecode(Item);
if flag = 1 then
Item := StringReplace(Item, '.', '');
result := Item;
end;
end;
//------------------------------------------------------------------------------------
procedure AnalyzeMovie(Address: string);
var
Page: TStringList;
LineNr: Integer;
LineEnd: Integer;
Line: string;
Item: string;
Comments: string;
begin
Line := '';
Comments := '';
SetField(fieldURL, Address);
Page := TStringList.Create;
Page.Text := GetPage(Address);
// Titulo español
Line := GetLine(Page, '<title>', '</title>', 0);
LineNr := FindLine('<title>', Page, 0);
Item := TextBetween (Line, 'LA BUTACA - ', '(');
SetField(fieldTranslatedTitle, Item);
SetField(fieldOriginalTitle,Item);
// Titulo original
Line := GetLine(Page, '<title>', '</title>', 0);
Item := TextBetween (Line, '(', ')');
if Item <> '' then
SetField(fieldOriginalTitle,Item);
// Dirección
Line := GetLine(Page, 'Dirección', '<br>', 1);
Item := TextBetween (Line, ':', '<br>');
if Item <>'' then
SetField(fieldDirector, Trim (Item));
// Pais
Line := GetLine(Page, 'País', '<br>', 1);
Item := TextBetween (Line, ':', '<br>');
if Item <>'' then
SetField(fieldCountry, Trim (Item));
// Año
Item := GetLine(Page, 'Año:', '<br>', 1);
if Item <>'' then
SetField(fieldYear, Trim (Item));
// Duración
Item := GetLine(Page, 'Duración:', 'min', 1);
if Item <>'' then
SetField(fieldLength, Trim (Item));
// Genero
Item := GetLine(Page, 'Género:', '<br>', 1);
if Item <>'' then
SetField(fieldCategory, Trim (Item));
// Interpretación
Item := GetLine(Page, 'Interpretación:', '<br>', 0);
if Item = '' then
Item := GetLine(Page, 'Intervención:', '<br>', 0);
if Item = '' then
Item := GetLine(Page, 'Personajes', '<br>', 0);
if Item <>'' then
SetField(fieldActors, Item);
// Sinopsis
Item := GetLine(Page, 'SINOPSIS', '<hr', 0);
if Item <>'' then
SetField(fieldDescription, Trim (Item));
// Comentarios
LineNr := FindLine('Interpretación:', Page, 0);
if LineNr = -1 then
LineNr := FindLine('Intervención:', Page, 0);
if LineNr = -1 then
LineNr := FindLine('Personajes', Page, 0);
if LineNr = -1 then
LineNr := FindLine('Genero:', Page, 0);
if LineNr = -1 then
LineNr := FindLine('Duración:', Page, 0);
if LineNr = -1 then
LineNr := FindLine('Año:', Page, 0);
if LineNr = -1 then
LineNr := FindLine('Dirección:', Page, 0);
LineNr := LineNr +1;
LineEnd := FindLine('<hr', Page, LineNr);
Line := '';
for LineNr := FindLine('<br>', Page, LineNr)+1 to LineEnd do
Line := Line + Page.GetString(LineNr);
Item := StringReplace(Line, '<br>', #11);
Item := DeleteTags(Item);
HTMLDecode(Item);
Item := StringReplace(Item,#11, #13#10);
if Item <>'' then
Comments := Comments + Trim(Item) + #13#10;
// Guión
if Pos('Guión', Comments) = 0 then
begin
LineNr := FindLine('Guión:', Page, 0);
if LineNR = -1 then
LineNr := FindLine('guión:', Page, 0);
if LineNr <> -1 then
begin
Line := '';
while TRUE do
begin
LineNr := LineNr + 1;
Line := Line + Page.GetString(LineNr);
if pos('<br>', Line)> 0 then
break;
end;
Item := TextBetween (Line, 'Verdana">', '<');
Item := DeleteTags(Item);
HTMLDecode(Item);
Item := StringReplace(Item, '.', '');
if Item <>'' then
Comments := 'Guión: '+ Trim(Item) + #13#10 + Comments;
end
end;
// Web oficial:
LineNr := FindLine('Web oficial', Page, 0);
if LineNr <> -1 then
begin
Line := Page.GetString(LineNr+1)+ Page.GetString(LineNr+2);
Item := TextBetween (Line, 'href="', '"');
Item := DeleteTags(Item);
HTMLDecode(Item);
if Item <>'' then
Comments := Comments + 'Web oficial: '+ Trim(Item) + #13#10;
end;
SetField(fieldComments, Comments);
// Cartel
LineNr := FindLine('href="http://www.cartelia.net/', Page, 0);
if LineNr <> -1 then
begin
Line := Page.GetString(LineNr)+ Page.GetString(LineNr+1);
Address:= TextBetween (Line, 'href="', '"');
Page.Text := GetPage(Address);
LineNr := FindLine('width="400" height=', Page, 0);
if LineNr<>-1 then
begin
Line := Page.GetString(LineNr-1) + Page.GetString(LineNr);
Item := 'http://www.cartelia.net/' + TextBetween (Line, '"../', '"');
GetPicture(Item );
end;
end
else
begin
LineNr := FindLine('alt="cartel"', Page, 0);
if LineNr<> -1 then
begin
Line := Page.GetString(LineNr);
if Pos('jpg', Line) = 0 then
LineNr := -1;
end;
if LineNr = -1 then
LineNr := FindLine('width="160" height=', Page, 0);
if LineNr = -1 then
LineNr := FindLine('width="150" background=', Page, 0);
if LineNr = -1 then
LineNr := FindLine('width="150" height=', Page, 0);
if LineNr<>-1 then
begin
Line := Page.GetString(LineNr-1) + Page.GetString(LineNr);
Item := TextBetween (Line, '"../../', '"');
if Item = '' then
begin
Item := TextBetween (Line, 'background="', '"');
LineNr := FindLine('href="http://www.labutaca.net/', Page, 0);
if LineNr <> -1 then
begin
Line := Page.GetString(LineNr);
Item := TextBetween (Line, 'href="', '"') + '/'+ Item;
GetPicture(Item );
end;
end
else
begin
Item := 'http://www.labutaca.net/' + Item;
GetPicture(Item );
end;
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('La butaca', 'Titulo de la pelicula:', MovieName);
AnalyzePage(UrlEncode('http://www.google.com/custom?num=100&hl=es&rls=GGLD,GGLD:2005-49,GGLD:es&as_epq=' + MovieName + '&lr=lang_es&as_occt=title&as_dt=i&as_sitesearch=www.labutaca.net'));
end.
