Rusian info + pictures
Code: Select all
// GETINFO SCRIPTING
// Imports movies info (RU) with picture from Friends-Forum.com
program FriendsForum;
const
BaseAddress = 'http://www.friends-forum.com/';
var
MovieName: string;
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
ID, FilmName, Line: String;
Page: TStringList;
FilmPage: TStringList;
BeginPos, EndPos, Lines: Integer;
begin
Page := TStringList.Create;
Page.Text := GetPage(Address);
BeginPos := FindLine('<TH bgcolor="#FF9900"><font class=A_white>О Фильме</font></TH></tr>', Page,0);
EndPos := FindLine('добавить в мой каталог', Page,0);
if BeginPos> 0 then
begin
Line:='';
for Lines := BeginPos+1 to EndPos do //Получение строк с названиями и адресами
Line:=Line+Page.GetString(Lines);
PickTreeClear; //Очистка дерева фильмов
PickTreeAdd('Поиск по слову: ' + MovieName, '');
repeat
BeginPos := Pos('<td align=center><A HREF="modules.php?name=Movie_News&file=preview&id',Line);
If BeginPos>0 Then
Begin
Delete(Line,1,BeginPos); //Удаление начала
BeginPos:=26;
EndPos := Pos('"><center><b>',Line);
ID := copy(Line, BeginPos, EndPos - BeginPos); //Получить адрес страницы фильма
BeginPos := Pos('"><center><b>',Line)+12;
Delete(Line,1,BeginPos);
BeginPos := 1;
EndPos := Pos('</b></A><br>',Line)-1;
FilmName := Copy(Line, BeginPos, EndPos); //Получить название фильма
FilmName := StringReplace(FilmName,' ',' ');
PickTreeAdd(FilmName, BaseAddress + ID);
end;
until BeginPos < 1;
end;
If PickTreeExec(Address) Then
AnalyzeMoviePage(Address);
end;
procedure AnalyzeMoviePage(Address: String); //Получение информации о выбраном фильме
var
Page: TStringList;
LineNr : Integer;
Line, Value : String;
BeginPos, EndPos : Integer;
begin
Page := TStringList.Create;
Page.Text := GetPage(Address);
SetField(fieldURL,Address); //Получение URL
BeginPos := FindLine('> » Информация о фильме', Page,0);
EndPos := FindLine('Рейтинг пользователей</a>:</B>', Page,0);
Line:='';
for LineNr := BeginPos to EndPos do //Получить строки с информацией
Line:=Line+Page.GetString(LineNr);
Value := ''; //импорт картинки
BeginPos := Pos('<IMG SRC="',Line)+10;
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := pos('">', Line);
if copy(Line, BeginPos, 1) = '/' then
Value := 'http://www.friends-forum.com/';
Value := Value + copy(Line, BeginPos, EndPos - BeginPos);
GetPicture(Value, False);
BeginPos := Pos('<B>Название:</B>',Line)+16; //переведенное название
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' </TD></TR>',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldTranslatedTitle,Value);
BeginPos := pos('Оригинальное название', Line)+26; //оригинальное название
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' </TD></TR>',Line);;
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldOriginalTitle, Value);
BeginPos := pos('выхода', Line)+10; //год
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := BeginPos+5;
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldYear, Value);
BeginPos := pos('Жанр', Line)+9; //жанр
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' </TD></TR>',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldCategory, Value);
BeginPos := pos('Режиссер', Line)+13; //режиссер
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' </TD></TR>',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldDirector, Value);
BeginPos := pos('ролях', Line)+10; //в ролях
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' </TD></TR>',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldActors, Value);
BeginPos := pos('фильме', Line)+11; //О фильме
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' </TD></TR>',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldDescription,Value);
BeginPos := pos('Выпущено', Line)+13; //студия (продюсер)
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' </TD></TR>',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldProducer, Value);
BeginPos := pos('Язык', Line)+9; //язык
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' </TD></TR>',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldLanguages, Value);
BeginPos := pos('Примечания', Line)+15; //коментарии
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos('</td></tr>',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldComments, Value);
BeginPos := Pos('Рейтинг пользователей</a>:</B>',Line)+31; //рейтинг (качество)
EndPos := Pos(' / 10 (',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
Value := Trim(Left(StringReplace(Value, '.', ' '),2));
Value := IntToStr(StrToInt(Value,0));
SetField(fieldRating,Value);
DisplayResults;
end;
begin
MovieName := GetField(fieldOriginalTitle);
if MovieName = '' then
MovieName := GetField(fieldTranslatedTitle);
if Input('Поиск на Friends-Forum.com', 'Введите название фильма:', MovieName) then
AnalyzePage('http://www.friends-forum.com/modules.php?name=Movie_News&file=index&orderfield=&direct=&pagenum=&searchterm='+UrlEncode(MovieName)+'&category=%C2%F1%E5&vlang=&let=&rezhiser=&artist=&format=%C2%F1%E5&kachestvo=%C2%F1%E5&storynum=100');
end.