Ho aggiornato gli indirizzi di riferimento, ma manca ancora qualcosa....
Grazie e buona serata.
Code: Select all
program Terminalvideo;
uses
StringUtils7552;
var
MovieName: string;
TheMovieAddress: string;
idx: integer;
const
//DebugPath = 'd:\';
BaseURL = 'http://www.terminalvideo.com';
QueryURL = BaseUrl + '/catalogsearch/result/?order=relevance&dir=desc&q=';
PicURLa = 'http://www.terminalvideo.com/images/articles/lrg/';
PicURLb = '/img_';
// http://www.terminalvideo.it/images/articles/lrg/47/img_85047_lrg.jpg')
//http://www.terminalvideo.com/catalogsearch/result/?order=relevance&dir=desc&q=lupin&cat=8
// ---
function Capitalize (str: string): string;
begin
str := AnsiLowerCase(str);
str := AnsiMixedCase(str, ' -/''');
Result := str;
end;
// ---
function Space2Html(Url: string): string;
var
Temp : string;
SpacePos : Integer;
begin
repeat
SpacePos := pos(' ', Url);
if SpacePos <> 0 then
begin
Temp := copy(Url, 1, SpacePos - 1);
Delete(Url, 1, SpacePos);
Temp := Temp + '%20' + Url;
Url := Temp;
end;
until pos(' ', Url) = 0;
result := Url;
end;
// ---
function RemoveExtraChars(InStr: string): string;
var
Temp: string;
PackedStr: string;
CharPos: Integer;
n: Integer;
begin
PackedStr := InStr;
repeat
CharPos := pos(' ', PackedStr);
if CharPos = 0 then
CharPos := pos(#9, PackedStr);
if CharPos <> 0 then
begin
Temp := copy(PackedStr, 1, CharPos - 1);
Delete(PackedStr, 1, CharPos);
PackedStr := Temp + PackedStr;
end;
until((pos(' ', PackedStr) = 0) and (pos(#9, PackedStr) = 0));
result := PackedStr;
end;
// ---
// Analisi ed estrazione dati dalla pagina del film
procedure AnalyzeMoviePage(Page: TStringList);
var
Line, Line2, Line3: string;
MovieID, sDisk, sType, LastTwoMovieID: string;
LineNr, LineEnd: Integer;
BeginPos, EndPos: Integer;
begin
// Immagine
LineNr := FindLine('<p><A href="/tvweb/applications/imgBig.aspx?ART_Id=', Page, 0);
if LineNr>-1 then
begin
Line := Page.GetString(LineNr);
BeginPos := pos('ART_Id=', Line);
Delete (Line, 1, BeginPos+6);
EndPos := pos('>', Line);
MovieID := Copy(Line, 1, EndPos-3);
LastTwoMovieID := Copy(Line, EndPos-4, 2);
Line := PicURLa + LastTwoMovieID + PicURLb + MovieID + '_lrg.jpg';
// ShowMessage(Line);
GetPicture(Line);
end;
// Durata
LineNr := FindLine('<font size="2">Durata <strong>', Page, 0);
if LineNr>-1 then
begin
LineNr := LineNr + 1;
Line := Trim(RemoveExtraChars(Page.GetString(LineNr)));
SetField (fieldLength, Line);
end;
// Colore
Line := '';
LineNr := FindLine('<font size="2">Colore <strong>', Page, 0);
if LineNr>-1 then
begin
LineNr := LineNr + 1;
Line := Trim(RemoveExtraChars(Page.GetString(LineNr)));
end;
// Formato Video
LineNr := FindLine('<font size="2">Formato video<strong>', Page, 0);
if LineNr>-1 then
begin
LineNr := LineNr + 1;
Line2 := Trim(RemoveExtraChars(Page.GetString(LineNr)));
if Line <> '' then
Line := Line + ' - ';
Line := Line + Line2;
end;
// Sistema
LineNr := FindLine('<font size="2">Sistema <strong>', Page, 0);
if LineNr>-1 then
begin
LineNr := LineNr + 1;
Line2 := Trim(RemoveExtraChars(Page.GetString(LineNr)));
if Line <> '' then
Line := Line + ' - ';
Line := Line + Line2;
end;
// Codifica
LineNr := FindLine('<font size="2">Codifica <strong>', Page, 0);
if LineNr>-1 then
begin
LineNr := LineNr + 1;
Line2 := Trim(RemoveExtraChars(Page.GetString(LineNr)));
if Line <> '' then
Line := Line + ' - ';
Line := Line + Line2;
end;
SetField (fieldVideoFormat, Line);
// Doppiaggio
LineNr := FindLine('<font size="2">Lingue', Page, 0);
if LineNr>-1 then
begin
Line := '';
LineEnd := FindLine('<!-- end ShowDoppiato; -->', Page, LineNr);
repeat
LineNr := FindLine('<strong>', Page, LineNr) + 1;
Line2 := Trim(RemoveExtraChars(Page.GetString(LineNr)));
if Line <> '' then
Line := Line + ', ';
Line := Line + Line2;
until FindLine('<strong>', Page, LineNr) > LineEnd;
SetField (fieldLanguages, Line);
end;
// Sottotitoli
LineNr := FindLine('<font size="2">Sottotitoli', Page, 0);
if LineNr>-1 then
begin
Line := '';
LineEnd := FindLine('<!-- end ShowSottotitolato; -->', Page, LineNr);
repeat
LineNr := FindLine('<strong>', Page, LineNr) + 1;
Line2 := Trim(RemoveExtraChars(Page.GetString(LineNr)));
if Line <> '' then
Line := Line + ', ';
Line := Line + Line2;
until FindLine('<strong>', Page, LineNr) > LineEnd;
SetField (fieldSubtitles, Line);
end;
// Audio
LineNr := FindLine('<font size="2">Audio <strong>', Page, 0);
if LineNr>-1 then
begin
LineNr := LineNr + 1;
Line := Trim(RemoveExtraChars(Page.GetString(LineNr)));
SetField (fieldAudioFormat, Line);
end;
// Dischi e Tipo
LineNr := FindLine('<td class="titolo">', Page, 0);
if LineNr>-1 then
begin
Line := Trim(RemoveExtraChars(Page.GetString(LineNr)));
HTMLRemoveTags(Line);
BeginPos := LastPos ('(', Line) + 1;
EndPos := LastPos (')', Line);
Line := copy (Line, BeginPos, EndPos - BeginPos);
BeginPos := pos(' ',Line);
EndPos := Length(Line) - BeginPos;
sDisk := copy (Line, 1, BeginPos - 1);
if Length(Trim(sDisk))=0 then
begin
SetField (fieldDisks, '1');
LineNr := FindLine('Supporto:', Page, 0);
if LineNr>-1 then
begin
Line:=Trim(RemoveExtraChars(Page.GetString(LineNr+2)));
BeginPos := LastPos ('>', Line);
sType := copy (Line, BeginPos + 1, Length(Line)-BeginPos);
SetField (fieldMediaType, ANSIUpperCase(sType));
end;
end
else
begin
sType := copy (Line, BeginPos + 1, EndPos);
SetField (fieldDisks, sDisk);
SetField (fieldMediaType, ANSIUpperCase(sType));
end;
end;
if GetOption('Capitalizza')=1 then
begin
Line := Trim(RemoveExtraChars(GetField(fieldTranslatedTitle)));
Line := Capitalize(Line);
SetField (fieldTranslatedTitle, Line);
Line := Trim(RemoveExtraChars(GetField(fieldOriginalTitle)));
Line := Capitalize(Line);
SetField (fieldOriginalTitle, Line);
end;
end;
// ---
// Riempie la lista con i film trovati
procedure AddMoviesTitles(Page: TStringList);
var
PrevLine, LineNr: integer;
Line, TempStr: string;
MovieTitle, MovieID: string;
Punta, EndPos: Integer;
begin
TheMovieAddress := '*';
PrevLine := 0;
LineNr := 0;
LineNr := FindLine('><A class=titolo href=',Page,0);
if LineNr > 0 then
begin
repeat
LineNr := FindLine('><A class=titolo href=',Page,PrevLine);
Line := Page.GetString(LineNr);
Line := Line + Page.GetString(LineNr+1);
Line := RemoveExtraChars(Line);
// ShowMessage (Line);
Punta := pos('ART_Id=', Line);
Delete (Line, 1, Punta+6);
EndPos := pos('>', Line);
MovieID := Copy(Line, 1, EndPos-2);
// ShowMessage (MovieID);
Delete (Line, 1, EndPos);
EndPos := pos('<', Line);
MovieTitle := Copy(Line, 1, EndPos-1);
// ShowMessage (MovieTitle);
PickTreeAdd(MovieTitle, QueryURL + MovieID);
PrevLine := LineNr+1;
until(FindLine('><A class=titolo href=',Page,PrevLine)=-1);
end;
end;
// ----
procedure AnalyzePage(Address: string);
var
Page: TStringList;
LineNr: integer;
BeginPos: integer;
begin
Page := TStringList.Create;
Page.Text := GetPage(Address);
idx := 0;
// Page.SaveToFile(debugpath+MovieName+'.lst');
//Page.LoadFromFile(PATHLOG+MOVIE+'.res0');
//AnalyzeMoviePage(Page);
//exit procedure;
LineNr := FindLine('Non è stato trovato <strong>nessun titolo', Page, 0);
if LineNr <> -1 then
begin
ShowError('Nessun film trovato in archivio');
end
else
begin
LineNr := FindLine('<a id="btnNext" class="titolo"', Page, 0);
if LineNr > -1 then
begin
if not ShowWarning('Trovati più di 20 film, verranno visualizzati soltanto i primi 20 titoli.' + #13#10 + 'Desideri continuare?') then
begin
Page.Free;
Exit;
end;
end;
PickTreeClear;
PickTreeAdd('Risultati ricerca per "' + MovieName + '":', '');
AddMoviesTitles(Page);
if PickTreeExec(Address) then
begin
Page.Text := GetPage(Address); // Richiede la pagina del film
AnalyzeMoviePage(Page); // Analizza la pagina del film
end;
end;
Page.Free;
end;
// ----- main()
Var
SearchURL: String;
begin
if CheckVersion(3,5,0) then
begin
MovieName := RemoveArticles(GetField(fieldTranslatedTitle));
if MovieName = '' then
MovieName := RemoveArticles(GetField(fieldOriginalTitle));
if Input('Terminal Video Italia', 'Inserire il titolo del film:', MovieName) then
begin
SearchURL := 'http://www.terminalvideo.com/catalogsearch/result/?order=relevance&dir=desc&q='+(MovieName)+'&cat=8';
//ShowMessage((TheMovieAddress)+'info');
AnalyzePage(SearchURL);
end;
end else
ShowMessage('This script requires a newer version of Ant Movie Catalog (at least version 3.5.0)');
end.