(***************************************************
Ant Movie Catalog importation script
www.antp.be/software/moviecatalog/
[Infos]
Authors=Sonya
Title=www.datacd.ru
Description=Позволяет скачивать автоматом описания фильмов с datacd.ru
Site=newsonya.narod.ru
Language=RU
Version=1.0
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 datacd;
const
BaseAddress = 'http://www.datacd.ru/';
content = 'application/x-www-form-urlencoded';
var
MovieName: string;
URL : string;
SearchParams : string;
function ParseURL(Text:String):String;
var
BeginPos : Integer;
EndPos : Integer;
Value : String;
begin
repeat
BeginPos := Pos('',Text);
If BeginPos > 0 Then
Begin
EndPos := Pos('',Text);
Value := copy(Text, BeginPos, EndPos - BeginPos);
Value := StringReplace(Value,'
',', ');
Value := StringReplace(Value,'
',', ');
HTMLRemoveTags(Value);
Delete(Text,1,EndPos);
If Length(result)>0 Then
result := result + ', ' + Value
else
result := Value;
end;
until BeginPos < 1;
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; Params: string);
var
ID, FilmName, Line: String;
Page: TStringList;
FilmPage: TStringList;
BeginLinePos, BeginPos, EndPos: Integer;
forceHTTP11: boolean;
forceEncodeParams: boolean;
begin
Page := TStringList.Create;
// FilmName := UrlEncode(Params);
forceHTTP11 := true;
forceEncodeParams := true;
SearchParams := 'search=' + MovieName + '&go.x=7&go.y=6';
Page.Text := PostPage2(URL, SearchParams, content, BaseAddress, forceHTTP11, forceEncodeParams);
BeginLinePos := FindLine('Результат поиска', Page,0);
PickTreeClear; //Очистка дерева фильмов
PickTreeAdd('Поиск по слову: ' + MovieName, '');
if BeginLinePos> 0 then
begin
repeat
//Вывод фильмов в дерево
Line:= Page.GetString(BeginLinePos+2); //Получить строку с адресами
// Page.SaveToFile('f:\page.html'); //!Отладка
BeginPos := Pos('a href=''about.php?id=',Line);
If BeginPos>0 Then
Begin
Delete(Line,1,BeginPos); //Удаление начала
BeginPos := 8;
EndPos := Pos('''>',Line);
ID := copy(Line, BeginPos, EndPos - BeginPos); //Получить адрес (номер) страницы
BeginPos := EndPos + 2;
Delete(Line,1,BeginPos); //Удаление до названия
BeginPos := 1;
EndPos := Pos('',Line)-1;
FilmName := Copy(Line, BeginPos, EndPos); //Получить название для выбора
FilmName := StringReplace(FilmName,' ',' ');
PickTreeAdd(FilmName, BaseAddress + ID);
BeginLinePos := BeginLinePos + 4;
end;
until BeginPos < 1;
end;
If PickTreeExec(Address) Then
AnalyzeMoviePage(Address); //Проанализировать страницу с фильмом
// AnalyzeMoviePage('http://localhost/testpage.html'); //Проанализировать тестовую страницу с фильмом
end;
procedure AnalyzeMoviePage(Address: String);
var
Page: TStringList;
LineNr : Integer;
Line, Value : String;
BeginPos, EndPos : Integer;
begin
Page := TStringList.Create;
Page.Text := GetPage(Address);
// Page.SaveToFile('f:\page.txt'); //!Отладка
// URL
SetField(fieldURL,Address); // Запоминаем URL страницы фильма
// Рейтинг фильма
LineNr := FindLine('', Page, 0);
if LineNr > -1 then
begin
Line := Page.GetString(LineNr+1);
BeginPos := Pos('/10',Line)-4;
EndPos := BeginPos+3;
Value := copy(Line, BeginPos, EndPos - BeginPos);
HTMLDecode(Value);
HTMLRemoveTags(Value);
SetField(fieldRating,Value);
end;
// Переведёное название
LineNr := FindLine('Название:', Page, 0);
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
BeginPos := Pos('Название:',Line)+16;
Delete(Line,1,BeginPos); //Стереть начало строки
BeginPos := 1;
EndPos := Pos('',Line)-1;
Value := Copy(Line, BeginPos, EndPos);
SetField(fieldTranslatedTitle,Value);
end;
// Оригинальное название
LineNr := FindLine('Оригинальное название:', Page, 0);
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
BeginPos := Pos('Оригинальное название:',Line)+29;
Delete(Line,1,BeginPos); //Стереть начало строки
BeginPos := 1;
EndPos := Pos('',Line)-1;
Value := Copy(Line, BeginPos, EndPos);
SetField(fieldOriginalTitle, Value);
end;
// Год выхода
LineNr := FindLine('Год выхода:', Page, 0);
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
BeginPos := Pos('Год выхода:',Line)+18;
Delete(Line,1,BeginPos); //Стереть начало строки
BeginPos := 1;
EndPos := Pos('',Line)-1;
Value := Copy(Line, BeginPos, EndPos);
SetField(fieldYear, Value);
end;
// Режиссёр:
LineNr := FindLine('Режиссер:', Page, 0);
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
BeginPos := Pos('Режиссер:',Line)+16;
Delete(Line,1,BeginPos); //Стереть начало строки
BeginPos := 1;
EndPos := Pos('',Line)-1;
Value := Copy(Line, BeginPos, EndPos);
SetField(fieldDirector, Value);
end;
// Продюсер:
LineNr := FindLine('Продюсер:', Page, 0);
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
BeginPos := Pos('Продюсер:',Line)+16;
Delete(Line,1,BeginPos); //Стереть начало строки
BeginPos := 1;
EndPos := Pos('',Line)-1;
Value := Copy(Line, BeginPos, EndPos);
SetField(fieldProducer, Value);
end;
// Жанр
LineNr := FindLine('Жанр:', Page, 0);
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
BeginPos := Pos('Жанр:',Line)+12;
Delete(Line,1,BeginPos); //Стереть начало строки
BeginPos := 1;
EndPos := Pos('',Line)-1;
Value := Copy(Line, BeginPos, EndPos);
SetField(fieldCategory, Value);
end;
// Продолжительность
LineNr := FindLine('Продолжительность:', Page, 0);
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
BeginPos := Pos('Продолжительность:',Line)+25;
Delete(Line,1,BeginPos); //Стереть начало строки
BeginPos := 1;
EndPos := Pos('',Line)-5;
Value := Copy(Line, BeginPos, EndPos);
SetField(fieldLength, Value);
end;
// Страна:
LineNr := FindLine('Страна:', Page, 0);
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
BeginPos := Pos('Страна:',Line)+14;
Delete(Line,1,BeginPos); //Стереть начало строки
BeginPos := 1;
EndPos := Pos('',Line)-1;
Value := Copy(Line, BeginPos, EndPos);
SetField(fieldCountry, Value);
end;
// В главных ролях
LineNr := FindLine('В главных ролях:', Page, 0);
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
BeginPos := pos('В главных ролях:', Line)+23;
EndPos := Pos('Затраты:',Line);
Value := Copy(Line, BeginPos, EndPos - BeginPos);
HTMLDecode(Value);
HTMLRemoveTags(Value);
SetField(fieldActors, Value);
end;
// Краткое содержание
LineNr := FindLine('Краткое содержание:', Page, 0); //Начало строки описания
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
BeginPos := pos('Краткое содержание:', Line)+26;
EndPos := Pos('В главных ролях:',Line);
Value := Copy(Line, BeginPos, EndPos - BeginPos);
HTMLDecode(Value);
HTMLRemoveTags(Value);
SetField(fieldDescription,Value);
end;
// Картинка
LineNr := FindLine('img src=''bigimage.php?', Page, 0); //Начало строки с рисунком
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
BeginPos := Pos('img src=''bigimage.php?',Line);
Delete(Line,1,BeginPos+8); //Стереть начало строки
BeginPos := 1;
EndPos := pos(' alt=', Line)-1;
Value := copy(Line, BeginPos, EndPos - BeginPos);
Address := BaseAddress+Value;
If Value <> 'foto/logo.gif' Then
begin
// GetPicture(Address);
end;
end;
//DisplayResults;
end;
begin
URL := BaseAddress + 'search.php';
// URL := 'http://localhost/search.html';
MovieName := GetField(fieldOriginalTitle);
if MovieName = '' then
MovieName := GetField(fieldTranslatedTitle);
if Input('Import from DVDSpecial', 'Enter the title of the movie:', MovieName) then
AnalyzePage(URL, MovieName);
end.