Ant Movie Catalog - [498] :: Программы :: Компьютерный форум Ru.Board

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

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

[Infos]
Authors=Ilya
Title=Friends-Forum.com
Description=Movie importation script for Imports movies info (RU) with picture from Friends-Forum.com
Site=www.friends-forum.com
Language=RU
Version=2.1
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 FriendsForum;
const
BaseAddress = 'http://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('записей найденно</center><', Page,0);
EndPos := FindLine('<a href="http://friends-forum.com/modules.php?name=Movie_News&file=searchtxt">New search', Page,0);
if BeginPos> 0 then
begin
Line:='';
for Lines := BeginPos to EndPos do //Получение строк с названиями и адресами
Line:=Line+Page.GetString(Lines);
PickTreeClear; //Очистка дерева фильмов
PickTreeAdd('Поиск по слову: ' + MovieName, '');
repeat
BeginPos := Pos('>Оригинальное название:',Line);
If BeginPos>0 Then
Begin
Delete(Line,1,BeginPos); //Удаление начала

BeginPos := Pos('":',Line)+29; //Получить название фильма (ориг.)
Delete(Line,1,BeginPos);
BeginPos := 1;
EndPos := Pos(' <B',Line)-1;
FilmName := Copy(Line, BeginPos, EndPos);

BeginPos := Pos('Название:',Line)+12; //Получить название фильма (перевед.)
Delete(Line,1,BeginPos);
BeginPos := 1;
EndPos := Pos(' <B',Line)-1;
FilmName := FilmName + ' / ' + Copy(Line, BeginPos, EndPos);

BeginPos := Pos('выхода:',Line)+10; //Получить название фильма (год)
Delete(Line,1,BeginPos);
BeginPos := 1;
EndPos := Pos(' <B',Line)-1;
FilmName := FilmName + ' (' + Copy(Line, BeginPos, EndPos) + ')';

BeginPos := Pos('http://friends-forum.com',Line); //Получить адрес страницы фильма
Delete(Line,1,BeginPos);
BeginPos := 1;
EndPos := Pos('</a></td></tr><',Line);
ID := copy(Line, BeginPos, EndPos - BeginPos);

FilmName := StringReplace(FilmName,' ',' ');
PickTreeAdd(FilmName, 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('h' + Address);

BeginPos := FindLine('<TR><td>Оригинальное название:', Page,0);
EndPos := FindLine('<a href="http://friends-forum.com/modules.php?name=Movie_News&file=searchtxt">New search', Page,0);

Line:='';
for LineNr := BeginPos to EndPos do //Получить строки с информацией
Line:=Line+Page.GetString(LineNr);

BeginPos := pos('<TR><td>Оригинальное название:', Line)+36; //оригинальное название
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' ',Line);;
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldOriginalTitle, Value);

BeginPos := Pos('Название:',Line)+12; //переведенное название
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' ',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldTranslatedTitle,Value);

BeginPos := pos('выхода:', Line)+10; //год
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' ',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldYear, Value);

BeginPos := Pos('><a href="',Line)+9; //Получение URL
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos('">',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldURL,Value);

BeginPos := pos('B>Жанр:', Line)+10; //жанр
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' ',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldCategory, Value);

BeginPos := pos('B>Режиссер:', Line)+14; //режиссер
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' ',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldDirector, Value);

BeginPos := pos('ролях:', Line)+9; //в ролях
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' ',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldActors, Value);

BeginPos := pos('фильме:', Line)+10; //О фильме
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' ',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldDescription,Value);

BeginPos := pos('B>Выпущено:', Line)+14; //студия (продюсер)
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' ',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldProducer, Value);

BeginPos := pos('Язык:', Line)+8; //язык
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' ',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldLanguages, Value);

BeginPos := pos('Примечания:', Line)+14; //коментарии
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := Pos(' ',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
SetField(fieldComments, Value);

BeginPos := Pos('пользователей:',Line)+19; //рейтинг (качество)
EndPos := Pos(' / 10 (',Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
Value := Trim(Left(StringReplace(Value, '.', ' '),2));
Value := IntToStr(StrToInt(Value,0));
SetField(fieldRating,Value);

BeginPos := Pos('http',Line)+1;
Delete(Line,1,BeginPos);
BeginPos :=1;
EndPos := pos('</td></', Line);
Value := copy(Line, BeginPos, EndPos - BeginPos);
GetPicture('ht' + Value);

//DisplayResults;
end;

begin
MovieName := GetField(fieldOriginalTitle);
if MovieName = '' then
MovieName := GetField(fieldTranslatedTitle);
if Input('Поиск на Friends-Forum.com', 'Введите название фильма:', MovieName) then
AnalyzePage('http://friends-forum.com/modules.php?name=Movie_News&file=searchtxt&op=viewresults&orderfield=&searchterm='+UrlEncode(MovieName)+'&vlang=&let=');
end.

Модерирует : gyra, Maz
Версия для печати • Подписаться • Добавить в закладки
На первую страницу • к этому сообщению • к последнему сообщению