//************************************************************************
//************************************************************************
//*** Парсинг информации о фильме с сайта http://www.kino-teatr.ru     *** 
//***                                                                  ***
//*** Автор:   Reset (http://www.videodb.info/forum_ru)                ***
//*** E-Mail:  pvd_ag@mail.ru                                          ***
//************************************************************************

Var
  formattedURL, optTitle, optOrigTitle, optPoster, optAka, optYear, optGenre, optDirector, optScenario, optComposer, optProducer, optActor, optCountry, optStudio, optURL, optReleaseDate, optDescription, optSites, optOperator, optDesigner, pgActors, pgDiscussion, pgReel : Boolean;
  ufPrefix, ufPostfix, ufReleaseDate, ufSites, ufOperator, ufDesigner, ufMakeStudio : WideString;
Const
  Enabled = true; Disabled = false;
  
  Delay = 10;


Const
  pathToConfig        = 'kino-teatr.ru.cfg';   // Полный путь к файлу конфигурации
                                              // Если указано только имя файла, то он должен находиться рядом с базой данных

procedure initOptions ();
Begin
  formattedURL   := true;      // Форматированные ссылки (не влияет на стандартное поле URL, работает только при createLink = true)
                               // true  - из ссылки убирается "http://", "www." и всё после "/",
                               //         остается видимым только домен, но ссылка указывает на полный адрес
                               // false - ссылка подставляется как есть

  ufPrefix       := '';        // Префикс  для имен пользовательских полей
  ufPostfix      := ':';        // Постфикс для имен пользовательских полей (можно добавить ":")

  optTitle       := Enabled ;  // Название
  optOrigTitle   := Enabled ;  // Оригинальное название
  optPoster      := Enabled ;  // Постер
  optAka         := Enabled ;  // Другие названия
  optYear        := Enabled ;  // Год
  optGenre       := Enabled ;  // Жанр
  optDirector    := Enabled ;  // Режиссер
  optProducer    := Enabled ;  // Продюсер
  optScenario    := Enabled ;  // Сценарий
  optComposer    := Enabled ;  // Композитор
  optActor       := Enabled ;  // Актёры
  optCountry     := Enabled ;  // Страна
  optStudio      := Enabled ;  // Студии
  optURL         := Enabled ;  // URL
  optReleaseDate := Enabled ;  // Дата выпуска
  optDescription := Enabled ;  // Описание

  optSites       := Enabled ;  // Сайты
  optOperator    := Enabled ;  // Операторы
  optDesigner    := Enabled ;  // Художники
  
  pgActors       := Disabled;  // Актеры и роли (пока не работает)
  pgDiscussion   := Disabled;  // Обсуждение (пока не работает)
  pgReel         := Disabled;  // Ролик (пока не работает)
  
  // Пользовательские поля
  // Для заполнения этих полей в программе необходимо
  // создать пользовательские поля с названием из кавычек
  // В начало названия необходимо добавить значение поля ufPrefix
  //  в конец - поля ufPostfix
  ufReleaseDate  := 'Премьера (@)'        ;  // Короткий текст
  ufSites        := 'Сайты'               ;  // Memo
  ufOperator     := 'Операторы'           ;  // Memo
  ufDesigner     := 'Художники'           ;  // Memo
  ufMakeStudio   := 'Студии. Производство';  // Memo
End;


//********** Далее находятся переменные, предназначенные для внутреннего использования **********// 
//Const

Const
  //Результаты парсинга
  prError     = 0; 
  prFinished  = 1;
  prList      = 2;
  prListImage = 3;
  prDownload  = 4;

  //Типы работы скрипта
  stMovies = 0;
  stPeople = 1; 
  stPoster = 2;

  //Поля фильма для добавления
  mfURL         = 0;
  mfTitle       = 1;
  mfOrigTitle   = 2;
  mfAka         = 3;
  mfYear        = 4;
  mfGenre       = 5;
  mfCategory    = 6;
  mfCountry     = 7;
  mfStudio      = 8;
  mfMPAA        = 9;
  mfRating      = 10;
  mfTags        = 11;
  mfTagline     = 12;
  mfDescription = 13;
  mfDuration    = 14;
  mfFeatures    = 15;

  //Поля фильма для получения
  gfID          =  1;
  gfTitle       =  2;
  gfOrigTitle   =  3;
  gfYear        =  5;
  gfMPAA        =  6;
  gfURL         =  8;
  gfIMDBRating  =  9;
  gfORating     = 11;
  gfScriptName  = 12;  // gfRatingName
  gfTagLine     = 14;
  gfDescription = 15;
  gfDateAdded   = 17;
  gfResolution  = 21;
  gfGenre       = 44;
  gfCountry     = 45;
  gfCategory    = 46;
  gfActors      = 47;
  gfDirector    = 53;
  gfScenario    = 54;
  gfComposer    = 55;
  gfProducer    = 56;

  //Участники фильмов
  mpActor       = 0;
  mpDirector    = 1;
  mpScenario    = 2;
  mpComposer    = 3;
  mpProducer    = 4;

  //Методы загрузки
  dmGET  = 0;
  dmPOST = 1;

  //Режимы работы с артиклями
  pmNone   = 0;
  pmEnd    = 1;
  pmBegin  = 2;
  pmRemove = 3;

  { MessageBox() Flags }
  MB_OK               = $00000000;
  MB_OKCANCEL         = $00000001;
  MB_ABORTRETRYIGNORE = $00000002;
  MB_YESNOCANCEL      = $00000003;
  MB_YESNO            = $00000004;
  MB_RETRYCANCEL      = $00000005;

  MB_ICONHAND        = $00000010;
  MB_ICONQUESTION    = $00000020;
  MB_ICONEXCLAMATION = $00000030;
  MB_ICONASTERISK    = $00000040;
  MB_USERICON        = $00000080;
  MB_ICONWARNING     = MB_ICONEXCLAMATION;
  MB_ICONERROR       = MB_ICONHAND;
  MB_ICONINFORMATION = MB_ICONASTERISK;
  MB_ICONSTOP        = MB_ICONHAND;

  MB_DEFBUTTON1 = $00000000;
  MB_DEFBUTTON2 = $00000100;
  MB_DEFBUTTON3 = $00000200;
  MB_DEFBUTTON4 = $00000300;

  MB_APPLMODAL   = $00000000;
  MB_SYSTEMMODAL = $00001000;
  MB_TASKMODAL   = $00002000;
  MB_HELP        = $00004000;                          { Help Button }

  MB_NOFOCUS              = $00008000;
  MB_SETFOREGROUND        = $00010000;
  MB_DEFAULT_DESKTOP_ONLY = $00020000;

  MB_TOPMOST    = $00040000;
  MB_RIGHT      = $00080000;
  MB_RTLREADING = $00100000;

  MB_SERVICE_NOTIFICATION      = $00200000;
  MB_SERVICE_NOTIFICATION_NT3X = $00040000;

  MB_TYPEMASK = $0000000F;
  MB_ICONMASK = $000000F0;
  MB_DEFMASK  = $00000F00;
  MB_MODEMASK = $00003000;
  MB_MISCMASK = $0000C000;

  IDOK       =  1;  ID_OK     = IDOK;
  IDCANCEL   =  2;  ID_CANCEL = IDCANCEL;
  IDABORT    =  3;  ID_ABORT  = IDABORT;
  IDRETRY    =  4;  ID_RETRY  = IDRETRY;
  IDIGNORE   =  5;  ID_IGNORE = IDIGNORE;
  IDYES      =  6;  ID_YES    = IDYES;
  IDNO       =  7;  ID_NO     = IDNO;
  IDCLOSE    =  8;  ID_CLOSE  = IDCLOSE;
  IDHELP     =  9;  ID_HELP   = IDHELP;
  IDTRYAGAIN = 10;
  IDCONTINUE = 11;

  // Режимы работы скрипта
  smSearch     = 0;
  smResult     = 1;
  smInfo       = 2;
  smActors     = 3;
  smDiscussion = 4;
  smReel       = 5;
  smPoster     = 6;
  smRobot      = 7;
  smFinished   = 8;

const
 SCRIPT_VERSION = '0.0.0.1'; 
 SCRIPT_NAME    = 'Кино-Театр.РУ';
 SCRIPT_DESC    = '[RU] Импортировать информацию о фильме из Кино-Театр.РУ';
 SCRIPT_LANG    = $19; //Russian
 SCRIPT_TYPE    = stMovies;

 BASE_URL       = 'http://www.kino-teatr.ru';

 RATING_NAME 	  = 'Кино-Театр.РУ';
 SEARCH_STR	    = 'http://www.kino-teatr.ru/search/?text=%s&submit=%ED%E0%E9%F2%E8&movie=on';
 CODE_PAGE   	  = 1251;

var
  Mode         : Byte;
  ExtraLinks   : array [smSearch..smFinished] of WideString;
  LoadPages    : array [smSearch..smFinished] of Boolean;
  Addr         : array [smSearch..smFinished] of WideString;
  optionsInitialized : Boolean;

procedure GetBoolOption (const Data, Name: WideString; var opt: Boolean);
Var
  curPos, endPos: Integer;
  tmp : WideString;
Begin
  if Name = '' then
    Exit;

  curPos := Pos (Name + ' ', Data);
  if curPos = 0 then
    Exit;

  curPos := PosFrom ('=', Data, curPos) + 1;
  endPos := PosFrom (';', Data, curPos);
  if (curPos = 0) Or (endPos = 0) then
    Exit;
  tmp := LowerCase (Trim (Copy (Data, curPos, endPos - curPos)));
  if (tmp = 'true') Or (tmp = 'enabled') then
    opt := true
  else if (tmp = 'false') Or (tmp = 'disabled') then
    opt := false;
End;

procedure GetIntOption (const Data, Name: WideString; var opt: Integer);
Var
  curPos, endPos: Integer;
  tmp : WideString;
Begin
  if Name = '' then
    Exit;

  curPos := Pos (Name + ' ', Data);
  if curPos = 0 then
    Exit;

  curPos := PosFrom ('=', Data, curPos) + 1;
  endPos := PosFrom (';', Data, curPos);
  if (curPos = 0) Or (endPos = 0) then
    Exit;

  tmp := Trim (Copy (Data, curPos, endPos - curPos));
  if tmp = '' then
    Exit;

  opt := StrToInt (tmp);
End;

procedure GetStrOption (const Data, Name: WideString; var opt: WideString);
Var
  curPos  : Integer;
  quoting : Boolean;
  str     : WideString;
Begin
  if Name = '' then
    Exit;

  curPos := Pos (Name + ' ', Data);
  if curPos = 0 then
    Exit;

  curPos := PosFrom ('=', Data, curPos);
  opt := '';
  while (quoting) Or (Data[curPos + 1] <> ';') do
    Begin
    Inc (curPos);
    if (Data[curPos] = '''') And ((Not quoting) Or (Data[curPos + 1] <> '''')) then
      quoting := Not quoting;
    if quoting then str := 'true' else str := 'false';
    if (Data[curPos] = '''') then
      Continue;
    if quoting Or (Data[curPos] <> ' ') then
      opt := opt + Data[curPos];
    End;
  opt := StringReplace (opt, '#13#10', #13#10, true, true, false);
End;

procedure SetUFOption (var opt: WideString);
Begin
  opt := ufPrefix + opt + ufPostfix;
End;

procedure loadOptions ();
Var
  Data : WideString;
Begin
  Data := FileToString (pathToConfig);
  if Data <> '' then
    Begin
    GetBoolOption (Data, 'formattedURL', formattedURL);
    GetBoolOption (Data, 'optTitle', optTitle);
    GetBoolOption (Data, 'optOrigTitle', optOrigTitle);
    GetBoolOption (Data, 'optPoster', optPoster);
    GetBoolOption (Data, 'optAka', optAka);
    GetBoolOption (Data, 'optYear', optYear);
    GetBoolOption (Data, 'optGenre', optGenre);
    GetBoolOption (Data, 'optDirector', optDirector);
    GetBoolOption (Data, 'optProducer', optProducer);
    GetBoolOption (Data, 'optScenario', optScenario);
    GetBoolOption (Data, 'optComposer', optComposer);
    GetBoolOption (Data, 'optActor', optActor);
    GetBoolOption (Data, 'optCountry', optCountry);
    GetBoolOption (Data, 'optStudio', optStudio);
    GetBoolOption (Data, 'optURL', optURL);
    GetBoolOption (Data, 'optReleaseDate', optReleaseDate);
    GetBoolOption (Data, 'optDescription', optDescription);
    GetBoolOption (Data, 'optSites', optSites);
    GetBoolOption (Data, 'optOperator', optOperator);
    GetBoolOption (Data, 'optDesigner', optDesigner);
    GetBoolOption (Data, 'pgActors', pgActors);
    GetBoolOption (Data, 'pgDiscussion', pgDiscussion);
    GetBoolOption (Data, 'pgReel', pgReel);

    GetStrOption (Data, 'ufPrefix', ufPrefix);
    GetStrOption (Data, 'ufPostfix', ufPostfix);

    GetStrOption (Data, 'ufReleaseDate', ufReleaseDate);
    GetStrOption (Data, 'ufSites',       ufSites);
    GetStrOption (Data, 'ufOperator',    ufOperator);
    GetStrOption (Data, 'ufDesigner',    ufDesigner);
    GetStrOption (Data, 'ufMakeStudio',  ufMakeStudio);
    End;

  SetUFOption (ufReleaseDate);
  SetUFOption (ufSites);
  SetUFOption (ufOperator);
  SetUFOption (ufDesigner);
  SetUFOption (ufMakeStudio);

  LoadPages[smSearch]     := Enabled;
  LoadPages[smResult]     := Enabled;
  LoadPages[smInfo]       := Enabled;
  LoadPages[smActors]     := pgActors;
  LoadPages[smDiscussion] := pgDiscussion;
  LoadPages[smReel]       := pgReel;
  LoadPages[smPoster]     := Enabled;
  LoadPages[smRobot]      := Enabled;
  LoadPages[smFinished]   := Disabled;
End;

function GetScriptVersion : WideString;
begin
  Result := SCRIPT_VERSION;
end; 
 
function GetScriptName : WideString;
begin
  Result := SCRIPT_NAME;
end;

function GetScriptDesc : WideString;
begin
 Result := SCRIPT_DESC;
end;

function GetRatingName : WideString;
begin
 Result := RATING_NAME;
end;

function GetBaseURL : String;
begin
 Result := BASE_URL;
end;

function GetScriptLang: Cardinal;
begin
 Result := SCRIPT_LANG;
end;

function GetCodePage : Cardinal;
begin
 Result := CODE_PAGE;
end;

function GetScriptType : Byte; 
begin
 Result := SCRIPT_TYPE;
end;

function GetCurrentMode : Byte; 
begin
 Result := Mode;
end;

function GetDownloadURL : String;
begin
  if mode = smSearch then 
    Result := SEARCH_STR
  else
    Result := ExtraLinks[mode];
//  ShowMessage (Result, 'GetDownloadURL');
end;

function GetDownloadMethod : Byte;
Var
  Str : WideString;
  Time: Double;
begin
  if (Mode = smSearch) then
    Begin
    Str := FileToString ('kino-teatr.ru.time.cfg');
    SetLength (Str, Length (Str) - 2);
    Time := StrToFloat (Str);
    if Time + Int (Delay) / 100000 > CurrentDateTime then
      Begin
      Time := (Time + Int (Delay) / 100000 - CurrentDateTime) * 100000 * 1000;
      LogMessage ('Wait ' + IntToStr (Round (Time)));
      Wait (Round (Time));
      End;
    End;
  
  if (Mode = smSearch) Or (Mode = smRobot) then
    Result := dmPOST
  else
    Result := dmGET;
  StringToFile ('kino-teatr.ru.time.cfg', FloatToStr (CurrentDateTime), false, false);
end;

{procedure GetLoginInfo(out URL : String; out Params : String);
begin
  URL := BASE_URL + '/level/30/';
  Params := 'shop_user[login]=' + login + '&shop_user[pass]=' + password;
end;}

function GetPrefixMode : Byte;
begin
 Result := pmEnd;  
end;

function GetReferrer : String;
Begin
  Result := 'http://www.kino-teatr.ru/search/';
End;


//****** Replace ******** Функция замены мнемоник и кодов на символы **********
function Replace (inStr: WideString): WideString;
Var
  I: Integer;
  Before, After : array of WideString;
Begin
//  inStr := HTMLToText (inStr);

  SetLength (Before, 53);
  SetLength (After, 53);
  // Мнемоники
  Before[ 1] := '&bdquo;';   After [ 1] := '„';
  Before[ 2] := '&bull;';    After [ 2] := '•';
  Before[ 3] := '&copy;';    After [ 3] := '©';
  Before[ 4] := '&deg;';     After [ 4] := '°';
  Before[ 5] := '&euro;';    After [ 5] := '€';
  Before[ 6] := '&hellip;';  After [ 6] := '…';
  Before[ 7] := '&laquo;';   After [ 7] := '«';
  Before[ 8] := '&ldquo;';   After [ 8] := '“';
  Before[ 9] := '&lsaquo;';  After [ 9] := '‹';
  Before[10] := '&lsquo;';   After [10] := '‘';
  Before[11] := '&mdash;';   After [11] := '—';
  Before[12] := '&middot;';  After [12] := '·';
  Before[13] := '&ndash;';   After [13] := '–';
  Before[14] := '&plusmn;';  After [14] := '±';
  Before[15] := '&raquo;';   After [15] := '»';
  Before[16] := '&rdquo;';   After [16] := '”';
  Before[17] := '&reg;';     After [17] := '®';
  Before[18] := '&rsaquo;';  After [18] := '›';
  Before[19] := '&rsquo;';   After [19] := '’';
  Before[20] := '&sbquo;';   After [20] := '‚';
  Before[21] := '&sect;';    After [21] := '§';
  Before[22] := '&shy;';     After [22] := '';   // «мягкий» дефис (место возможного переноса)

  // Коды
  Before[23] := '&#130;';    After [23] := '‚';
  Before[24] := '&#132;';    After [24] := '„';
  Before[25] := '&#133;';    After [25] := '…';
  Before[26] := '&#136;';    After [26] := '€';
  Before[27] := '&#137;';    After [27] := '‰';
  Before[28] := '&#139;';    After [28] := '‹';
  Before[30] := '&#145;';    After [30] := '‘';
  Before[31] := '&#146;';    After [31] := '’';
  Before[32] := '&#147;';    After [32] := '“';
  Before[33] := '&#148;';    After [33] := '”';
  Before[34] := '&#149;';    After [34] := '•';
  Before[35] := '&#150;';    After [35] := '–';
  Before[36] := '&#151;';    After [36] := '—';
  Before[37] := '&#153;';    After [37] := '™';
  Before[38] := '&#155;';    After [38] := '›';
  Before[39] := '&#171;';    After [39] := '«';
  Before[40] := '&#185;';    After [40] := '№';
  Before[41] := '&#187;';    After [41] := '»';

  // Символы
  Before[50] := '	';         After [50] := '';   // табуляция
  Before[51] := #13#10' ';   After [51] := #13#10;  // пробел в начале абзаца
  Before[52] := '';       After [52] := '';  // и попадается же хреновина всякая (http://www.kinopoisk.ru/level/1/film/5619/)

  For I := Low (Before) To High (Before) Do
    inStr := StringReplace (inStr, Before [i], After [i], true, false, false);
  Result := HTMLToText (inStr);
End;


// ******** CheckDate ************** Преобразовывает строку с датой в короткий формат ****
function CheckDate(s: WideString): WideString;
var
  i, j, num        : Integer;
  months           : array [1..12] of String;
  items            : TWideArray;
  Day, Month, Year : WideString;
begin
  months[ 1] := 'январ';
  months[ 2] := 'феврал';
  months[ 3] := 'март';
  months[ 4] := 'апрел';
  months[ 5] := 'ма';
  months[ 6] := 'июн';
  months[ 7] := 'июл';
  months[ 8] := 'август';
  months[ 9] := 'сентябр';
  months[10] := 'октябр';
  months[11] := 'ноябр';
  months[12] := 'декабр'; 

  ExplodeString (s, items, ' ');
  for i := 0 to 2 do
    Begin
    if i > High (items) then Break;
    
    num := StrToInt (items[i]);
    if num > 0 then  // День или год
      Begin
      if num <= 31 then  // День
        Day := items[i]
      else if (num >= 1000) And (num <= 2200) then  // Год
        Begin
        Year := items[i];
        Break;  // Год - последний
        End;
      End
    else  // Месяц
      Begin
      for j := Low (months) to High (months) do
        if Pos (months[j], LowerCase (items[i])) > 0 then Break;
      End;
      if j <= High (months) then
        Month := IntToStr (j);
    End;

  if Year <> '' then
    Begin
    if Day = '' then
      Day := '01'
    else if length (Day) = 1 then
      Day := '0' + Day;
    if Month = '' then
      Month := '01'
    else if length (Month) = 1 then
      Month := '0' + Month;
    Result := Day + '.' + Month + '.' + Year;
    End
  else
    Result := s;
end;


//========== Сравнивает даты ==========//
function CompareDate (date1, date2 : WideString): Integer;
Begin
  if (Copy (date1, 7, 4) < Copy (date2, 7, 4)) then
    Result := -1
  else if (Copy (date1, 7, 4) > Copy (date2, 7, 4)) then
    Result := 1
  else
    Begin
    if (Copy (date1, 4, 2) < Copy (date2, 4, 2)) then
      Result := -1
    else if (Copy (date1, 4, 2) > Copy (date2, 4, 2)) then
      Result := 1
    else
      Begin
      if (Copy (date1, 1, 2) < Copy (date2, 1, 2)) then
        Result := -1
      else if (Copy (date1, 1, 2) > Copy (date2, 1, 2)) then
        Result := 1
      else
        Result := 0;
      End;
    End;
End;


//========== Парсинг страницы с адресом страницы результатов поиска ==========//

procedure ParseAddressOfSearchPage (const HTML : WideString);
Var
  curPos, endPos : Integer;
Begin
  curPos := Pos ('<a href="', HTML) + 9;
  endPos := PosFrom ('"', HTML, curPos);
  ExtraLinks [smResult] := BASE_URL + Copy (HTML, curPos, endPos - curPos);
End;


//========== Разбор страницы с результатами поиска ==========//

procedure ParseSearchResults (const HTML : WideString);
Var
  curPos, endPos: Integer;
  poster, url, Title, OrigTitle, Year : WideString;
Begin
  endPos := 1;
  while true do
    Begin
    curPos := PosFrom ('title="Array[name]"', HTML, endPos);
    if curPos = 0 then
      Break;

    // Постер
    curPos := PosFrom ('<img src="', HTML, curPos) + 10;
    endPos := PosFrom ('"', HTML, curPos);
    poster := BASE_URL + Copy (HTML, curPos, endPos - curPos);

    // Адрес
    curPos := PosFrom ('<a href="', HTML, curPos) + 9;
    endPos := PosFrom ('"', HTML, curPos);
    url := BASE_URL + Copy (HTML, curPos, endPos - curPos);

    // Название
    curPos := PosFrom ('">', HTML, curPos) + 2;
    endPos := PosFrom ('</a>', HTML, curPos);
    Title := Copy (HTML, curPos, endPos - curPos);

    // Оригинальное название
    curPos := PosFrom ('">', HTML, curPos) + 2;
    endPos := PosFrom ('</a>', HTML, curPos);
    OrigTitle := Copy (HTML, curPos, endPos - curPos);

    // Год
    curPos := PosFrom ('>Год выпуска', HTML, curPos);
    curPos := PosFrom ('">', HTML, curPos) + 2;
    endPos := PosFrom ('</span>', HTML, curPos);
    Year := Copy (HTML, curPos, endPos - curPos);

    AddSearchResult (Title, OrigTitle, Year, url, poster);
    End;
End;


//========== Добавление одного типа персон ==========//
type
  TPerson = record
    Name      : WideString;
    TransName : WideString;
    URL       : WideString;
    end;
function AddOneTypePerson (const HTML, Name : WideString) : array of TPerson;
Var
  curPos, endPos, i : Integer;
  Tmp               : WideString;
  Items             : TWideArray;
Begin
  SetLength (Items, 0);
  curPos := Pos ('<p align="left">' + Name, HTML);
  if curPos > 0 then
    Begin
    curPos := PosFrom ('red">', HTML, curPos) + 5;
    endPos := PosFrom ('</span>', HTML, curPos);
    Tmp := Replace (Copy (HTML, curPos, endPos - curPos));
    Tmp := RemoveTags (Tmp, false);
    ExplodeString (Tmp, Items, ',');
    SetLength (Result, High (Items) + 1);
    For I := 0 to High (Items) do
      Begin
      curPos := Pos ('/', Items[i]);
      if curPos = 0 then
        Result[i].Name := Items[i]
      else
        Begin
        Result[i].Name := Copy (Items[i], 1, curPos - 1 - 1);
        Result[i].TransName := Copy (Items[i], curPos + 1, LastPos ('/', Items[i]) - curPos - 1);
        End;
      curPos := Pos ('>' + Result[i].Name + '</a>', HTML);
      if curPos > 0 then
        Begin
        curPos := PrevPos ('href="', HTML, curPos) + 6;
        endPos := PosFrom ('"', HTML, curPos);
        Result[i].URL := BASE_URL + Copy (HTML, curPos, endPos - curPos);
        End;
      End;
    End;
End;


//========== Добавление одного типа персон в стандартное поле ==========//
procedure AddOneMainTypePerson (const HTML, Name : WideString; const opt : Boolean; const mp : Integer);
Var
  I     : Integer;
  Items : array of TPerson;
Begin
  if opt then
    Begin
    Items := AddOneTypePerson (HTML, Name);
    For I := Low (Items) To High (Items) do
      AddMoviePerson (Items[i].name, Items[i].TransName, '', Items[i].URL, mp);
    End;
End;


//========== Добавление одного типа персон в пользовательское поле ==========//
procedure AddOneUserTypePerson (const HTML, Name : WideString; const opt : Boolean; const uf : String);
Var
  I     : Integer;
  Items : array of TPerson;
  Tmp   : WideString;
Begin
  if opt then
    Begin
    Items := AddOneTypePerson (HTML, Name);
    For I := Low (Items) To High (Items) do
      Begin
      If Length (Tmp) > 0 then
        Tmp := Tmp + ', ';
      Tmp := Tmp + '<link name="' + Items[i].Name + '">' + Items[i].Name;
      if Items[i].TransName <> '' then
        Tmp := Tmp + ' / ' + Items[i].TransName;
      Tmp := Tmp + '</link>';
      End;

    AddCustomFieldValueByName (uf, Tmp);
    End;
End;


//========== Разбор основной страницы фильма ==========//
procedure ParseInfo (const MovieURL, HTML: WideString);
Var
  curPos, endPos, i : Integer;
  Tmp, URL, Name, Country, ReleaseDate : WideString;
  Items             : TWideArray;
Begin
  if Pos ('>Актеры и роли<', HTML) > 0 then
    ExtraLinks[smActors] := StringReplace (MovieURL, '/annot/', Addr [smActors], True, True, False);
  if Pos ('>Обсуждение<', HTML) > 0 then
    ExtraLinks[smDiscussion] := StringReplace (MovieURL, '/annot/', Addr [smDiscussion], True, True, False);
  if Pos ('>Ролик', HTML) > 0 then
    ExtraLinks[smReel] := StringReplace (MovieURL, '/annot/', Addr [smReel], True, True, False);

  if optTitle Or optOrigTitle then
    Begin
    curPos := Pos ('<h2 align="left">', HTML) + 17;
    endPos := PosFrom ('</h2>', HTML, curPos);
    Tmp := Replace (Copy (HTML, curPos, endPos - curPos));
    if optTitle then
      Begin
      curPos := 1;
      endPos := Pos (' | ', Tmp);
      if endPos > 0 then
        AddFieldValue (mfTitle, Copy (Tmp, curPos, endPos - curPos));
      End;
    if optOrigTitle then
      Begin
      curPos := Pos (' | ', Tmp) + 3;
      endPos := Length (Tmp) + 1;
      AddFieldValue (mfOrigTitle, Copy (Tmp, curPos, endPos - curPos));
      End;
    End;

  if optPoster then
    Begin
    curPos := Pos ('/movie/poster', HTML);
    if curPos > 0 then
      Begin
      EndPos := PosFrom ('"', HTML, curPos);
      ExtraLinks[smPoster] := BASE_URL + Copy (HTML, curPos, endPos - curPos);
      End;
    End;

  if optAka then
    Begin
    Tmp := '';
    curPos := Pos ('<p>Другое название', HTML);
    if curPos > 0 then
      Tmp := Replace (TextBetween (HTML, 'Другое название:', '</p>', false, curPos));
    curPos := Pos ('<p>Оригинальное название', HTML);
    if curPos > 0 then
      Begin
      if Tmp <> '' then
       Tmp := Tmp + ', ';
      Tmp := Tmp + Replace (TextBetween (HTML, 'Оригинальное название:', '</p>', false, curPos));
      End;
    Tmp := StringReplace (Tmp, ' / ', ', ', True, True, False);
    Tmp := StringReplace (Tmp, ' | ', ', ', True, True, False);
    Tmp := StringReplace (Tmp, '; ', ', ', True, True, False);
    AddFieldValue (mfAka, Tmp);
    End;

  if optYear then
    Begin
    curPos := Pos ('>Год выпуска', HTML);
    if curPos > 0 then
      Begin
      Tmp := Replace (TextBetween (HTML, '<span class="red">', '</span>', false, curPos));
      Tmp := Copy (Tmp, 1, 4);
      AddFieldValue (mfYear, Tmp);
      End;
    End;

  if optGenre then
    Begin
    curPos := Pos ('>Жанр', HTML);
    if curPos > 0 then
      Begin
      Tmp := Replace (TextBetween (HTML, '<span class="red">', '</span>', false, curPos));
      AddFieldValue (mfGenre, Tmp);
      End;
    End;

  AddOneMainTypePerson (HTML, 'Режиссер',    optDirector, mpDirector);
  AddOneMainTypePerson (HTML, 'Сценарист',   optScenario, mpScenario);
  AddOneMainTypePerson (HTML, 'Композитор',  optComposer, mpComposer);
  AddOneMainTypePerson (HTML, 'Продюсер',    optProducer, mpProducer);
  AddOneUserTypePerson (HTML, 'Оператор',    optOperator, ufOperator);
  AddOneUserTypePerson (HTML, 'Художник',    optDesigner, ufDesigner);

  if optActor then
    Begin
    curPos := Pos ('<p>Актер', HTML);
    if curPos > 0 then
      Begin
      curPos := PosFrom (':', HTML, curPos) + 1;
      endPos := PosFrom ('</p>', HTML, curPos) + 4;
      Tmp := Replace (Copy (HTML, curPos, endPos - curPos));
      Tmp := StringReplace (Tmp, ', ', '@', True, True, False);
      ExplodeString (Tmp, Items, '@');
      For I := Low (Items) To High (Items) do
        Begin
        curPos := Pos ('<a href="', Items[i]);
        if curPos > 0 then
          Begin
          curPos := curPos + 9;
          endPos := PosFrom ('"', Items[i], curPos);
          URL := BASE_URL + Copy (Items[i], curPos, endPos - curPos);
          End
        else
          URL := '';
          
        Name := RemoveTags (Items[i], false);
        AddMoviePerson (Name, '', '', URL, mpActor);
        End;
      End;
    End;

  if optCountry then
    Begin
    curPos := Pos ('>Страна', HTML);
    if curPos > 0 then
      Begin
      Tmp := Replace (TextBetween (HTML, '<span class="red">', '</span>', false, curPos));
      AddFieldValue (mfCountry, Tmp);
      End;
    End;

  if optURL then
    AddFieldValue (mfURL, MovieURL);

  if optReleaseDate then
    Begin
    curPos := Pos ('>Премьера', HTML);
    if curPos > 0 then
      Begin
      Tmp := Replace (TextBetween (HTML, '<span class="red">', '</span>', false, curPos));
      Tmp := StringReplace (Tmp, ', ', '@', True, True, False);
      ExplodeString (Tmp, Items, '@');
      ReleaseDate := '99.99.9999';
      For I := 0 to High (Items) do
        Begin
        curPos := Pos ('(', Items[i]);
        if curPos > 0 then
          Begin
          curPos := curPos + 1;
          endPos := LastPos (')', Items[i]);
          Country := Copy (Items[i], curPos, endPos - curPos);
          if Country = 'Россия' then
            Country := 'РФ';
          Delete (Items[i], curPos - 2, Length (Items[i]) + 1 - curPos + 2);
          End;
        Items[i] := CheckDate (Items[i]);
        if (CompareDate (Items[i], ReleaseDate) < 0) then
          ReleaseDate := Items[i];
        Name := StringReplace (ufReleaseDate, '@', Country, True, True, False);
        if Country <> '' then
          AddCustomFieldValueByName (Name, Items[i])
        else
          AddFieldValueXML ('rdate', ReleaseDate);
        End;
//      AddFieldValueXML ('rdate', ReleaseDate);
      End;
    End;

  SetLength (Items, 3);
  Items[0] := 'Год выпуска:';
  Items[1] := 'Премьера:';
  Items[2] := 'Актеры:';
  if optDescription then
    Begin
    curPos := 1;
    while true do
      Begin
      curPos := PosFrom ('</span></p><p>', HTML, curPos);
      if curPos = 0 then
        Break;
        
      curPos := curPos + 14;
      for I := 0 to High (Items) do
        Begin
        if Pos (Items[i], HTML) = curPos then
          Break;
        End;
      if I <= High (Items) then
        Continue;
      endPos := PosFrom ('</p>', HTML, curPos);
      Tmp := Replace (Copy (HTML, curPos, endPos - curPos));
      Tmp := StringReplace (Tmp, #13#10, '', True, True, False);
      AddFieldValue (mfDescription, Tmp);
      End;
    End;

  if optSites then
    Begin
    curPos := Pos ('>Сайт', HTML);
    if curPos > 0 then
      Begin
      Tmp := HTMLValues (HTML, 'Сайт', '</p>', 'href="', '">', '@', curPos);
      ExplodeString (Tmp, Items, '@');
      Tmp := '';
      For I := 0 to High (Items) do
        Begin
        URL := Items[i];
        if formattedURL then
          Begin
          URL := StringReplace (URL, 'http://', '', false, false, false);
          URL := StringReplace (URL, 'www.', '', false, false, false);
          if Pos ('/', URL) > 0 then
            Delete (URL, Pos ('/', URL), Length (URL));
          End;
        if Tmp <> '' then
          Tmp := Tmp + '  ';
        Tmp := Tmp + '<link url="' + Items[i] + '">' + URL + '</link>';
        End;
      AddCustomFieldValueByName (ufSites, Tmp);
      End;
    End;

  if optStudio then
    Begin
    curPos := Pos ('>Производство', HTML);
    if curPos > 0 then
      Begin
      Tmp := Replace (TextBetween (HTML, '<span class="red">', '</span>', false, curPos));
      AddFieldValue (mfStudio, Tmp);
      End;
    End;
End;


//========== Защита от роботов ==========//
procedure ImHuman (const HTML : WideString);
Var
  curPos, endPos, x, y : Integer;
  tmp, id : WideString;
Begin
  curPos := Pos ('(this)">'#13#10, HTML) + 10;
  endPos := PosFrom ('<input', HTML, curPos);
  tmp := HTMLToText (Copy (HTML, curPos, endPos - curPos));
  
  curPos := 1;
  endPos := Pos (' ', tmp);
  x := StrToInt (Copy (tmp, curPos, endPos - curPos));

  curPos := PosFrom (' ', tmp, endPos + 1);
  endPos := PosFrom (' ', tmp, curPos + 1);
  y := StrToInt (Copy (tmp, curPos, endPos - curPos));
  
  curPos := Pos ('name="id" value="', HTML) + 17;
  endPos := PosFrom ('">', HTML, curPos);
  id := Copy (HTML, curPos, endPos - curPos);
  
  ExtraLinks[smRobot] := BASE_URL + '/robot/?result=' + IntToStr (x + y) + '&id=' + id + '&ok=ok';
End;


// ******** ParsePage *************** Парсим заданный URL **********
function ParsePage(HTML : WideString; URL : String) : Cardinal;
Var
  i : Integer;
Begin
//  ShowMessage ('Новая страница', '');
  if Not optionsInitialized then
    Begin
//    Wait (10000);
    initOptions ();
    loadOptions ();
    optionsInitialized := true;

    Addr [smInfo]       := '/annot/';
    Addr [smActors]     := '/titr/';
    Addr [smDiscussion] := '/forum/';
    Addr [smReel]       := '/video/';
    End;

  ExtraLinks[smRobot] := '';
  // Если пришла не HTML-страница
  if (Pos('<html>', HTML) = 0) Or (Pos ('Вам запрещено посещать сайт.<br>', HTML) > 0) then 
     begin
     Result := prError; //произошла ошибка
     end

  // Если нет результатов поиска
  else if Pos ('По вашему запросу ничего не обнаружено...<br', HTML) > 0 then 
    begin
    Result := prList;
    end

  // Если есть результат поиска
  else if Pos ('Поиск успешно завершен.<br', HTML) > 0 then 
    begin
    // Парсим эти результаты
    ParseAddressOfSearchPage (HTML);
    Result := prDownload;
    Inc (Mode);
    end

  // Результаты поиска
  else if Pos ('<strong>Поиск</strong>', HTML) > 0 then 
    begin
    // Парсим эти результаты
    ParseSearchResults (HTML);
//    ShowMessage ('', '');
    Result := prList; //получен список фильмов/персон
    end

  // Защита от роботов
  else if Pos ('Роботам запрещено посещать наш сайт.<br>', HTML) > 0 then 
    begin
    if MessageBox ('На сайте Кино-Театр.РУ сработала защита от роботов.'#10#13 + 
      'Рекомендуется прервать загрузку и по возможности сменить IP-адрес.'#10#13 +
      'Продолжение загрузки может привести к блокировке текущего IP-адреса на сайте Кино-Театр.РУ.'#10#13 +
      'Прервать работу скрипта?',
      'ВНИМАНИЕ!', MB_YESNO + MB_ICONWARNING + MB_DEFBUTTON1 + MB_APPLMODAL) = IDYES then
      Result := prError
    else
      Begin
      Mode := smRobot;
      ImHuman (HTML);
      Result := prDownload;
      End;
    end

  // Защита от частого поиска
  else if Pos ('Вы не можете отправлять запросы чаще 1 раза в 10 секунд...<br />', HTML) > 0 then 
    begin
    Wait (10000);
    Result := prDownload;
    Exit;
    end

  else 
    begin
    For I := 0 to High (Addr) do
      Begin
      if Pos (Addr [I], URL) > 0 then
        Begin
        Mode := I;
        Break;
        End;
      End;
    case mode of
      smInfo : ParseInfo (URL, HTML);
      end;

    // Перебираем следующие режимы, пока не найдем режим с непустой страницей
    Repeat
      Inc(Mode);
    until (mode >= smFinished) Or ((GetDownloadURL <> '') And (LoadPages[Mode] = Enabled));
    if Mode >= smFinished then
      Result := prFinished
    else
      Result := prDownload;
  end; 
End;

{
История версий


Планы на будущее
}
