Here is the fixed version 1.0.4 of the OFDB script. It fixes following bugs.
- Parse correct movie address (with no onmouseover part)
- Import description fix. I've described this problem here already, but since the script wasn't updated yet I've included this fix in the new version.
Code: Select all
(***************************************************
Ant Movie Catalog importation script
www.antp.be/software/moviecatalog/
[Infos]
Authors=Fabian Filipczyk / fixed 20061222 bad4u / fixed 20070311 yeti
Title=OFDb
Description=Online-Filmdatenbank (OFDb) import with small picture (DE)
Site=http://www.ofdb.de
Language=DE
Version=1.0.4
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]
ReformatDescription=1|1|0=Do not reformat. Add the description as on OFDB|1=Reformat the description. Remove all Linefeeds and make a long flow text.
***************************************************)
(***************************************************
1.0.4 (02/12/2007) by DarkS
- Fix: Parse correct URL for movie address (with no onmouseover part)
- Fix: if the movie description on the first ofdb page has no [mehr]-Link, the
script adds an empty string only
1.0.3 (06/11/2007) by yeti (yeti@gmx.info)
- Fix: if the actors list on the first ofdb page have no [mehr]-Link, the
script adds an empty string only (thx DarkS)
1.0.2 (03/06/2007) by yeti (yeti@gmx.info)
- Chg: Code cleanup
- New: Option to import the description as is, include all line feeds.
Standard is reformat as before.
- Fix: The last change in actors loading from the cast/crew details page
reads the crew names too :( Hope I've finally fixed this now.
1.0.1 (03/04/2007) by yeti (yeti@gmx.info)
- Chg: Added stringUtils1-Lib and removed FindLine(), Code cleanup (not completed yet)
- Fix: If the actor-name in the details view is clickable to view the actors
profile, the name was not imported.
1.0.0 (03/03/2007) by yeti (yeti@gmx.info)
- Fix/Chg: Ratingimport changed to 2 digits (rounded)
Rating 6.49 -> Old: 7 -> New: 6.5
- Chg: Removed old code
- New: Version number 1.0.0 added for better distinction between versions
***************************************************)
program OFDB_DE;
uses
stringUtils1;
const
CRLF = #13#10;
var
MovieName: string;
procedure AnalyzePage(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
SetField(fieldURL, Address);
AnalyzeMoviePage(Page)
end else
begin
PickTreeClear;
LineNr := FindLine('<b>Titel:</b>', Page, 0);
if LineNr > 0 then
begin
PickTreeAdd('Filme :', '');
AddMoviesTitles(Page, LineNr);
if PickTreeExec(Address) then
AnalyzePage(Address);
end;
end;
Page.Free;
end;
procedure AnalyzeMoviePage(Page: TStringList);
var
Line, Temp, Value: string;
LineNr, LineNrTmp, IntValue: Integer;
BeginPos, EndPos: Integer;
begin
// Picture
LineNr := FindLine('images/film/', Page, 0);
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
Value := TextBetween(Line, '<img src="', '" alt=');
if Value <> '' then
begin
Temp := 'http://www.ofdb.de/' + Value;
GetPicture(Temp);
end;
end;
// Original Title
LineNr := Findline('Originaltitel:', Page, 0);
if LineNr > -1 then
begin
Line := Page.GetString(LineNr + 2);
HTMLRemoveTags(Line);
Line := Trim(Line);
if Line <> '' then SetField(fieldOriginalTitle, Line);
end;
// Translated Title
LineNr := Findline('sans-serif" size="3"><b>', Page, 0);
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
HTMLRemoveTags(Line);
Line := Trim(Line);
if Line <> '' then SetField(fieldTranslatedTitle,Line);
end;
// Country
LineNr := Findline('Herstellungsland:', Page, 0);
if LineNr > -1 then
begin
LineNr := LineNr + 3;
Line:= Page.GetString(LineNr);
Delete(Line, 1, Pos('<a', Line) - 1);
Line := StringReplace(Line, '<br><a', ', <br><a');
HTMLRemoveTags(Line);
SetField(fieldCountry, Line);
end;
// Year
LineNr := Findline('Erscheinungsjahr:', Page, 0);
if LineNr > -1 then
begin
LineNr := LineNr + 3;
Line:= Page.GetString(LineNr);
Delete(Line, 1, Pos('<a', Line) - 1);
Value := TextBetween(Line, '">', '</a></b>');
if Value <> '' then SetField(fieldYear, Value);
end;
// Category
LineNr := Findline('Genre(s):', Page, 0);
if LineNr > -1 then
begin
Value:= '';
LineNr := LineNr + 2;
Line:= Page.GetString(LineNr);
repeat
Line := TextAfter(Line, '<a');
Temp := TextBetween(Line, '">', '</a><br>');
if Temp <> '' then Value := Value + ', ' + Temp ;
until (Temp = '');
Value:= Copy(Value, 3, Length(Value) - 1);
SetField(fieldCategory, Value);
end;
// Actors
LineNr := Findline('Darsteller', Page, 0);
if LineNr > -1 then
begin
LineNr := LineNr + 3;
Line:= Page.GetString(LineNr);
Delete(Line, 1, Pos('<a', Line) - 1);
if Pos('">[mehr]', Line) > 0 then
begin
BeginPos := Pos('<a href="view.php?page=film_detail', Line) + 9;
EndPos := Pos('">[mehr]', Line);
Value := Copy(Line, BeginPos, EndPos - BeginPos);
GetOFDBActors(Value);
end else
begin
Line := StringReplace(Line, '<br><a', ', <br><a');
HTMLRemoveTags(Line);
SetField(fieldActors, Line);
end;
end;
// Director
LineNr := Findline('Regie', Page, 0);
if LineNr > -1 then
begin
Value := '';
LineNr := LineNr + 3;
Line := Page.GetString(LineNr);
Delete(Line, 1, Pos('<a', Line) - 1);
Line := StringReplace(Line, '<br><a', ', <br><a');
HTMLRemoveTags(Line);
SetField(fieldDirector, Line);
end;
// Description
LineNr := Findline('<b>Inhalt:</b>', Page, 0);
LineNrTmp := LineNr;
if LineNr > -1 then
begin
LineNr := Findline('<a href="view.php?page=inhalt', Page, 0);
if LineNr > -1 then
begin //"[mehr]" part exists
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 else
begin //No "[mehr]" part exists
Line := Page.GetString(LineNrTmp);
Value := TextBetween(Line, '<b>Inhalt:</b>', '</p></font></td>');
SetField(fieldDescription, FullTrim(Value));
end;
end;
// Rating
LineNr := Findline('<br>Note:', Page, 0);
if LineNr > -1 then
begin
Line:= Page.GetString(LineNr);
BeginPos := Pos('<br>Note:',Line) + 10;
// I had to add 0.1 here to make the rounding more precise
Value := IntToStr(Round((StrToInt(Copy(Line, BeginPos+2, 2), 0) + 0.1) / 10));
if StrToInt(Value,0) > 9 then
Value := IntToStr(StrToInt(StrGet(Line, BeginPos),0) + 1) + '.0'
else
Value := StrGet(Line, BeginPos) + '.' + Value;
SetField(fieldRating, Value);
end;
end;
procedure GetOFDBActors(Address: string);
var
Line,Temp, Value: string;
LineNr, EndLine: Integer;
Page: TStringList;
begin
Page := TStringList.Create;
Page.Text := GetPage('http://www.ofdb.de/'+Address);
LineNr := Findline('Darsteller', Page, 0);
if LineNr > -1 then
begin
Value:= '';
EndLine := FindLine('/table', Page, LineNr); // Find the end of the cast-table
repeat
LineNr := Findline('<a href="view.php?page=', Page, LineNr + 1);
if LineNr >= EndLine then LineNr := -1; // Cast-Table ended, leave loop
if LineNr > -1 then
begin
Line := Page.GetString(LineNr);
Delete(Line, 1, pos('<a href="view.php?page=', Line) + 22);
Temp := TextBefore(Line, '=', '');
if (Temp = 'person&id') Or (Temp = 'liste&Name') then
begin
Temp := TextBetween(Line, '">', '</a>');
HTMLRemoveTags(Temp);
if Temp <> '' then Value := Value + ', ' + Temp;
end;
end;
until (LineNr < 0);
Value:= copy(Value, 3,length(Value)-1);
SetField(fieldActors, Value);
end;
Page.Free;
end;
procedure GetDescriptions(Address: string);
var
Line, Value, Temp: string;
LineNr: Integer;
Page: TStringList;
Reformat: Boolean;
begin
Value := '';
if GetOption('ReformatDescription') = 1 then Reformat := True else Reformat := False;
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);
Line := TextAfter(Line, '</a></b><br><br>');
while (Pos('<br />', Line) > 0) do
begin
Temp := TextBefore(Line, '<br />', '');
if Not Reformat then
begin
Value := Value + Temp + CRLF;
end else
begin
if Temp <> '' then Value := Value + Temp + ' ';
end
LineNr := LineNr + 1;
Line := Page.GetString(LineNr);
end;
Value := Value + TextBefore(Line, '</font></p>', '');
SetField(fieldDescription, Value);
end;
Page.Free;
end;
procedure AddMoviesTitles(Page: TStringList; var LineNr: Integer);
var
Line: string;
MovieTitle, MovieAddress, CutMark, CutMarkAddress: string;
StartPos, EndPos: Integer;
begin
Line := Page.GetString(LineNr);
repeat
CutMark := '">';
CutMarkAddress := '" ';
StartPos := Pos('<a href="view.php?page=film&fid=', Line);
if StartPos = 0 then
begin
StartPos := Pos('<a href=''view.php?page=film&fid=', Line);
CutMark := '''>';
CutMarkAddress := ''' ';
end;
if StartPos > 0 then
begin
Delete(Line, 1, StartPos + 8);
MovieAddress := TextBefore(Line, CutMarkAddress, '');
MovieTitle := TextBetween(Line, CutMark, '</a>');
HTMLRemoveTags(MovieTitle);
if (MovieAddress <> '') And (MovieTitle <> '') then
begin
//MovieAddress := MovieAddress + '&full=1';
PickTreeAdd(MovieTitle , 'http://www.ofdb.de/' + MovieAddress);
end else
StartPos := -1; // Error - Leave the Loop
end;
until (StartPos < 1);
end;
begin
if CheckVersion(3,5,0) then
begin
MovieName := GetField(fieldOriginalTitle);
if MovieName = '' then
MovieName := GetField(fieldTranslatedTitle);
if Input('OFDb', 'Bitte Titel eingeben :', MovieName) then
begin
AnalyzePage('http://www.ofdb.de/view.php?page=suchergebnis&SText='+UrlEncode(MovieName)+'&Kat=All');
end;
end else
ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.0)');
end.
