[Release] Script for filmposter-archiv.de

If you made a script you can offer it to the others here, or ask help to improve it. You can also report here bugs & problems with existing scripts.
Post Reply
Nik0
Posts: 15
Joined: 2003-03-15 11:20:01

[Release] Script for filmposter-archiv.de

Post 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.
Last edited by Nik0 on 2003-03-19 15:04:30, edited 6 times in total.
Guest

Post by Guest »

Great ! Exactly what I was looking for... But unfortunately it only produces an error...: "MAIN an Position 1881 (syntax error)"
Nik0
Posts: 15
Joined: 2003-03-15 11:20:01

Post by Nik0 »

hmm, perhaps it was the ) in the copyright note

try the updated text
antp
Site Admin
Posts: 9630
Joined: 2002-05-30 10:13:07
Location: Brussels
Contact:

Post 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 ?
Nik0
Posts: 15
Joined: 2003-03-15 11:20:01

Post by Nik0 »

thanks!
Nik0
Posts: 15
Joined: 2003-03-15 11:20:01

Post 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
antp
Site Admin
Posts: 9630
Joined: 2002-05-30 10:13:07
Location: Brussels
Contact:

Post by antp »

ok
Nik0
Posts: 15
Joined: 2003-03-15 11:20:01

Post by Nik0 »

site is down :(
Nik0
Posts: 15
Joined: 2003-03-15 11:20:01

Post 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.
SpeedCore
Posts: 2
Joined: 2007-09-06 08:57:09

Post 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
antp
Site Admin
Posts: 9630
Joined: 2002-05-30 10:13:07
Location: Brussels
Contact:

Post 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.
bad4u
Posts: 1148
Joined: 2006-12-11 22:54:46

Post 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 ;)
SpeedCore
Posts: 2
Joined: 2007-09-06 08:57:09

Post 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?
bad4u
Posts: 1148
Joined: 2006-12-11 22:54:46

Post 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);
Nik0
Posts: 15
Joined: 2003-03-15 11:20:01

Post 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.
antp
Site Admin
Posts: 9630
Joined: 2002-05-30 10:13:07
Location: Brussels
Contact:

Post by antp »

Thanks
Post Reply