new OFDb - IMDb (DE)

gerol · Post by **gerol** » 2007-03-04 18:51:33

I corrected the script OFDb - IMDb (DE), because http://german.imdb.com and http://us.imdb.com made some changes on their web, but I'm a little afraid, how long the modified version will work, because http://german.imdb.com and http://us.imdb.com made many changes in the last weeks.

This version works today:

Code: Select all

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

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

[Infos]
Authors=Fabian Filipczyk<FFJaro@gmx.de>, Bad Joker<badjoker@gmx.de>, VisualMAx<visualmax@gmail.com>, U. Pollaehne<u.pollaehne@web.de>
Title=OFDb - IMDb - mod
Description=Combined OFDb / IMDb (DE)|German Title, Picture and Description from OFDb|All other from IMDb (DE)
Site=www.ofdb.de
Language=DE,EN
Version=1.3
Requires=3.5.0
Comments=Import from Online-Filmdatenbank (OFDb) http://www.ofdb.de|and Internet Movie Database (IMDb) http://us.imdb.com
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]

***************************************************)

(***************************************************
 *                                                 *
 *  (c) 2002 Fabian Filipczyk    FFJaro@gmx.de     *
 *                                                 *
 *     @2003                                       *
 *     Overworked by Bad Joker    badjoker@gmx.de  *
 *                                                 *
 *     @16.10.2004                                 *
 *     Modified by VisualMAx    (at)gmail.com      *
 *                                                 *
 *     @19.12.2004                                 *
 *     Modified by u.pollaehne  (at)web.de         *
 *                                                 *
 *     @08.01.2006                                 *
 *     Modified by Bad Joker    badjoker@gmx.de    *
 *                                                 *
 ***************************************************)

program OFDB_DE;
var
  MovieName, IMDbURL, GerIMDbDURL: 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 AnalysePage(Address: string);
var
  Page: TStringList;
  LineNr: Integer;
begin
  Page := TStringList.Create;
  Page.Text := GetPage(Address);
  if pos('<title>OFDb - Suchergebnis', Page.Text) = 0 then
  begin
    AnalyseOFDBPage(Page)
    AnalyseIMDBDPage(Page)
    AnalyseIMDBPage(Page)
  end else
  begin
    if FindLine('<b>Titel:</b><br><br><b>&#149;</b> <i>Keine Ergebnisse</i>', Page, 0) > 0 then
    begin
      ShowMessage('Die Suche nach "' + MovieName +'" ergab kein Ergebniss, bitte den Titel ändern.');
      Input('OFDb', 'Bitte einen anderen Titel eingeben :', MovieName);
        begin
        AnalysePage('http://www.ofdb.de/view.php?page=suchergebnis&SText='+UrlEncode(MovieName)+'&Kat=All');
        end;
  end else
  begin
      PickTreeClear;
      LineNr := FindLine('<b>Titel:</b>', Page, 0);
      if LineNr > 0 then
      begin
        PickTreeAdd('Suche nach "' + MovieName + '" ergab:', '');
        Address := AddMoviesTitles(Page, LineNr);
        if Address = '' then
        begin
          if PickTreeExec(Address) then
            AnalysePage(Address);
        end else
          AnalysePage(Address);
      end;
    end;
  end;
  Page.Free;
end;

function AddMoviesTitles(Page: TStringList; var LineNr: Integer) : string;
var
  Line: string;
  MovieTitle, MovieAddress: string;
  StartPos, EndPos, NumTitles: Integer;
  Multi: boolean;
begin
  Multi := true;
  result := '';
  Line := Page.GetString(LineNr);
  NumTitles := 0;
  repeat
    StartPos := pos('<a href=''view.php?page=film&fid=', Line);
    if StartPos < 1 then
      begin
      StartPos := pos('<a href="view.php?page=film&fid=', Line);
      Multi := false;
      end;
    if StartPos > 0 then
    begin
      Delete(Line, 1, StartPos + 8);
      MovieAddress := copy(Line, 1, pos('''>', Line) - 1);
      if Multi = false then MovieAddress := copy(Line, 1, pos('">', Line) - 1);
      StartPos := pos('''>', Line) + 2;
      if Multi = false then StartPos := pos('">', Line) + 2;
      MovieTitle := copy(Line, StartPos, pos('</a>', Line) - StartPos);
      HTMLRemoveTags(MovieTitle);
      NumTitles := NumTitles + 1;
      PickTreeAdd(MovieTitle, 'http://www.ofdb.de/' + MovieAddress);
    end;
  until (StartPos < 1);
  if NumTitles = 1 then result := 'http://www.ofdb.de/' + MovieAddress;
end;

procedure AnalyseOFDBPage(Page: TStringList);
var
  Line, Temp, Value, NewURL: string;
  LineNr, BeginPos, EndPos: Integer;
begin

  // Get IMDb URL + Set german IMDb URL
  begin
    LineNr :=Findline('http://german.imdb.com/Title?', Page, 0);
    Line := Page.GetString(LineNr);
    BeginPos := pos('Title?', Line)+6;
    EndPos := pos('" target', Line);
    Value := copy(Line, BeginPos, EndPos - BeginPos);
    NewURL := ('http://german.imdb.com/title/tt' + Value);
    SetField(fieldURL, NewURL);
    BeginPos := pos('Title?', Line)+6;
    EndPos := pos('" target', Line);
    Temp := copy(Line, BeginPos, EndPos - BeginPos);
    Value := ('http://german.imdb.com/title/tt' + Temp + '/fullcredits#cast');
    GerIMDbDURL := Value;
    Value := ('http://us.imdb.com/title/tt' + Temp + '/');
    IMDbURL := Value;
  end;

  // Original & Translated Title
  LineNr := FindLine('Originaltitel:</font>', Page, 0);
  if LineNr > -1 then
  begin
    LineNr:= LineNr+2;
    Line := Page.GetString(LineNr);
    BeginPos := pos('class="Daten"><b>', Line) + 17;
    EndPos := pos('</b></font>', Line);
    Value := copy(Line, BeginPos, EndPos - BeginPos);
    SetField(fieldOriginalTitle, Value);
    LineNr := Findline('sans-serif" size="3"><b>', Page, 0);
    if LineNr > -1 then
    begin
      Line:= Page.GetString(LineNr);
      BeginPos := pos('sans-serif" size="3"><b>',Line) +24;
      Endpos :=  pos('</b></font></td>',Line);
      Value := copy(Line,BeginPos, Endpos-Beginpos);
      SetField(fieldTranslatedTitle,Value);
    end;
  end;
 
  // Picture
  LineNr := FindLine('images/film/', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr);
    BeginPos := pos('<img src="', Line) + 10;
    if BeginPos > 10 then
    begin
      EndPos := pos(' alt=', Line)-1;
      Value := copy(Line, BeginPos, EndPos - BeginPos);
      Temp := 'http://www.ofdb.de/'+Value;
      GetPicture(Temp);
    end;
  end;

  // Description
  LineNr := Findline('<b>Inhalt:</b>', Page, 0);
  if LineNr > -1 then
  begin
    LineNr := Findline('<a href="view.php?page=inhalt', Page, 0);
    Line := Page.GetString(LineNr);
    BeginPos := pos('<a href="view.php?page=inhalt', Line)+9;
    EndPos := pos('"><b>[mehr]', Line);
    Value := copy(Line, BeginPos, EndPos - BeginPos);
    GetDescriptions(Value);
  end;
end;

procedure GetDescriptions(Address: string);
var
  Line, Temp, Value: string;
  LineNr, BeginPos, EndPos: Integer;
  Page: TStringList;

begin
  Temp:= '';
  Page := TStringList.Create;
  Page.Text := GetPage('http://www.ofdb.de/' + Address);
  LineNr := FindLine('Eine Inhaltsangabe von', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr);
    BeginPos := pos('</a></b><br><br>', Line) + 16;
    while (pos('<br />', Line) >0) do
         begin
           EndPos := pos('<br />', Line);
           Temp := Temp + copy(Line, BeginPos, EndPos - BeginPos);
           LineNr:=LineNr+1;
           Line:=Page.GetString(LineNr);
           BeginPos:=1;
         end;   
    EndPos := pos('</font></p>', Line);
    Temp:= Temp +  copy(Line, BeginPos, EndPos - BeginPos);
    Value:= Temp;
    SetField(fieldDescription, Value);
  end;
  Page.Free;
end;

procedure AnalyseIMDBDPage(Page: TStringList);
var
  Line, Value, Value2, FullValue, GerTitle, Ger, Temp: string;
  BeginPos, EndPos, LineNr, TempPos: Integer;
begin

  Page.Text := GetPage(GerIMDbDURL);

  // Producer
  LineNr := FindLine(' name="producers"', Page, 0);
  if LineNr > -1 then
  begin
    FullValue := '';
    EndPos := 0;
    Line := Page.GetString(LineNr);
    BeginPos := Pos('>Produktion<', Line);
    EndPos := Pos(' name="music_original"', Line);
    if EndPos = 0 then
    begin
    EndPos := Pos(' name="cinematographers"', Line);
    end;
    Line := copy(Line, BeginPos, EndPos - BeginPos);
    repeat
      BeginPos := Pos('<td valign="top">', Line);
      if BeginPos > 0 then
      begin
        Delete(Line, 1, BeginPos + 25);
        TempPos := Pos('">producer</a>', Line);
        if (TempPos > 0) and (TempPos < Pos('</tr>', Line)) then
        begin
          BeginPos := pos('">', Line) + 2;
          EndPos := pos('</a>', Line);
          if EndPos = 0 then
            EndPos := Pos('</td>', Line);
          Value := copy(Line, BeginPos, EndPos - BeginPos);
          if FullValue <> '' then
            FullValue := FullValue + ', ';
          FullValue := FullValue + Value;
          EndPos := Pos('</td></tr>', Line);
          Delete(Line, 1, EndPos);
        end;
      end else
      begin
        Line := '';
      end;
    until Line = '';
    HTMLDecode(FullValue);
    SetField(fieldProducer, FullValue);
  end;
end;

procedure AnalyseIMDBPage(Page: TStringList);
var
  Line, Value, Value2, FullValue: string;
  BeginPos, EndPos, LineNr: Integer;
begin

  // Original Title & Year
  Page.Text := GetPage(IMDbURL);
  LineNr := FindLine('<title>', Page, 0);
  Line := Page.GetString(LineNr);
  if LineNr > -1 then
  begin
    BeginPos := pos('<title>', Line);
    if BeginPos > 0 then
      BeginPos := BeginPos + 7;
      EndPos := pos('(', Line);
    if EndPos = 0 then
      EndPos := Length(Line);
    Value := copy(Line, BeginPos, EndPos - BeginPos - 1);
    HTMLDecode(Value);
    SetField(fieldOriginalTitle, Value);
    BeginPos := pos('(', Line) + 1;
    if BeginPos > 0 then
    begin
      EndPos := pos(')', Line);
      Value := copy(Line, BeginPos, EndPos - BeginPos);
      SetField(fieldYear, Value);
    end;
  end;

  // IMDb Rating
  LineNr := FindLine('User Rating:', Page, 0);
  if LineNr > -1 then
  begin
      Line := Page.GetString(LineNr + 1);
      if Pos('awaiting', Line) = 0 then
      begin
      Line := Page.GetString(LineNr + 1);
      BeginPos := pos('<b>', Line) + 3;
      EndPos := BeginPos + 3;
      Value := copy(Line, BeginPos, EndPos - BeginPos);
      SetField(fieldRating, Value);
      end;
  end;

  // Director
  LineNr := FindLine('Directed by', Page, 0);
  if LineNr > -1 then
  begin
    FullValue := '';
    Line := Page.GetString(LineNr + 1);
    repeat
      BeginPos := pos('">', Line) + 2;
      EndPos := pos('</a>', Line);
      Value := copy(Line, BeginPos, EndPos - BeginPos);
      if (Value <> '(more)') and (Value <> '') then
      begin
        if FullValue <> '' then
          FullValue := FullValue + ', ';
        FullValue := FullValue + Value;
      end;
      Delete(Line, 1, EndPos);
    until Pos('</a>', Line) = 0;
    HTMLDecode(FullValue);
    SetField(fieldDirector, FullValue);
  end;

  // Actors
  LineNr := FindLine('Cast overview', Page, 0);
  if LineNr = -1 then
    LineNr := FindLine('cast overview', Page, 0);
  if LineNr = -1 then
    LineNr := FindLine('Credited cast', Page, 0);
  if LineNr = -1 then
    LineNr := FindLine('Complete credited cast', Page, 0);
  if LineNr > -1 then
  begin
    FullValue := '';
    Line := Page.GetString(LineNr);
    repeat
      BeginPos := Pos('<td class="nm">', Line);
      if BeginPos > 0 then
      begin
        Delete(Line, 1, BeginPos);
        Line := copy(Line, 26, Length(Line));
        BeginPos := pos('">', Line) + 2;
        EndPos := pos('</a>', Line);
        if EndPos = 0 then
          EndPos := Pos('</td>', Line);
        Value := copy(Line, BeginPos, EndPos - BeginPos);
        if (Value <> '(more)') and (Value <> '') then
        begin
          BeginPos := pos('<td class="char">', Line);
          if BeginPos > 0 then
          begin
            EndPos := pos('</td></tr>', Line);
            BeginPos := BeginPos + 17;
            Value2 := copy(Line, BeginPos, EndPos - BeginPos);
            if Value2 <> '' then
            begin
              Value := Value + ' (als ' + Value2 + ')';
            end;
          end;
          if FullValue <> '' then
            FullValue := FullValue + ', ';
          FullValue := FullValue + Value;
        end;
        EndPos := Pos('</td></tr>', Line);
        Delete(Line, 1, EndPos);
      end else
      begin
        Line := '';
      end;
    until Line = '';
    HTMLDecode(FullValue);
    SetField(fieldActors, FullValue);
  end;

  // Comments
  begin
  LineNr := FindLine('<b>Summary:</b>', Page, 0);
  if LineNr > -1 then
  begin
    Value := '';
    repeat
      LineNr := LineNr + 1;
      Line := Page.GetString(LineNr);
      EndPos := Pos('</blockquote>', Line);
      if EndPos = 0 then
        EndPos := Length(Line)
      else
        EndPos := EndPos - 1;
      Value := Value + Copy(Line, 1, EndPos) + ' ';
    until Pos('</blockquote>', Line) > 0;
    HTMLDecode(Value);
    Value := StringReplace(Value, '<br>', #13#10);
    Value := StringReplace(Value, #13#10+' ', #13#10);
    SetField(fieldComments, Value);
  end;
  end;

  // Length
  LineNr := FindLine('Runtime:', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr + 1);
    EndPos := pos(' min', Line);
    if EndPos = 0 then
      EndPos := pos('  /', Line);
    if EndPos = 0 then
      EndPos := Length(Line);
    if Pos(':', Line) < EndPos then
      BeginPos := Pos(':', Line) + 1
    else
      BeginPos := 1;
    Value := copy(Line, BeginPos, EndPos - BeginPos);
    SetField(fieldLength, Value);
  end;

  // Language
  LineNr := FindLine('Language:', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr + 1);
    BeginPos := pos('/">', Line) + 3;
    EndPos := pos('</a>', Line);
    if EndPos = 0 then
      EndPos := Length(Line);
    Value := copy(Line, BeginPos, EndPos - BeginPos);
    SetField(fieldLanguages, Value);
  end;
 
  // Country
  LineNr := FindLine('Country:', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr + 1);
    BeginPos := pos('/">', Line) + 3;
    EndPos := pos('</a>', Line);
    Value := copy(Line, BeginPos, EndPos - BeginPos);
    if pos('</a> / <a ', Line) > 2 then
    begin
      Line := copy(Line, pos('</a> / <a ', Line) + 8, Length(Line));
      BeginPos := pos('/">', Line) + 3;
      EndPos := pos('</a>', Line);
      Value := Value + ' / ' + copy(Line, BeginPos, EndPos - BeginPos);
    end;
    HTMLDecode(Value);
    SetField(fieldCountry, Value);
  end;
 
  // Category
  LineNr := FindLine('Genre:', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr + 1);
    BeginPos := pos('/">', Line) + 3;
    EndPos := pos('</a>', Line);
    Value := copy(Line, BeginPos, EndPos - BeginPos);
    HTMLDecode(Value);
    SetField(fieldCategory, Value);
  end;
end;

begin
  if CheckVersion(3,5,0) then
  begin
    MovieName := GetField(fieldTranslatedTitle);
    if MovieName = '' then
      MovieName := GetField(fieldOriginalTitle);
    if MovieName = '' then
    begin
      Input('OFDb', 'Bitte Titel eingeben :', MovieName)
      AnalysePage('http://www.ofdb.de/view.php?page=suchergebnis&SText='+UrlEncode(MovieName)+'&Kat=All');
    end else
    begin
      AnalysePage('http://www.ofdb.de/view.php?page=suchergebnis&SText='+UrlEncode(MovieName)+'&Kat=All');
    end;
  end else
    ShowMessage('Dieses Script benötigt eine neuere Version von Ant Movie Catalog (mindestens Version 3.5.0)');
end.

Post by **antp** » 2007-03-05 19:52:35

Thanks

Melmoth · Post by **Melmoth** » 2007-04-04 11:30:56

Worked until april... now directors are missing... hope they stop their spring cleaning soon...