antp.be forum

Code: Select all

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

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

[Infos]
Authors=gilistico
Title=Cover Caratulas (ES)
Description= Movie covers importation script for Cover caratulas (Spain)
Site=www.covercaratulas.com
Language=ES
Version=1.2
Requires=3.5.0
Comments= 
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 covercaratulas;

var
  
	MovieName: string;
        Prodid: string;

const
	UrlBase1 = 'http://www.covercaratulas.com/buscador-de-caratulas.html';
	UrlBase2 = 'tipo=dvd&lupa.x=35&lupa.y=18&busca=';


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

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; 
   Resultados: string;
   Pagina: Integer;
   i: integer;
   Item: String;

begin 
	Page      := TStringList.Create; 
	Page.Text := PostPage(UrlBase1,Address);

	LineNr := FindLine('<b>No ha sido posible encontrar resultado', Page, 0); 
	if LineNr <> -1 then 
	begin 
      		ShowMessage('Titulo no encontrado.'); 
        	Page.Free; 
      		exit;    
   	end; 

  
	PickTreeClear; 
	Count  := 0; 
	LineNr := 0; 
	Resultados := '';
	Pagina := 1;

	While TRUE do 
	begin 

	      	LineNr := FindLine('<font class="title123"><b>¬ ', Page, LineNR+1); 
      		if LineNr = -1 then 
			break;
		DirURL := 'http://www.covercaratulas.com/'+ GetLine(LineNr, Page, 'href="', '"');
		Title  := GetLine(LineNr, Page, '<font class="title123"><b>¬ ', '</a>');

        	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 
	begin
		// Read page ---- NEED Getpage() with cookies
		Page.Text := GetPage(Address,);   
	      	LineNr := FindLine('.jpg"', Page, 0); 
		if LineNr  <> -1 then
		begin
			Line :=  Page.GetString(LineNr);
			ShowMessage(Line);
			//DirURL := TextBetween (Line, 'http://www.covercaratulas.com/', '"');
			//ShowMessage(DirURL);
			//DirURL := 'http://www.covercaratulas.com/'+ DirURL;
			//GetPicture(DirURL);
		end;
	end;

   	Page.Free; 

end; 



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

function  GetLine(LineNR: Integer; Page: TStringList; TextoBusqueda1: string;  TextoBusqueda2: string): string;
var

  	Item:     string;
  	Line:     string;
	LineNr1:   Integer;
	LineNr2:   Integer;
begin
	
	LineNr1 := FindLine(TextoBusqueda1, Page, LineNR);
	LineNr2 := FindLine(TextoBusqueda2, Page, LineNr1);

	if (LineNr1 = -1) OR (LineNr2 = -1) then
	begin
		result := '';
	end
	else
	begin
		Line :=  Page.GetString(LineNr1);
		Line := TextoBusqueda1 + TextBetween (Line, TextoBusqueda1,  '</html>');

		while TRUE do
		begin
			LineNr1 := LineNr1 + 1;
			Line := Line + Page.GetString(LineNr1);
 			if pos(TextoBusqueda2, Line) > 0 then
				break;
		end;


		Item := TextBetween (Line, TextoBusqueda1,  TextoBusqueda2);
		Item := DeleteTags(Item);
		HTMLDecode(Item);
		result := Item;
	end;
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('Cover Caratulas', 'Titulo de la pelicula:', MovieName);

	AnalyzePage(UrlBase2 + UrlEncode(MovieName));


end.