(*************************************************** Ant Movie Catalog importation script www.antp.be/software/moviecatalog/ [Infos] Authors=Legrad Title=Labutaca (ES) Description= Site=www.labutaca.net Language=ES Version=3.0 Requires=3.5.0 Comments= El script carga todos los datos de www.Labutaca.net el Rating, categoria y duracion los carga de www.imdb.com a traves del mismo enlace de la butaca, la caratula y el titulo original se carga desde www.carteles.metropoliglobal.com a traves del vinculo propio de www.labutaca.net License= GetInfo=1 [Options] ***************************************************) program LabutacaLegrad; var MovieName: string; MovieURL: string; //------------------------------------------------------------------------------------ function UpFirstLetterWord(texto:string):string; var espaco:integer; sst:string; begin texto:=AnsiUpFirstLetter(AnsiLowerCase(texto)); repeat espaco:=Pos(' ',texto); sst:=AnsiUpperCase(Copy(texto,espaco+1,1)); texto:=Copy(texto,1,espaco-1)+'/|\'+sst+Copy(texto,espaco+2,length(texto)); until Pos(' ',texto)=0; texto := StringReplace(texto, '/|\', ' '); if Copy(texto,1,1)=' ' then texto:=Copy(texto,2,length(texto)); result:=texto; end; //------------------------------------------------------------------------------------ function BorraComillas(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 = '''' then c := ' '; t := t + c; end s := t; result := t; 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 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 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, 'Â', ''); result := str1; 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; //------------------------------------------------------------------------------------ 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 ', strPage); if(BeginPos > -1)then begin PickTreeClear; Delete(strPage, 1, BeginPos); BeginPos := Pos('http://www.labutaca.net/', strPage); EndPos := 1; while ((BeginPos > 0) and (EndPos > 0)) do begin Delete(strPage, 1, BeginPos); EndPos := Pos('"', strPage); MovieId := Copy(strPage,+24, EndPos-24); MovieAddr := 'http://www.labutaca.net/' + MovieId; BeginPoss := Pos(')">LA BUTACA - ',strPage); EndPoss := Pos('
', strPage); MovieTitle := Copy(strPage,BeginPoss+2, EndPoss); MovieTitle := TextBetween(MovieTitle , 'BUTACA -', ''); MovieTitle := Caracter(MovieTitle); DeleteTags(MovieTitle); HTMLDecode(MovieTitle); PickTreeAdd(MovieTitle, MovieAddr); BeginPos := Pos('http://www.labutaca.net/', strPage); if(Pos('Todo acerca de Google', strPage) < BeginPos) then BeginPos := -1; PickTreeSort; end; end; PickTreeExec(Address) AnalyzeMoviePage(Address); end; //------------------------------------------------------------------------------- procedure AnalyzeMoviePage(Address: string); var Page: TStringList; LineNr: Integer; LineNr1: Integer; Busca: Integer; Line: string; Line1: string; Item: string; Item1: string; Comments: string; Actors: string; Directors: string; Description: string; test: string; Address1: string; MovieName: string; begin Description := ''; Page := TStringList.Create; Page.Text := GetPage(Address); test := Page.Text; // URL SetField(fieldURL, Address); // Titulo traducido Page.Text := GetPage(Address); LineNr := FindLine('Añade "', Page, 0); if LineNr > 0 then begin Item := copy(Page.Text, pos('Añade "',Page.Text), length(Page.Text)); Item := TextBetween (Item, 'Añade "','"'); DeleteTags (Item); HTMLDecode(Item); Item:=UpFirstLetterWord(Item); SetField(fieldTranslatedTitle, Trim (Item)); end; // Director LineNr := FindLine('Direcci', Page, 0); if LineNr > 0 then begin Item := copy(Page.Text, pos('Direcci',Page.Text), length(Page.Text)); Item := TextBetween (Item, 'face="Verdana"> ', '.'); Item := StringReplace (Item, #13#10, ''); Item := StringReplace (Item, ' ', ' '); DeleteTags (Item); HTMLDecode(Item); Item := StringReplace (Item, ' ', ' '); SetField(fieldDirector, Trim (Item)); end; // Nacionalidad LineNr := FindLine('Direcci', Page, 0); if LineNr > 0 then begin Item := copy(Page.Text, pos('s:',Page.Text), length(Page.Text)); Item := TextBetween (Item, 'face="Verdana"> ', '.'); Item := StringReplace (Item, #13#10, ''); Item := StringReplace (Item, ' ', ''); DeleteTags (Item); HTMLDecode(Item); SetField(fieldCountry, Trim (Item)); end; // Año LineNr := FindLine('Direcci', Page, 0); if LineNr > 0 then begin Item := copy(Page.Text, pos('o:',Page.Text), length(Page.Text)); Item := TextBetween (Item, 'face="Verdana"> ', '.'); Item := StringReplace (Item, #13#10, ''); Item := StringReplace (Item, ' ', ''); DeleteTags (Item); HTMLDecode(Item); SetField(fieldYear, Trim (Item)); end; //Interpretes LineNr := FindLine('Interpretaci', Page, 0); if LineNr > 0 then begin Item := copy(Page.Text, pos('Interpretaci',Page.Text), length(Page.Text)); Item := TextBetween (Item, 'face="Verdana"> ', '.
'); Item := StringReplace (Item, #13#10, ''); Item := StringReplace (Item, ' ', ''); DeleteTags (Item); HTMLDecode(Item); SetField(fieldActors, Trim (Item)); end; // Produccion LineNr := FindLine('Producción:', Page, 0); if LineNr > 0 then begin Item := copy(Page.Text, pos('Producción:',Page.Text), length(Page.Text)); Item := TextBetween (Item, 'face="Verdana"> ', '.'); Item := StringReplace (Item, #13#10, ''); Item := StringReplace (Item, ' ', ' '); DeleteTags (Item); HTMLDecode(Item); Item := StringReplace (Item, ' ', ' '); SetField(fieldProducer, Trim (Item)); end; // Sinopsis LineNr := FindLine('SINOPSIS', Page, 0); if LineNr > 0 then begin Item := copy(Page.Text, pos('SINOPSIS',Page.Text), length(Page.Text)); Item := TextBetween (Item, 'SINOPSIS', '

'); Item := StringReplace (Item, #13#10, ''); Item := StringReplace (Item, ' ', ''); DeleteTags (Item); HTMLDecode(Item); SetField(fieldDescription, Trim (Item)); end; // Comentarios LineNr := FindLine('Interpretación:', Page, 0); if LineNr > 0 then begin Item := copy(Page.Text, pos('Interpretación:',Page.Text), length(Page.Text)); Item := TextBetween (Item, '.
', ''); Item := StringReplace (Item, #13#10, ''); Item := StringReplace (Item, ' ', ''); Item := StringReplace (Item, '
', #13#10); DeleteTags (Item); HTMLDecode(Item); SetField(fieldComments, Trim (Item)); end; //----------------------------------------------------------- // Cargar IMDB LineNr := FindLine('http://spanish.imdb.com/Details?', Page, 0); if LineNr > 0 then begin Item := copy(Page.Text, pos('http://spanish.imdb.com/Details?',Page.Text), length(Page.Text)); Item := TextBetween (Item, 'http://spanish.imdb.com/Details?', '"'); Page := TStringList.Create; Page.Text := GetPage('http://akas.imdb.com/title/tt'+Item); end; // Calificacion IMDB LineNr := FindLine('