antp.be forum

Official Forum
https://forum.antp.be/phpbb3/

[Release] Script for filmposter-archiv.de

https://forum.antp.be/phpbb3/viewtopic.php?t=537

Page 1 of 1

[Release] Script for filmposter-archiv.de

Posted: 2003-03-15 11:24:48
by Nik0
Hi,

i changed the script for imdb a bit and made it compatible to filmposter-archiv.de.

It only imports the filmposters.

Perhaps somebody needs it :wink:

Code: Select all

// GETINFO SCRIPTING
// Bild von Filmposterarchiv.de

program filmposterarchiv;
var
  MovieName: string;
  
const
  fp_Server = 'http://www.filmposter-archiv.de/';

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;

// wenn mehrere Ergebnisse
procedure AnalyzePage(Address: string);
var
  Page: TStringList;
  LineNr: Integer;
begin
  Page := TStringList.Create;
  Page.Text := GetPage(Address);
  if pos('<TITLE>Filmposter-Archiv - Filmposter-Suche', Page.Text) = 0 then
  begin
    AnalyzeMoviePage(Page)
  end else
  begin
    PickTreeClear;
    LineNr := 0;
    LineNr := FindLine('<OL>', Page, LineNr);
    if LineNr > -1 then
    begin
      PickTreeAdd('Suche nach "' + MovieName + '" ergab mehrere Treffer:', '');
      AddMoviesTitles(Page, LineNr);
    end;
    if PickTreeExec(Address) then
      AnalyzePage(Address);
  end;
  Page.Free;
end;

//wenn Filmseite
procedure AnalyzeMoviePage(Page: TStringList);
var
  Line, Value, Value2, FullValue: string;
  LineNr: Integer;
  BeginPos, EndPos: Integer;
begin

  // Picture
  LineNr := FindLine('<IMG SRC="../p_', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr);
    BeginPos := pos('SRC="', Line) + 4;
    Delete(Line, 1, BeginPos);
    EndPos := pos('"', Line);
    Value := copy(Line, 1, EndPos - 1);
    GetPicture(Value, False); // False = do not store picture externally ; store it in the catalog file
  end;
  DisplayResults;
end;

procedure AddMoviesTitles(Page: TStringList; var LineNr: Integer);
var
  Line: string;
  MovieTitle, MovieAddress, PictureKiloByte, AdditionalInfo: string;
  StartPos: Integer;
begin
  repeat
    LineNr := LineNr + 1;
    Line := Page.GetString(LineNr);
//    ShowMessage(Line);
    StartPos := pos('<LI>', Line);
    if StartPos > 0 then
    begin
      StartPos := StartPos + 4;
      MovieTitle := copy(Line, StartPos, pos(' <A', Line) - StartPos);
      HTMLDecode(Movietitle);
      HTMLRemoveTags(Movietitle);
      
      StartPos := pos(' kByte', Line) - 3;
      PictureKiloByte := copy(Line, StartPos, pos(' kByte', Line) - StartPos);
      MovieTitle := MovieTitle + ' | ' + Trim(PictureKiloByte) + ' kByte';

      StartPos := pos('[', Line) + 1;
      AdditionalInfo := copy(Line, StartPos, pos(']', Line) - StartPos);
      if AdditionalInfo <> '' then
        MovieTitle := MovieTitle + ' | [' + AdditionalInfo + ']';
      StartPos := pos('_gr.php3?id=', Line) + 12;
      MovieAddress := copy(Line, StartPos, pos('" TARGET="', Line) - StartPos);
      PickTreeAdd(MovieTitle, fp_Server + 'html/anzeige_gr.php3?id=' + MovieAddress);
    end;
  until pos('</OL>', Line) > 0;
end;

begin
  if CheckVersion(3,4,0) then
  begin
    MovieName := GetField(fieldOriginalTitle);
    if MovieName = '' then
      MovieName := GetField(fieldTranslatedTitle);
    if Input('Filmposter-Archiv.de', 'Geben Sie den Namen den Films ein:', MovieName) then
    begin
      AnalyzePage( fp_Server + 'html/suche.php3?sent=1&language=german&filmtitel='+UrlEncode(MovieName));
    end;
  end else
    ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.4.0)');
end.

Posted: 2003-03-15 11:46:52
by Guest
Great ! Exactly what I was looking for... But unfortunately it only produces an error...: "MAIN an Position 1881 (syntax error)"

Posted: 2003-03-15 11:59:32
by Nik0
hmm, perhaps it was the ) in the copyright note

try the updated text

Posted: 2003-03-15 13:12:40
by antp
I'll include it with the program for the next update.
In the "copyright" comment that I add at the top, I just put "Nik0" as name ?

Posted: 2003-03-15 15:05:00
by Nik0
thanks!

Posted: 2003-03-19 15:05:00
by Nik0
I found a bug:

please change

Code: Select all

  // Picture
  LineNr := FindLine('<IMG SRC="../p_', Page, 0);
I have updated the upper post

Posted: 2003-03-19 15:08:27
by antp
ok

Posted: 2003-04-19 08:47:48
by Nik0
site is down :(

Posted: 2005-12-10 14:16:57
by Nik0
Here is an update for the script. They added a referer blocking method. The script only works with amc version >= 3.5.1.0 beta 1 (or further amc versions).

Code: Select all

program filmposterarchiv;
var
  MovieName: string;
 
const
  fp_Server = 'http://www.filmposter-archiv.de/';

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;

// wenn mehrere Ergebnisse
procedure AnalyzePage(Address: string);
var
  Page: TStringList;
  LineNr: Integer;
begin
  Page := TStringList.Create;
  Page.Text := GetPage(Address);
  if pos('<TITLE>Filmposter-Archiv - Filmposter-Suche', Page.Text) = 0 then
  begin
    AnalyzeMoviePage(Page)
  end else
  begin
    PickTreeClear;
    LineNr := 0;
    LineNr := FindLine('<OL>', Page, LineNr);
    if LineNr > -1 then
    begin
      PickTreeAdd('Suche nach "' + MovieName + '" ergab mehrere Treffer:', '');
      AddMoviesTitles(Page, LineNr);
    end;
    if PickTreeExec(Address) then
      AnalyzePage(Address);
  end;
  Page.Free;
end;

//wenn Filmseite
procedure AnalyzeMoviePage(Page: TStringList);
var
  Line, Value, Value2, FullValue: string;
  LineNr: Integer;
  BeginPos, EndPos: Integer;
begin

  // Picture
  LineNr := FindLine('<IMG SRC="../filmplakat/', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr);
    BeginPos := pos('SRC="', Line) + 4;
    Delete(Line, 1, BeginPos);
    EndPos := pos('"', Line);
    Value := copy(Line, 1, EndPos - 1);
    GetPicture2(Value, 'http://www.filmposter-archiv.de/html/anzeige_gr.php3?id=1234'); // False = do not store picture externally ; store it in the catalog file
  end;
  //DisplayResults;
end;

procedure AddMoviesTitles(Page: TStringList; var LineNr: Integer);
var
  Line: string;
  MovieTitle, MovieAddress, PictureKiloByte, AdditionalInfo: string;
  StartPos: Integer;
begin
  repeat
    LineNr := LineNr + 1;
    Line := Page.GetString(LineNr);
//    ShowMessage(Line);
    StartPos := pos('<LI>', Line);
    if StartPos > 0 then
    begin
      StartPos := StartPos + 4;
      MovieTitle := copy(Line, StartPos, pos(' <A', Line) - StartPos);
      HTMLDecode(Movietitle);
      HTMLRemoveTags(Movietitle);
     
      StartPos := pos(' kByte', Line) - 3;
      PictureKiloByte := copy(Line, StartPos, pos(' kByte', Line) - StartPos);
      MovieTitle := MovieTitle + ' | ' + Trim(PictureKiloByte) + ' kByte';

      StartPos := pos('[', Line) + 1;
      AdditionalInfo := copy(Line, StartPos, pos(']', Line) - StartPos);
      if AdditionalInfo <> '' then
        MovieTitle := MovieTitle + ' | [' + AdditionalInfo + ']';
      StartPos := pos('_gr.php3?id=', Line) + 12;
      MovieAddress := copy(Line, StartPos, pos('" TARGET="', Line) - StartPos);
      PickTreeAdd(MovieTitle, fp_Server + 'html/anzeige_gr.php3?id=' + MovieAddress);
    end;
  until pos('</OL>', Line) > 0;
end;

begin
  if CheckVersion(3,5,0) then
  begin
    //MovieName := GetField(fieldOriginalTitle);
    if MovieName = '' then
      MovieName := GetField(fieldTranslatedTitle);
    if Input('Filmposter-Archiv.de', 'Geben Sie den Namen den Films ein:', MovieName) then
    begin
      AnalyzePage( fp_Server + 'html/suche.php3?sent=1&language=german&filmtitel='+UrlEncode(MovieName));
    end;
  end else
  ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.0)');
end.

Posted: 2007-09-06 08:59:12
by SpeedCore
This source did't work for me... dunno why :D here is the source edited by me:

Code: Select all

program filmposterarchiv;
var
  MovieName: string;
 
const
  fp_Server = 'http://www.filmposter-archiv.de/';

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;

// wenn mehrere Ergebnisse
procedure AnalyzePage(Address: string);
var
  Page: TStringList;
  LineNr: Integer;
begin
  Page := TStringList.Create;
  Page.Text := GetPage(Address);
  if pos('<TITLE>Filmposter-Archiv - Filmposter-Suche', Page.Text) = 0 then
  begin
    AnalyzeMoviePage(Page)
  end else
  begin
    PickTreeClear;
    LineNr := 0;
    LineNr := FindLine('<OL>', Page, LineNr);
    if LineNr > -1 then
    begin
      PickTreeAdd('Suche nach "' + MovieName + '" ergab mehrere Treffer:', '');
      AddMoviesTitles(Page, LineNr);
    end;
    if PickTreeExec(Address) then
      AnalyzePage(Address);
  end;
  Page.Free;
end;

//wenn Filmseite
procedure AnalyzeMoviePage(Page: TStringList);
var
  Line, Value, Value2, FullValue: string;
  LineNr: Integer;
  BeginPos, EndPos: Integer;
begin

  // Picture
  LineNr := FindLine('<IMG SRC="../filmplak', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr);
    BeginPos := pos('SRC="', Line) + 7;
    Delete(Line, 1, BeginPos);
    EndPos := pos('" WIDTH="', Line);
    Value := fp_Server + copy(Line, 1, EndPos - 1);
    GetPicture2(Value, 'http://www.filmposter-archiv.de/html/anzeige_gr.php3?id=1234'); // False = do not store picture externally ; store it in the catalog file
  end;
  //DisplayResults;
end;

procedure AddMoviesTitles(Page: TStringList; var LineNr: Integer);
var
  Line: string;
  MovieTitle, MovieAddress, PictureKiloByte, AdditionalInfo: string;
  StartPos: Integer;
begin
  repeat
    LineNr := LineNr + 1;
    Line := Page.GetString(LineNr);
//    ShowMessage(Line);
    StartPos := pos('<LI>', Line);
    if StartPos > 0 then
    begin
      StartPos := StartPos + 4;
      MovieTitle := copy(Line, StartPos, pos(' <A', Line) - StartPos);
      HTMLDecode(Movietitle);
      HTMLRemoveTags(Movietitle);
     
      StartPos := pos(' kByte', Line) - 3;
      PictureKiloByte := copy(Line, StartPos, pos(' kByte', Line) - StartPos);
      MovieTitle := MovieTitle + ' | ' + Trim(PictureKiloByte) + ' kByte';

      StartPos := pos('[', Line) + 1;
      AdditionalInfo := copy(Line, StartPos, pos(']', Line) - StartPos);
      if AdditionalInfo <> '' then
        MovieTitle := MovieTitle + ' | [' + AdditionalInfo + ']';
      StartPos := pos('_gr.php3?id=', Line) + 12;
      MovieAddress := copy(Line, StartPos, pos('?id=', Line) - 30);
      PickTreeAdd(MovieTitle, fp_Server + 'html/anzeige_gr.php3?id=' + MovieAddress);
    end;
  until pos('</OL>', Line) > 0;
end;

begin
  if CheckVersion(3,5,0) then
  begin
    MovieName := GetField(fieldOriginalTitle);
    if MovieName = '' then
      MovieName := GetField(fieldTranslatedTitle);
    if Input('Filmposter-Archiv.de', 'Geben Sie den Namen den Films ein:', MovieName) then
    begin
      AnalyzePage( fp_Server + 'html/suche.php3?sent=1&language=german&filmtitel='+UrlEncode(MovieName));
    end;
  end else
  ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.0)');
end.
This works great here. Maybe we should try to find out, what the problem was :)

Greets

Posted: 2007-09-06 17:29:20
by antp
Well, knowing why the old one does not work is maybe not much important if the one that you provided works ;
Thanks for it.

Posted: 2007-09-06 22:17:53
by bad4u
Maybe it was just because the old script was nearly 2 years old and perhaps outdated because of website changes ?
I'd rather be surprised if it would still work fine after that time ;)

Posted: 2007-09-07 06:16:41
by SpeedCore
Ahh i didn't notice the date of nik0's post :lol: Well, i have some sporadic problems with that script. it can't handle id's with less than 4 digits and has some problems with some movies (don't know exactly, why...) Could someone help me find a solution? f.e. American Pie II won't work for me (Blade II works fine). It doesn't cut the url properly in some cases ("TARGET="plakatanzeige"><IMGSRC=". after the id). Can someone help?

Posted: 2007-09-07 09:11:30
by bad4u
SpeedCore wrote:It doesn't cut the url properly in some cases ("TARGET="plakatanzeige"><IMGSRC=". after the id).
As you said, it does not cut the url properly. If you don't know how long the filmID is, you cannot use the beginning of the ID ('?id=') to find the correct end position. You have to use the code behind the ID. So just change the MovieAddress line :

Code: Select all

MovieAddress := copy(Line, StartPos, pos('?id=', Line) - 30);
to

Code: Select all

MovieAddress := copy(Line, StartPos, pos('" TARGET="plakatanzeige"', Line) - StartPos);

Posted: 2008-10-30 20:29:48
by Nik0
Now an update for the script. Urls were changed a bit and there's a POST/GET check.

Code: Select all

program filmposterarchiv;
var
  MovieName: string;

const
  fp_Server = 'http://www.filmposter-archiv.de/';

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;

// wenn mehrere Ergebnisse
procedure AnalyzePage(Address: string; UsePostGet: Integer);
var
  Page: TStringList;
  LineNr: Integer;
begin
  //ShowMessage(Address);
  Page := TStringList.Create;
  
  if UsePostGet = 1 then
  begin
    Page.Text := PostPage(fp_Server + 'html/suche.php3', Address);
  end else
  begin
    Page.Text := GetPage(Address);
  end;
  
  if pos('im Filmposter-Archiv ergab', Page.Text) = 0 then
  begin
    AnalyzeMoviePage(Page)
  end else
  begin
    PickTreeClear;
    LineNr := 0;
    LineNr := FindLine('<OL>', Page, LineNr);
    if LineNr > -1 then
    begin
      PickTreeAdd('Suche nach "' + MovieName + '" ergab mehrere Treffer:', '');
      AddMoviesTitles(Page, LineNr);
    end;
    if PickTreeExec(Address) then
      AnalyzePage(Address, 0);
  end;
  Page.Free;
end;

//wenn Filmseite
procedure AnalyzeMoviePage(Page: TStringList);
var
  Line, Value, Value2, FullValue: string;
  LineNr: Integer;
  BeginPos, EndPos: Integer;
begin

  // Picture
  LineNr := FindLine('<IMG SRC="../filmplakat/', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr);
    BeginPos := pos('SRC="', Line) + 4;
    Delete(Line, 1, BeginPos);
    EndPos := pos('"', Line);
    Value := copy(Line, 1, EndPos - 1);
    GetPicture2(Value, 'http://www.filmposter-archiv.de/html/filmplakat.php?id=1234'); // False = do not store picture externally ; store it in the catalog file
  end;
  //DisplayResults;
end;

procedure AddMoviesTitles(Page: TStringList; var LineNr: Integer);
var
  Line: string;
  MovieTitle, MovieAddress, PictureKiloByte, AdditionalInfo: string;
  StartPos: Integer;
begin
  repeat
    LineNr := LineNr + 1;
    Line := Page.GetString(LineNr);
//    ShowMessage(Line);
    StartPos := pos('<LI>', Line);
    if StartPos > 0 then
    begin
      StartPos := StartPos + 4;
      MovieTitle := copy(Line, StartPos, pos(' <A', Line) - StartPos);
      HTMLDecode(Movietitle);
      HTMLRemoveTags(Movietitle);

      StartPos := pos(' kByte', Line) - 3;
      PictureKiloByte := copy(Line, StartPos, pos(' kByte', Line) - StartPos);
      MovieTitle := MovieTitle + ' | ' + Trim(PictureKiloByte) + ' kByte';

      StartPos := pos('[', Line) + 1;
      AdditionalInfo := copy(Line, StartPos, pos(']', Line) - StartPos);
      if AdditionalInfo <> '' then
        MovieTitle := MovieTitle + ' | [' + AdditionalInfo + ']';
      StartPos := pos('filmplakat.php?id=', Line) + 18;
      MovieAddress := copy(Line, StartPos, pos('" TARGET="', Line) - StartPos);
      PickTreeAdd(MovieTitle, fp_Server + 'html/filmplakat.php?id=' + MovieAddress);
    end;
  until pos('</OL>', Line) > 0;
end;

begin
  if CheckVersion(3,5,1) then
  begin
    //MovieName := GetField(fieldOriginalTitle);
    if MovieName = '' then
      MovieName := GetField(fieldTranslatedTitle);
    if Input('Filmposter-Archiv.de', 'Geben Sie den Namen den Films ein:', MovieName) then
    begin
      AnalyzePage('sent=1&language=german&productsearch=productsearch&filmtitel='+UrlEncode(MovieName), 1);
    end;
  end else
  ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.1)');
end.

Posted: 2008-10-30 22:13:15
by antp
Thanks
All times are UTC
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited