(***************************************************
Ant Movie Catalog importation script
www.antp.be/software/moviecatalog/
[Infos]
Authors=Fulvio53s03
Title=Libreria Universitaria Film -
Description=Estrae info film da libreriauniversitaria.it
Site=www.libreriauniversitaria.it
Language=IT
Version=1.0.0 - 15. 8.2010
Requires=3.5.0
Comments=
License=
GetInfo=1
[Options]
***************************************************)
program Film;
uses
StringUtils1;
var
MovieName: string;
TheMovieAddress: string;
UrlSearch, InitSearch, EndSearch, Pagestr: string;
comm: String;
const
crlf = #13#10; // carriage return/line feed
virgolette = #187;
procedure AnalyzePage(Address: string);
var
Line: string;
LineNr: integer;
BeginPos: integer;
begin
Pagestr := GetPage(Address);
// SavePage := Pagestr;
SetField(fieldURL, Address);
Line := TextBetween(Pagestr, 'Risultati da', 'della ricerca');
LineNr := Length(Line);
if LineNr = 0 then
begin
SetField(fieldURL, Address);
AnalyzeMoviePage;
end
else
begin
PickTreeClear;
PickTreeAdd('Risultati ricerca per "' + StringReplace(MovieName, '+', ' ') + '":', '');
AddMoviesTitles;
if TheMovieAddress='' then
begin
if PickTreeExec(Address) then
AnalyzePage(Address);
end
else
begin
SetField(fieldURL, MovieAddress);
Page.Text := GetPage(Address); //Page.Text := GetPage(TheMovieAddress);
AnalyzeMoviePage;
end;
end;
end;
procedure AnalyzeMoviePage; //estrae campi dalla pagina del libro scelto
var
SavePage, SaveLine, Line, Value, PreviousLine, NomeHtml, sTemp: string;
LineNr, LengthLine: Integer;
BeginPos, EndPos, Field: Integer;
BeginDiv, EndDiv: Integer;
LengthDiv: Integer;
InCatalogo: string;
BeginChar, EndChar: string;
SaveCommento, Commento: string;
BeginLineNr, endLineNr: Integer;
begin
Pagestr := TextBetween(Pagestr, '
', 'Recensioni degli utenti
');
SavePage := Pagestr;
if length(Pagestr) > 0 then
begin
SetField(fieldDate, DateToStr(Date));
// Titolo Tradotto
Line := TextBetween(Pagestr, '', '
'); // Titolo tradotto
HTMLRemoveTags(Line);
HTMLDecode(Line);
Line := Fulltrim(Line);
setfield(FieldTranslatedTitle, Line);
Line := TextBetween(Pagestr, '', '
'); //trama
HTMLRemoveTags(Line);
HTMLDecode(Line);
Line := Fulltrim(Line);
setfield(FieldDescription, Line);
Line := TextBetween(Pagestr, 'Attori: ', ''); //Cast
HTMLRemoveTags(Line);
HTMLDecode(Line);
Line := Fulltrim(Line);
if Length(Line) > 0 then
setfield(FieldActors, Line);
Line := TextBetween(Pagestr, 'Anno produzione: ', ''); // anno di produzione
HTMLRemoveTags(Line);
HTMLDecode(Line);
Line := Fulltrim(Line);
if Length(Line) > 0 then
setfield(FieldYear, Line);
Line := TextBetween(Pagestr, 'Produttore: ', ''); // produtore
HTMLRemoveTags(Line);
HTMLDecode(Line);
Line := Fulltrim(Line);
if Length(Line) > 0 then
setfield(FieldProducer, Line);
Line := TextBetween(Pagestr, 'Genere: ', ''); // genere
HTMLRemoveTags(Line);
HTMLDecode(Line);
Line := Fulltrim(Line);
if Length(Line) > 0 then
setfield(FieldCategory, Line);
Line := TextBetween(Pagestr, 'Nazione: ', ''); // Nazione
HTMLRemoveTags(Line);
HTMLDecode(Line);
Line := Fulltrim(Line);
if Length(Line) > 0 then
setfield(FieldCountry, Line);
Line := TextBetween(Pagestr, 'Durata: ', ''); // Durata
HTMLRemoveTags(Line);
HTMLDecode(Line);
Line := Fulltrim(Line);
delete(Line, length(Line), 1);
if Length(Line) > 0 then
setfield(FieldLength, Line);
end;
//****** inizio estrazione commenti - eliminato. per ripristinare prendere versione script per i libri ****************
//fulvio estrazione-commenti;
//**************************************** fine estrazione commenti ******************************
// Picture import // per non trovato??????
Line := TextBetween(Pagestr, '', '/td>');
Line := TextBetween(Line, 'src="', '" height="240"'); // Extract the picture URL from "Page"
HTMLRemoveTags(Line);
HTMLDecode(Line);
// setfield(FieldURL, Line);
GetPicture(Line);
end;
procedure AddMoviesTitles;
var
LghtMovieTitle, LgthLine, LineNr, LineBegin, LineEnd: Integer;
Line, InitString, EndString: string;
MovieTitle, MovieAddress, Editor, year, MovieAuthor, Newmovietitle: string;
BeginChar: string;
BeginPos, EndPos: Integer;
begin
TheMovieAddress := '*';
LineNr := 0;
InitString := '';
Pagestr := TextBetween(Pagestr, InitString, EndString);
Line := TextBetween(Pagestr, ' | ', '
');
while length(Line) > 0 do
begin
LgthLine := length(Line);
BeginChar := ''); // regista
MovieAuthor := TextBetween(MovieAuthor, 'title="', '"');
HTMLRemoveTags(MovieAuthor);
HTMLDecode(MovieAuthor);
MovieAuthor := FullTrim(MovieAuthor);
MovieTitle := MovieTitle + ' (' + MovieAuthor + ')';
if LghtMovieTitle > 6 then
PickTreeAdd(Movietitle, MovieAddress);
//fulvio TheMovieAddress := '*';
Delete(Pagestr, 1, (lgthLine - 1));
Line := TextBetween(Pagestr, '', '
');
end;
if TheMovieAddress='*' then TheMovieAddress := '';
end;
procedure estrazionecommenti;
begin
BeginLineNr := FindLine('
', Page, 0); // inizio estrazione commenti
EndLineNr := FindLine('
', Page, BeginLinenr); // fine estrazione commenti
Line := '';
While BeginLineNr <= EndLineNr do
begin
Line := Line + Page.GetString(BeginLineNr); // inizio estrazione commenti
beginLineNr := BeginLineNr + 1;
end;
LengthLine := length(Line);
SaveCommento := '';
BeginDiv := Pos(' '' do
begin
EndDiv := Pos('
', Line) + Length(''); // lunghezza della divisione
EndPos := Pos(EndChar, Line);
delete(Line, 1, Endpos - 1);
LengthLine := length(Line);
HTMLRemoveTags(Commento);
HTMLDecode(Commento);
// Commento := Fulltrim(Commento);
SaveCommento := SaveCommento + Commento + ' ';
BeginChar := '
';
EndChar := '';
Commento := TextBetween(Line, BeginChar, EndChar); // 2
EndPos := Pos(EndChar, Line);
delete(Line, 1, Endpos - 1);
LengthLine := length(Line);
HTMLRemoveTags(Commento);
HTMLDecode(Commento);
// Commento := Fulltrim(Commento); // appena ripristinato
SaveCommento := SaveCommento + Commento;
BeginChar := '';
EndChar := '';
Commento := TextBetween(Line, BeginChar, EndChar); // 3
EndPos := Pos(EndChar, Line);
delete(Line, 1, Endpos - 1);
LengthLine := length(Line);
HTMLRemoveTags(Commento);
HTMLDecode(Commento);
Commento := Fulltrim(Commento);
SaveCommento := SaveCommento + Commento + ' - ';
BeginChar := '>leggi tutte le sue recensioni
'; // estrae commento esteso
EndChar := '