[REL] [ENG] auto.tv.com is new automated script for tv.com

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
HappyTalk
Posts: 19
Joined: 2006-11-02 23:44:37

[REL] [ENG] auto.tv.com is new automated script for tv.com

Post by HappyTalk »

Auto.Tv.Com Version=1.07.01.16 (will update this top bit when/if edited)
-2007.01.16 - fixed to match new tv.com code re getting login/signup

--------------------------------------------------------------------

Here's a new fully automated tv.com script. It uses 2 files (both below)
Enjoy...
-------------------------
Inspired by the tvtome script by Alex Iribarren & original tv.com script by nalf75014.

I added full automation using intelligent soundex name searching and caching as much info as possible. It will happily grab 1,000's of entries unmonitored if suitably named eg:
series.xx.xxxxx.episode or series.episode etc
You may change . seperator to other using options

1) Unchecks items it modifies, so run first pass using a full automation mode then again for checked items, not found in an interactive mode.

2) Puts title grabbed from tv.com in 'TranslatedTitle' field for fast
human cross checking that correct eps were auto-grabbed.

When running script remember when it hits Results Dialog (if turned on) to press 'save all' so it will run automated and not re-prompt you.

Code has other commented out lines I used sometimes that may be of use, uncomment at will to aid automation. Heavily road tested.


The 2 files you need may be downloaded from here:-
http://antp.be/temp/scripts/auto.tv.com.ifs &
http://antp.be/temp/scripts/AutoUtils.pas

--------------------
Here they are in regular text format:-

auto.tv.com.ifs

Code: Select all

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

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

[Infos]
Authors=HappyTalk
Title=Auto.TV.Com
Description=Automated TV series import from tv.com
Site=http://www.tv.com
Language=EN
Version=1.07.01.16
Requires=3.5.0
Comments=inspired by the tvtome script by Alex Iribarren & original tv.com script by nalf75014. ||I added full automation using intelligent soundex name searching and caching|as much info as possible. It will happily grab 1,000's of entries unmonitored |if suitably named eg:|series.xxx.episode  Where xxx is anything|You may change . seperator to other using options||1) Unchecks items it modifies, so run first pass using a full automation mode|then again for checked items , not found in an interactive mode.||2) Puts title grabbed from tv.com in 'TranslatedTitle' field for fast |human cross checking that correct eps were auto-grabbed.||When running script remember when it hits Results Dialog (if turned on) |to press 'save all' so it will run automated and not re-prompt you.||Code has other commented out lines I used sometimes that may be of use, |uncomment at will to aid automation. Heavily road tested.||Cheers
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]
SortEpisodePicker=0|1|1=Yes|0=No
AutoMode=1|0|0=  Prompt with menu|1=  Prompt for series and episode match on every search|2=  Prompt for series only when changes|3=  Never Prompt for series|4=  Never prompt for series or episode matches
Seperator=0|0|0=.   (dot)|1=-   (hyphen/minus)|2=   (space)|3=_   (underscore)|4=(  (open bracket)
NamingStyle=1|0|0=series.episode / series.xxx.episode|1=series.episode.xxx / series.xxx.episode.xxx
MatchMethod=0|0|0=Alpha+SoundEx|1=Alpha Only|2=SoundEx Only|3=AlphaNum Only|4=AlphaNum+SoundEx

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

program Auto_TV_Com;
uses
  AutoUtils;
var
  EpName, EpNumber, SeName: string;
  MovieName: string;
  arraySeName, CalcSeName, Prev_CalcSEname, Prev_SeAddress, Sep : String;
  temp1 : String;
  AutoMode, NamingStyle, MatchMethod: Integer;
  arrayEpName, arrayEpAddr, arrayEpAlpha, arrayEpSoundEX : array of string;
  arrayEpCnt, arrayEpSize: Integer;



function AutoMenu() : Integer;
var
  Sel: string;
begin
  PickTreeClear;
  PickTreeAdd('1. Prompt for series and episode match on every search', '1');
  PickTreeAdd('2. Prompt for series only when changes', '2');
  PickTreeAdd('3. Never Prompt for series', '3');
  PickTreeAdd('4. Never prompt for series or episode matches', '4');

  PickTreeExec(Sel);
  result := StrToInt(Sel, 0);
end;

//The letters A,E,I,O,U,Y,H,W and other characters are not coded.
function GetSepOption() : String;
begin
  result := '.'; //default
  Case GetOption('Seperator') of
    0 : result := '.';
    1 : result := '-';
    2 : result := ' ';
    3 : result := '_';
    4 : result := '(';
  end;
end;

procedure AnalyzeEpListing(Address: string);
var
  Page: TStringList;
  LineNr, StartPos, EndLine, MatchCnt, i, EpIX: Integer;
  Line, EpTitle, EpNr, Conv_EpName: string;
begin
  if (SeName <> arraySeName) then // populate array with episodes,address
  begin
    Page := TStringList.Create;
    Address := Address + 'episode_listings.html';
    Page.Text := PostPage(Address, URLEncode('season=0'));
    ArrayEpCnt := 0;
    
    LineNr := FindLine('Click here to continue to TV.com', Page, 0);
    if LineNr > -1 then
    begin
        Line := Page.GetString(LineNr);
        Page.Free;
        AnalyzeResults(SeName);
        Exit;
    end
    
    // fill array with all episodes
    LineNr := FindLine('<td class="', Page, LineNr);
    LineNr := FindLine('<td class="', Page, LineNr+1);
    EndLine := FindLine('</table>', Page, LineNr);
    repeat
      LineNr := FindLine('<a href="', Page, LineNr);
      Line := Page.GetString(LineNr);
      if (LineNr > -1) and (pos ('class="f-930"', Line) = 0) and (pos ('img src', Line) = 0)  then
      begin
        EpTitle := LineTextBetween('">', 0, '</a', 0, Line, True);
//        HTMLDecode(EpTitle);
        if EpTitle <> '' then
        begin
          arrayEpName[ArrayEpCnt] := EpTitle;
          arrayEpAddr[ArrayEpCnt] := LineTextBetween('"', 0, '">', 0, Line, False);
          if AutoMode > 1 then
          begin
            if (MatchMethod > 2) then
            begin
              arrayEpAlpha[ArrayEpCnt] :=  ConvertAlphaNum(EpTitle); //Only Match Alpha & Num chars (To use must uncomment other occurence further on as well!)
            end else
              arrayEpAlpha[ArrayEpCnt] :=  ConvertAlpha(EpTitle); //Only match alpha chars (ignore punctuation, numbers etc)
              
            if (MatchMethod <> 1) and (MatchMethod <> 3) then arrayEpSoundEX[ArrayEpCnt] :=  ConvertSoundEx(EpTitle);
          end;
          ArrayEpCnt := ArrayEpCnt + 1;
        end;
      end
      LineNr := LineNr + 1;
    until (LineNr > EndLine) or (ArrayEpCnt >= arrayEpSize);
    
    Page.Free;
    arraySeName := SeName; // series currently stored
  end;

  if ArrayEpCnt = 0 then exit; //no matches
  EpIX := 0;

  // pass 1: store only matches in picker
  if (AutoMode > 1) then //1 => don't do computer search, user will select
  begin
    PickTreeClear;
    PickTreeAdd('Episode matches for "' + EpName + '" (' + GetField(fieldSource) + ')', '');
    MatchCnt := 0;

    if (MatchMethod > 2) then
    begin
      Conv_EpName := ConvertAlphaNum(EpName) //Only Match Alpha & Num chars
    end else
      Conv_EpName := ConvertAlpha(EpName); //Only match alpha chars (ignore punctuation, numbers etc)

    if (MatchMethod <> 2) then
    begin
      for i := 0 to ArrayEpCnt - 1 do
      begin
  //      if pos(Conv_EpName, arrayEpAlpha[i]) <> 0 then //look for ep name within tv.com one (as tv.com may have (aka other name) )
        if (Conv_EpName = arrayEpAlpha[i]) then //exact match tv.com name
        begin
          PickTreeAdd(arrayEpName[i] + ' (' + IntToStr(i+1) + ')', IntToStr(i));
          MatchCnt := MatchCnt + 1;
          EpIX := i; //store match, if only 1 match we will use this value
        end;
      end;
    end;
    
    
    if (MatchMethod <> 1) and (MatchMethod <> 3) then
    begin
      Conv_EpName := ConvertSoundEx(EpName); //no exact matches try soundex compare
      if (MatchCnt = 0) then //no exact matches try more liberal soundex compare
        for i := 0 to ArrayEpCnt - 1 do
        begin
          if pos(Conv_EpName, arrayEpSoundEx[i]) <> 0 then
          begin
            PickTreeAdd(arrayEpName[i] + ' (' + IntToStr(i+1) + ')', IntToStr(i));
            MatchCnt := MatchCnt + 1;
            EpIX := i;
          end;
        end;

      if (MatchCnt = 0) then //no exact matches try more liberal soundex compare
        for i := 0 to ArrayEpCnt - 1 do
        begin
          if SoundExIn(Conv_EpName, arrayEpSoundEx[i]) then //find words in any order
          begin
            PickTreeAdd(arrayEpName[i] + ' (' + IntToStr(i+1) + ')', IntToStr(i));
            MatchCnt := MatchCnt + 1;
            EpIX := i;
          end;
        end;
    end;
  end;
  
  if (AutoMode < 4) then // 4 => dont prompt user
  begin
    if (MatchCnt > 1) then
      if PickTreeExec(EpNr) then //select from matches or if cancel select from all
      begin
        EpIX := StrToInt(EpNr, 0);
        MatchCnt := 1;
      end else
        MatchCnt := 0;

    //pass 2: store all in picker for user choice if no matches or cancel in pass1
    if  (MatchCnt = 0) then
    begin
      PickTreeClear;
      PickTreeAdd('All episodes for "' + EpName + '" (' + GetField(fieldSource) + ')', '');

      for i := 0 to ArrayEpCnt - 1 do //add (count) after Ep Name so after sort still have epnum
        PickTreeAdd(arrayEpName[i] + ' (' + IntToStr(i+1) + ')', IntToStr(i));

      If GetOption('SortEpisodePicker') = 1 then PickTreeSort; //sort will random order if have same name eg 'episodis weird
      if PickTreeExec(EpNr) then //user select from all episodes
      begin
        EpIX := StrToInt(EpNr, 0);
        MatchCnt := 1;
      end;
    end;
  end;

  if (MatchCnt = 1) then
  begin
    EpName := arrayEpName[EpIX];
    AnalyzeEpisodePage(arrayEpAddr[EpIX]);
  end;
end;

procedure AnalyzeEpisodePage(Address: string);
var
  Line, TempStr, GuestStars, EpNr, Season, EpTitle: string;
  BeginPos, Tmp, StartPos: Integer;
  Page: TStringList;
  LineNr: Integer;
begin
  Page := TStringList.Create;
  Page.Text := GetPage(Address);

  // URL - OK
  SetField(fieldURL, Address);

  // Set Trans title = Episode Name got from tv.com
  if EpName <> '' then
    SetField(fieldTranslatedTitle, EpName);

  // First Aired + Production Code - OK
  LineNr := FindLine('First Aired:', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr);
    CutAfter(Line,'<span class="f-bold f-666">');
    SetField(fieldYear, copy(Line, pos(', ',Line)+2, 4));
    SetField(fieldComments,'Production Code: ' + copy(Line, pos('Code: ', Line) + 6, 4))
  end;
  
  // Rating  - OK
  LineNr := FindLine('<span class="f-28 f-bold mt-10 mb-10 f-FF9 db lh-18">', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr);
    TempStr := copy(Line, pos('">', Line) + 2, 3);
    SetField(fieldRating, TempStr);
  end;
  
  // Writer - OK
  LineNr := FindLine('Writer:', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr + 3);
    CutAfter(Line,'>');
    TempStr := copy(Line, 1, pos('</a>',Line)-1);
    HTMLRemoveTags(TempStr);
    if TempStr <> '' then SetField(fieldProducer, 'Writer: ' + TempStr);
  end;
  
  // Director - OK
  LineNr := FindLine('Director:', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr + 3);
    CutAfter(Line,'>');
    TempStr := copy(Line, 1, pos('</a>',Line)-1);
    HTMLRemoveTags(TempStr);
    SetField(fieldDirector, TempStr);
  end;
  
  // Description - OK
  Line := PageTextBetween('class="f-11 f-bold">Watch Video</a>', 2, '<div class="ta-r mt-10 f-bold">', -1, Page, 0, true);
  if (Line = '') then
    Line := PageTextBetween('<div id="main-col">',3,'<div class="ta-r mt-10 f-bold">', -1, Page, 0, true);
  if (Line <> '') then
    SetField(fieldDescription, Line);

  // Cast
  // Guest Stars

  LineNr := FindLine('Guest Star:', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr + 3);
    TempStr := Trim(Line);
    HTMLRemoveTags(TempStr);
    repeat
      Tmp := Length(TempStr);
      TempStr := StringReplace(TempStr, '  ', ' ');
    until Length(TempStr) = Tmp;
    TempStr := StringReplace(TempStr, ' ,', ',');
    TempStr := StringReplace(TempStr, ' ', '');
    GuestStars := TempStr;
  end;
  
  LineNr := FindLine('Star:', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr + 3);
    TempStr := Trim(Line);
    HTMLRemoveTags(TempStr);
    repeat
      Tmp := Length(TempStr);
      TempStr := StringReplace(TempStr, '  ', ' ');
    until Length(TempStr) = Tmp;
    TempStr := StringReplace(TempStr, ' ,', ',');
    TempStr := StringReplace(TempStr, ' ', '');
    SetField(fieldActors, TempStr + #13#10 + 'Guest stars: ' + GuestStars);
  end;

  SetField(fieldChecked, ''); // uncheck any items we set

  Page.Free;
end;

procedure CutAfter(var Str: string; Pattern: string);
begin
  Str := Copy(str, Pos(Pattern, Str) + Length(Pattern), Length(Str));
end;

function StringReplaceAll(S, Old, New: string): string;
begin
  while Pos(Old, S) > 0 do
    S := StringReplace(S, Old, New);
  Result := S;
end;

procedure AnalyzeResults(var Search: string);
var
  Page: TStringList;
  LineNr, StartPos, EndLine, SeCnt: Integer;
  Line, Tmp, Address, SeDesc: string;
begin
  if (SeName = arraySeName) then // and (Prev_SeAddress <> '')
  begin
    AnalyzeEpListing(''); //Address
  end else
  begin
    Page := TStringList.Create;
    Page.Text := GetPage('http://www.tv.com/search.php?qs=' + URLEncode(Search) + '&type=11&stype=all&tag=search%3Bbutton');
    LineNr := FindLine('<table id="search-results"', Page, 0);
    if LineNr <> -1 then // if no results found quit out
    begin
      EndLine := FindLine('</table>', Page, LineNr);
      PickTreeClear;
      PickTreeAdd('Series Matches for "' + Search + '" (' + GetField(fieldOriginalTitle) + ')', '');
      repeat
        LineNr := FindLine('<span class="f-18">Show:', Page, LineNr); //LineNr := FindLine('<a href="', Page, LineNr);
        if LineNr > -1 then
        begin
          Line := PageTextBetween('',0 ,'<p class="m-0">', 0, Page, LineNr, False);
          SeDesc := StripSpace(Line, 2, true);
          if (SeDesc <> '') then // or (GetOption('OnlySeriesWithDescription') = 0)
          begin
            Address := LineTextBetween('"http', -4, 'summary.html?', 0, Line, False); //new
            if Address <> '' then
            begin
              PickTreeAdd(SeDesc, Address);
              SeCnt := SeCnt + 1;
            end;
          end;
          LineNr := LineNr + 1;
        end;
      until (LineNr < 0) or (LineNr > EndLine) or ((AutoMode >= 3) and (SeCnt > 0));
    end;

    if (SeCnt > 0) then // matches found
    begin
      if (AutoMode <= 2) then //and (SeCnt > 1) if 1 entry or AF > 2 => use 1st entry
        if not PickTreeExec(Address) then exit; // press cancel => quit proc
      AnalyzeEpListing(Address);
    end else
      SeName := ''; //clear series name as is no good
  end;
end;

begin
  if CheckVersion(3,5,0) then
  begin
    if AutoMode = 0 then
    begin
      AutoMode := (GetOption('AutoMode'));
      NamingStyle := (GetOption('NamingStyle'));
      MatchMethod := (GetOption('MatchMethod'));
      
      if AutoMode = 0 then AutoMode := AutoMenu();
      if AutoMode = 0 then exit;
      arrayEpSize := 1000;  // max number of episodes to store at once, increase if required
      SetArrayLength(arrayEpName, arrayEpSize);
      SetArrayLength(arrayEpAddr, arrayEpSize);
      SetArrayLength(arrayEpSoundEX, arrayEpSize);
      SetArrayLength(arrayEpAlpha, arrayEpSize);
      Sep := GetSepOption;
    end;
    
    CalcSeName := GetField(fieldOriginalTitle);
    CalcSeName := nposLeft(Sep, CalcSeName, 1, false);
    if CalcSeName = '' then CalcSeName := Prev_CalcSeName; // if no series name found keep last name
    if (CalcSeName = '') or (CalcSeName <> Prev_CalcSeName) or (AutoMode = 1) then // or (Prev_SeName = '')
    begin //only prompt new series name if changed or AF=1
      SeName := CalcSeName; //computer guess at series
      if (AutoMode <= 2) then // use calc name if AutoMode >= 3
        if not (Input('TV.com Import', 'Series Name for ' + GetField(fieldOriginalTitle), SeName)) then exit; //SeName := '';
    end;
    
    if SeName <> '' then
    begin
      EpName := GetField(fieldOriginalTitle);
      if (NamingStyle = 0) then EpName := nposRight(Sep, EpName, 1, true); // get string after last dot eg (Lost.1x01.Pilot = Pilot)
      if (NamingStyle = 1) then EpName := nposLeft(Sep, nposRight(Sep, EpName, 2, true), 1, false); // get string after second last dot & before last eg (Lost.1x01.Pilot.01 = Pilot)
      AnalyzeResults(SeName);
    end;
    Prev_CalcSeName := CalcSeName;
  end else
    ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.0)');
    exit;
end.
AutoUtils.pas

Code: Select all

unit AutoUtils;

(***************************************************
AutoUtils by HappyTalk 2006.
Unit to add string, soundex and other functions to ANT
scripts. You may use unit in your scripts.
Please do not modify this original file, make a newly
named one. you can redistribute it and/or modify it under 
the terms of the GNU General Public License

--------------------------------------------------
v1.06.11.24 
Original release. Currently used by
Auto.TV.Com
Auto.IMDB.Com
and other scripts
--------------------------------------------------

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


const AutoUtils_Version = 1;

//-----------------------------
// MATHS FUNCTIONS
//-----------------------------
// rets min of 2 values
function Min(X, Y: Integer): Integer;
begin
  if X < Y then Min := X else Min := Y;
end;

// rets max of 2 values
function Max(X, Y: Integer): Integer;
begin
  if X > Y then Max := X else Max := Y;
end;



//-----------------------------
// STRING FUNCTIONS
//-----------------------------
Function stringReverse(S : String): String;
Var
   i : Integer;
Begin
   Result := '';
   For i := Length(S) DownTo 1 Do
   Begin
     Result := Result + Copy(S,i,1) ;
   End;
End;

//finds pos of last sFind in sStr
Function revpos(sFind, sStr: string; p: Integer) : Integer;
var
p2: Integer;
begin
  result := 0;
  if Length(Sstr) >= p then
  begin
    //p2 := pos(sFind, copy(sStr, p, length(sStr)- p + 1)) + p - 1;
    p2 := pos(sFind, StrMid(sStr, p, 0)) + p - 1;
    if p2 >= p then result := p2
  end;
end;

// returns the pos of nth instance of sFind found in sStr going from reverse of string to start
Function nposrev(sFind, sStr: string; n: Integer) : Integer;
var
sFindRev, sStrRev: string;
p: Integer;
begin
  sFindRev := stringReverse(sFind);
  sStrRev := stringReverse(sStr);

  p := npos(sFindRev, sStrRev, n);
  if p > 0 then
    result := Length(sStr) - p - Length(sFind) + 2
  else
    result := 0;
end;

// returns pos of sFind in sStr from position p in str
Function ppos(sFind, sStr: string; p: Integer) : Integer;
var
p2: Integer;
begin
  result := 0;
  if Length(Sstr) >= p then
  begin
    //p2 := pos(sFind, copy(sStr, p, length(sStr)- p + 1)) + p - 1;
    p2 := pos(sFind, StrMid(sStr, p, 0)) + p - 1;
    if p2 >= p then result := p2
  end;
end;

// returns the pos of nth instance of sFind found in sStr or 0 if none.
Function npos(sFind, sStr: string; n: Integer) : Integer;
var
p: Integer;
begin
  result := 0;
  p := 0;
  repeat
    p := ppos(sFind, sStr, p+1);
    n := n - 1;
  until (p = 0) or (n = 0);
  result := p;
end;

// gets the right hand string AFTER nth instance of sFind in sStr,
// if bReverse nth instance is nth from end working backwards
Function nposRight(sFind, sStr: string; n: Integer; bReverse: boolean) : string;
var
p: integer;
begin
  result := '';
  if bReverse then
    p := nposrev(sFind, sStr, n) + Length(sFind) // set to pos AFTER nth occurrence
  else
    p := npos(sFind, sStr, n) + Length(sFind); // set to pos AFTER nth occurrence
  if (p > Length(sFind)) and (p <= Length (sStr)) then
    result := StrMid(sStr, p, 0);
end;

// gets the left hand string BEFORE nth instance of sFind in sStr
Function nposLeft(sFind, sStr: string; n: Integer; bReverse: boolean) : string;
var
p: integer;
begin
  result := '';
  if bReverse then
    p := nposrev(sFind, sStr, n) - 1 // set to pos BEFORE nth occurrence
  else
    p := npos(sFind, sStr, n) - 1; // set to pos BEFORE nth occurrence

  if (p > 0) then
    result := StrLeft(sStr, p);
end;


Function StrLeft(str: string; len: Integer) : string;
begin
  result := copy(str,1,len);
end;

Function StrRight(str: string; len: Integer) : string;
begin
  result := copy(str,Max(1,length(str)-len+1), len);
end;

// rets len chars from position p or rest if len=0
Function StrMid(str: string; p, len: Integer) : string;
begin
  if len = 0 then len := length(str)- p + 1;
  result := copy(str,p,len);
end;


// replaces all occurences of sFind with sReplace in sStr from after n'th instance of sFind
function nposReplaceString(sFind, sReplace: string; sStr: string; n:Integer): string;
var
  p: Integer;
begin
  p := npos(sFind, sStr, n) + 1;
  if p > 1 then
    sStr := posReplaceString(sFind, '', sReplace, sStr, p);
  result := sStr;
end;


// replaces all occurences of text between sFindBeg & sFindEnd with sReplace in sStr from position FBeg onwards
// sFindEnd can be '' to only replace sFindBeg's not range
// sReplace can be '' to just erase each occurence
function posReplaceString(sFindBeg, sFindEnd, sReplace: string; sStr: string; FBeg: Integer): string;
var
  FEnd: Integer;
begin
  if FBeg < 1 then FBeg := 1;
  while (true) do
  begin
    FBeg := ppos(sFindBeg, sStr, FBeg);
    if FBeg = 0 then break;

    if sFindEnd <> '' then
    begin
      FEnd := ppos(sFindEnd, sStr, FBeg+1);
      if FEnd = 0 then break;
      FEnd := FEnd + Length(sFindEnd);
    end else
      FEnd := FBeg + Length(sFindBeg);

    delete(sStr, FBeg, FEnd-FBeg);
    if sReplace <> '' then insert(sReplace, sStr, FBeg);
    FBeg := FBeg + Length(sReplace);
    if FBeg > Length(sStr) then Break;
  end;
  result := sStr;
end;


// Removes all space from start and end and ensures there is no more than SpCnt consecutive space inside string
// also Strips HTML out if required
Function StripSpace(s: string; SpCnt: Integer; StripHTML: Boolean) : string;
var
i, cnt: Integer;
s2, ch: string;
begin
  s2 := '';
  s := Trim(s);
  For i := 1 To Length(s) do
  begin
    ch := copy(s, i, 1);
    if (ch = ' ') then
    begin
      if (cnt < SpCnt) then
      begin
        s2 := s2 + ch;
        cnt := cnt + 1;
      end;
    end else
    begin
      s2 := s2 + ch;
      cnt := 0;
    end;
  end;

  if (StripHTML) and (Length(s2) > 0)  then
  begin
    HTMLRemoveTags(s2);
    HTMLDecode(s2);
  end;

  result := s2;
end;


// ConvertAlphaSpace: converts certain punc chars to space(only allows 1 consecitive space) + removes numbers & rets rest as lower case
Function ConvertAlphaSpace(s: string) : string;
var
i: Integer;
s2, ch: string;
begin
    s := AnsiLowerCase(s);
    s2 := '';
    For i := 1 To Length(s) do
    begin
        ch := copy(s, i, 1);
        if (ch >= 'a') and (ch <= 'z') then
          s2 := s2 + ch
        else
        begin
          case ch of
            ' ', '-', ':', '*', '?', '"', '<', '>', '.', '_', '\', '/', '|' : If StrRight(s2, 1) <> ' ' Then s2 := s2 + ' ';
          end;
        end;
    end;
    result := Trim(s2);
end;

// ConvertAlpha: removes from a string all non alpha chars (inc spaces) and rets rest as lower case
Function ConvertAlpha(s: string) : string;
var
i: Integer;
s2, ch: string;
begin
    s := AnsiLowerCase(s);
    s2 := '';
    For i := 1 To Length(s) do
    begin
      ch := copy(s, i, 1);
      if (ch >= 'a') and (ch <= 'z') then
        s2 := s2 + ch;
    end;
    result := s2;
end;

// ConvertAlphaNum: removes from a string all non alphanum chars (inc spaces) and rets rest as lower case
Function ConvertAlphaNum(s: string) : string;
var
i: Integer;
s2, ch: string;
begin
    s := AnsiLowerCase(s);
    s2 := '';
    For i := 1 To Length(s) do
    begin
      ch := copy(s, i, 1);
      if ((ch >= 'a') and (ch <= 'z')) or ((ch >= '0') and (ch <= '9')) then
        s2 := s2 + ch;
    end;
    result := s2;
end;


//-----------------------------
// LOCATE TEXT FUNCTIONS
//-----------------------------
// accumulates all lines between those containing FindBeg & FindEnd strings (inclusive) offset by OffBeg & OffEnd
// BegFind can = EndFind to get same line if BegOff=0
function PageTextBetween(BegFind: string; BegOff: Integer; EndFind: string; EndOff: Integer; Page: TStringList; LineNr: Integer; StripHTML: Boolean): string;
var
BegPos, EndPos, i: Integer;
Line: string;
begin
  result := '';
  if BegFind = '' then
    BegPos := LineNr // if no beg string go from current pos
  else
    BegPos := FindLine(BegFind, Page, LineNr);// + BegOff;

  if BegPos > -1 then
  begin
    if EndFind = '' then
      EndPos := BegPos
    else
      EndPos := FindLine(EndFind, Page, BegPos);

    if EndPos > -1 then
    begin
      BegPos := BegPos + BegOff;
      EndPos := EndPos + EndOff;
      for i := BegPos to EndPos do
      begin
        Line := Line + Page.GetString(i);
      end;
      Line := Trim(Line);
      if StripHTML then
      begin
        HTMLRemoveTags(Line);
        HTMLDecode(Line);
      end;
      result := Line;
    end;
  end;
end;

// rets text between BegFind & EndFind use BegOff & EndOff to reposition
function LineTextBetween(BegFind: string; BegOff: Integer; EndFind: string; EndOff: Integer; Line: string; StripHTML: Boolean): string;
var
BegPos, EndPos, i: Integer;
begin
  result := '';
  BegPos := pos(BegFind, Line);
  if BegPos = -1 then exit;
  EndPos := ppos(EndFind, Line, BegPos+1);
  if EndPos = -1 then exit;

  BegPos := BegPos + Length(BegFind) + BegOff; //Beg = 1st char after BegFind
  EndPos := EndPos + EndOff; //End = 1st Char off EndFind

  if (BegPos <= EndPos) and (BegPos > 0) and (EndPos < Length(Line)) then
  begin
    Line := copy(Line, BegPos, EndPos-BegPos);
    if StripHTML then
    begin
      HTMLRemoveTags(Line);
      HTMLDecode(Line);
    end;
    result := Line;
  end;
end;


function FindLine(Pattern: string; List: TStringList; StartAt: Integer): Integer;
var
  i, Cnt: Integer;
begin
  result := -1;
  if StartAt < 0 then
    StartAt := 0;
  Cnt := List.Count-1;
  for i := StartAt to Cnt do
    if Pos(Pattern, List.GetString(i)) <> 0 then
    begin
      result := i;
      Break;
    end;
end;


function FindLineNoCase(Pattern: string; List: TStringList; StartAt: Integer): Integer;
var
  i: Integer;
begin
  result := -1;
  Pattern :=  AnsiLowerCase(Pattern);
  if StartAt < 0 then
    StartAt := 0;
  for i := StartAt to List.Count-1 do
    if Pos(Pattern, AnsiLowerCase(List.GetString(i)));; <> 0 then
    begin
      result := i;
      Break;
    end;
end;


function FindLineAlpha(Pattern: string; List: TStringList; StartAt: Integer): Integer;
var
  i: Integer;
begin
  result := -1;
  Pattern :=  ConvertAlpha(Pattern);
  if StartAt < 0 then
    StartAt := 0;
  for i := StartAt to List.Count-1 do
    if Pos(;Pattern, ConvertAlpha(List.GetString(i))) <> 0 then
    begin
      result := i;
      Break;
    end;
end;


// do fuzzy search
function FindLineSoundEx(Pattern: string; List: TStringList; StartAt: Integer): Integer;
var
  i: Integer;
begin
  result := -1;
  Pattern :=  ConvertSoundEx(Pattern);
  if StartAt < 0 then
    StartAt := 0;
  for i := StartAt to List.Count-1 do
    if SoundExComp(Pattern,List.GetString(i)) then
    begin
      result := i;
      Break;
    end;
end;




//-----------------------------
// SOUNDEX FUNCTIONS
//-----------------------------
Function ConvertSoundEx(sSent: string) : string;
var
Pos1,Pos2,SLen: Integer;
s, wrd: string;
begin
    sSent := ConvertAlphaSpace(sSent);
    //sSent = ValidateChars(sSent) 'replace dodgy chars with spaces
    SLen := Length(sSent);
    Pos1 := 1;
    s := '';
    Repeat
        Pos2 := ppos( ' ', sSent,Pos1); //look for rest of str
        If Pos2 = 0 Then Pos2 := SLen + 1;
        wrd := copy(sSent, Pos1, Pos2 - Pos1);
        s := s + SoundEx(wrd);
        Pos1 := Pos2 + 1;
    Until Pos1 > SLen;
    result := s;
end;

//takes 2 soundex strings looks for soundex string(s) sStr2 in sStr1. does as 4 char comps
Function SoundExIn(sFind, sStr: string) : Boolean;
var SLen, i, MatchCnt: Integer;
begin
    SLen := Length(sFind) DIV 4;
    MatchCnt := 0;
    for i := 0 to SLen-1 do
    begin
        if (pos(copy(sFind, i * 4 + 1, 4), sStr) > 0) Then MatchCnt := MatchCnt + 1;
    end;
    result := ((MatchCnt * 100) DIV SLen) >= 60; //greater than 75% match => match
End;

//takes 2 normal strings and soundex converts. Then compares if str2 is in str1
Function SoundExComp(sFind, sStr : string) : Boolean;
var
  r: boolean;
begin
    r := SoundExIn(ConvertSoundEx(sFind), ConvertSoundEx(sStr));
    result := r
End;

//converts a string into soundex. 4 chars per word
Function SoundEx(sWord: String) : String;
var Num, sChar, sLastCode: string;
    lWordLength, i: Integer;
begin
    sWord := AnsiUpperCase(sWord);
    Num := copy(sWord, 1, 1); // Get the first letter
    sLastCode := GetSoundCodeNumber(Num);
    lWordLength := Length(sWord);

    // Create the code starting at the second letter.
    for i := 2 To lWordLength do
    begin
        sChar := GetSoundCodeNumber(copy(sWord, i, 1));
        
        // If two letters that are the same are next to each other only count one of them
        if (Length(sChar) > 0) And (sLastCode <> sChar) Then
        begin
          Num := Num + sChar;
          sLastCode := sChar;
        end;
    end;

    result := copy(Num + '    ', 1, 4); // Make sure code is exactly 4 chars
end;

//The letters A,E,I,O,U,Y,H,W and other characters are not coded.
function GetSoundCodeNumber(sChar: string) : String;
var
  SC: string;
begin
  SC := '';

// comma seperating this case statement = memory leaks???, hence done like this
  Case sChar of
    'B' : SC := '1';
    'F' : SC := '1';
    'P' : SC := '1';
    'V' : SC := '1';
    'C' : SC := '2';
    'G' : SC := '2';
    'J' : SC := '2';
    'K' : SC := '2';
    'Q' : SC := '2';
    'S' : SC := '2';
    'X' : SC := '2';
    'Z' : SC := '2';
    'D' : SC := '3';
    'T' : SC := '3';
    'L' : SC := '4';
    'N' : SC := '5';
    'M' : SC := '5';
    'R' : SC := '6';
  end;

  result := SC;
end;



//-----------------------------
// FIELD FUNCTIONS
//-----------------------------
// removes dots after 4th dot
function FixTitles(sStr: string): string;
begin
  result := '';	
  if sStr = '' then exit;
  result := nposReplaceString('.', ' ', sStr, 4); // replace '.' with ' ' after 4th '.' change the 4 to ? as required
end;


/// IMDB info has 'actorname (as partname)' this changes that to 'actor1,actor2,actor3'
function FixActors(sStr: string): string;
begin
  result := '';	
  if sStr = '' then exit;
  sStr := posReplaceString(' (', '), ',',', sStr, 1); // replace ' (.....), '
  sStr := posReplaceString(' (', ')','', sStr, 1); // replace '.' with ' ' after 4th '.'
  sStr := posReplaceString('(', '','', sStr, 1); // erase any remaining '('
  sStr := posReplaceString(')', '','', sStr, 1); // erase any remaining ')'
  // sStr := posReplaceString(', ', '',',', sStr, 1); // remove spaces between ,'s
  result :=  sStr;
end;




//-----------------------------
// OTHER FUNCTIONS
//-----------------------------
// rets url for large amazon pic given title. If ShowPicker = true will prompt with choices (if any)
function GetAmazonPicUrl(Title: String; ShowPicker: boolean) : String;
var
  Page: TStringList;
  LineNr, MovieCnt: Integer;
  Line, Address, Match: string;
begin
  result := '';
  MovieCnt := 0;
  Page := TStringList.Create;
  Address := 'http://www.amazon.com/s/ref=nb_ss_gw/103-7540265-9891830?url=search-alias%3Ddvd&field-keywords=' + StringReplace(UrlEncode(Title),'+', '%20');
  Page.Text := GetPage(Address);

  PickTreeClear;
  PickTreeAdd('Amazon matches for "' + Title + '" (' + GetField(fieldSource) + ')', '');
  LineNr := -1;
  repeat
    LineNr := FindLine('<span class="srTitle">', Page, LineNr + 1);
    if LineNr < 0 then Break;
    Line := Page.GetString(LineNr);
    Address := LineTextBetween('"http', -4, '">', 0, Line, False);
    HTMLRemoveTags(Line);
    if (Line <> '') and (Address <> '') then
    begin
      PickTreeAdd(Line, Address);
      if MovieCnt = 0 then Match := Address;
      MovieCnt := MovieCnt + 1;
    end;
  until (false);// or (LineNr > EndLine) or ((AutoFlag >= 3) and (SeCnt > 0));

  if MovieCnt <> 0 then //if no movies to select from may be it has gone straight to only choice so carry on
  begin
    if ShowPicker then
    begin
      if PickTreeExec(Address) = false then exit; //user select from all episodes
    end else
      Address := Match; //set to 1st match

    Page.Text := GetPage(Address); // get main movie page
  end;

// main movie page
  Line := PageTextBetween('registerImage("original_image"', 0, '', 0, Page, 0, False); //get the line
  Address := LineTextBetween('<a href="+''"''+"', 0, '"+''"''+" target="', 0, Line, False);
  if Address = '' then exit;

// movie large image page
  Page.Text := GetPage(Address);
  Line := PageTextBetween('imagePlaceHolder', 1, '', 1, Page, 0, False); //get the line after the 'imageplaceholder' one
  Address := LineTextBetween('<img src="', 0, '.jpg"', 4, Line, False);
  result := Address;
End;



//-----------------------------
// END
//-----------------------------
begin
end.
Last edited by HappyTalk on 2007-03-27 11:57:44, edited 11 times in total.
antp
Site Admin
Posts: 9629
Joined: 2002-05-30 10:13:07
Location: Brussels
Contact:

Re: [REL] [ENG] Auto.Tv.Com is new automated script for tv.c

Post by antp »

HappyTalk wrote: 3) When hits first 'save fields' box be sure to press' save all' then 'no' to
not remember fields.
I do not really see what you mean by pressing "no" at that time :??: The only message that I see is the one asking if you want to save changes made to the script in the editor...
HappyTalk
Posts: 19
Joined: 2006-11-02 23:44:37

Re: [REL] [ENG] Auto.Tv.Com is new automated script for tv.c

Post by HappyTalk »

antp wrote:
HappyTalk wrote: 3) When hits first 'save fields' box be sure to press' save all' then 'no' to
not remember fields.
I do not really see what you mean by pressing "no" at that time :??: The only message that I see is the one asking if you want to save changes made to the script in the editor...
OK I modified the text does that make more sense. I think I wrote that comment when I first created it last year as I was new(ish) to Ant as a reminder to myself.
antp
Site Admin
Posts: 9629
Joined: 2002-05-30 10:13:07
Location: Brussels
Contact:

Post by antp »

Shall I include this script with the other scripts, for the other users, by the way? Or is it a very specific thing?
HappyTalk
Posts: 19
Joined: 2006-11-02 23:44:37

Post by HappyTalk »

BY all means add it. It's up to you whether you wish to remove old tv.com script (which AFAIK doesn't work at all, at least it didn't a few months back, hence I wrote this). If AutoMode=1 it should be functionally similar to old script, it just prompts for episode choice AFTER its grabbed them all via listbox rather than before via textbox. This makes it far, far more efficient when grabbing info for 2+ records of same tv show as episode list is requested only once not every time as with old script.

I named it Auto as the grabbing can be totally automated via AutoMode Flag. It might work better if the records were passed to it in the order they appear in the list as it cache's all episodes for a series until a new series is required, to minimise hitting tv.com for the same info. we discussed this before on this thread (posts 3 - 5), dunno if it's been changed
viewtopic.php?p=21476&highlight=#21476
Last edited by HappyTalk on 2007-01-18 16:02:42, edited 1 time in total.
antp
Site Admin
Posts: 9629
Joined: 2002-05-30 10:13:07
Location: Brussels
Contact:

Post by antp »

OK if it works better than the old script and can be used in the same way, then I will replace the old one by yours. Thanks.
HappyTalk
Posts: 19
Joined: 2006-11-02 23:44:37

Post by HappyTalk »

OK well I thoroughly tested it on 10,000's of dummy ant records, fixing any probs I encoutered to hone it. But obviously they may change the format? It could be honed even more probably. As mentioned, for slight naming variations I comment in/out other lines on the fly. To make it more user friendly I have just knocked up 2 'script options' for:-

NamingStyle
series.xxx.episode (default)
series.xxx.episode.xxx
Others???? what do people use. (dot seperator can already be altered via option)

MatchMethod
Alpha+SoundEx (default)
AlphaNum+SoundEx
Alpha Only
AlhpaNum Only
SoundEx Only

I have updated the O.P to reflect these changes now so it's good to go.
JohnL
Posts: 2
Joined: 2006-09-18 18:10:54

Post by JohnL »

I've created a new file and blank record but when I run the script it prompts for series name, lets me select the series, then always only gives the option to select either 'login' or 'signup'. Do you need an account on tv.com to run this?
HappyTalk
Posts: 19
Joined: 2006-11-02 23:44:37

Post by HappyTalk »

OK I fixed it and updated first post so it works again as of 16Jan. See top post

-------------
Being an automated script their servers might get hammered, they might investigate and alter web code to break it. It seems strange that it worked fine for last 3 months, when just I was using it but days after releasing this it breaks, probably coincidence. The info like cddb was contributed by us users, so should be freely available. I did cache everything possible to reduce hitting the servers to an absolute minimum, but as ANT doesn't present the records in the selected order though, this caching advantage may get lost.

BTW It's aimed at grabbing info for whole seasons in one hit, rather than single records as it grabs a list of every episode for every season first, caches it, then uses that info to either auto-set the episode based on its name or prompt if unsure dependant on the AutoMode setting.

I would set a checkmark for every tv episode in your ant db, set AutoMode=4 (if title named series.....episode), kick the script off for all checked items, this will uncheck items it gets info for (may take some time if lots). When done set AutoMode=2 (or 1 if not named properly), run script again on remaining checked items this time you will be prompted for which episode to match to. That's it shouldn't take long to get info for every tv-ep in your db.
rickympl
Posts: 10
Joined: 2003-04-03 10:18:57

Help please

Post by rickympl »

I must be a real idiot cause I can't figure this script out, from what i gathered this script will get the info from tv.com only if the name of the episodes are as follows, series.xxx.episode, does that mean that the name of the episode must be known beforehand? How can this be done when we don't know the name of the episode? Can't it just be used to get the info using the episode number?
Sorry if this is truely basic, but like i said, i must be an idiot.
Thermal Ions
Posts: 58
Joined: 2006-12-08 18:19:18
Location: The Land Down Under

Post by Thermal Ions »

@HappyTalk
Absolutely love this script HappyTalk. It's actually prompted me to finally enter my TV episodes into AMC.

I've entered all the episodes with separate numbers and ended up using the category field to group them by series/season (e.g. "Lost: Season 1", "Lost: Season 2"). Works really well with PK's Movie Database template I use at http://tv-series.110mb.com/. Just got to hang in there until I finish entering all the data - still a ways to go.

@Ricky
As far as I am aware the script only works on using the Series name and the Episode name, so while in most peoples cases the xxx in series.xxx.episode most likely refers to the episode number it's actually ignored (and could be any gobbledegook). I imagine that the episode name has been used as it should be more accurate than the number which isn't as consistently reliable as a key field when extracting the data from tv.com.

And I believe you are right in that you need the records in AMC with the episode names for the script to actually pull back details. You can't just have an empty database and tell the script to pull back all episodes for a given series, creating a separate record for each - although this would be neat.

Personally, I'm taking the long road of dragging in the files from DVD's to build all the records, as this reads in the file details at the same time. I'd rather use AVIList to build a csv file, but it doesn't work for me on the root drive of optical media.

If you want to pull in all the episodes of a given series, you could possibly grab the list of episodes from tv.com, using the page with all episodes listed (e.g. for Lost http://www.tv.com/lost/show/24313/episo ... dropdown;3) . Then cut and paste into a spreadsheet, manipulate a little to get the series.xxx.episode format, and save to csv. Import the csv into AMC, and run the script. Shouldn't take too long to do a number of series, particularly if you use some formulas in the spreadsheet to covert the pasted data - you could then re-use them. Hope this approach helps out.

Cheers.......Thermal
Thermal's Movie db / TV Series db
rickympl
Posts: 10
Joined: 2003-04-03 10:18:57

Post by rickympl »

Thermal Ions wrote:
thank you, I had thought up of that spreadsheet approach, and actually added a few series using that approach. A lot of hard work ahead, lot more series to add.

Thanks
HappyTalk
Posts: 19
Joined: 2006-11-02 23:44:37

Post by HappyTalk »

You DON'T have to have them named using one of the naming styles to use the script. But doing so enables it to run in full automation mode where it can grab the info for 1,000's of episodes unaided by you.

If you set AutoMode = 1 (script options to your right) it will prompt for series name, grab all episodes then present them in a listbox for you to select the correct one (your current title will be listed at top)

I currently rename episodes thus (manually getting the titles from tv.com) :-

Heroes.s01.12.Godsend.avi
Heroes.s01.13.The Fix.avi
GnomesRUs
Posts: 41
Joined: 2005-08-30 18:10:10
Location: U.S.A.

Post by GnomesRUs »

Just got your script and am trying it out

One question: Would it be possible to have it import the complete "First Aired" date into the Comments field of AMC, maybe after the production code?

Thanks for a great script!
Post Reply