Updated and powered Beyazperde Script

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.
fyper
Posts: 16
Joined: 2006-03-04 18:34:46

Updated and powered Beyazperde Script

Post by fyper »

Code: Select all

Your file 1BeyazPerde_TR__03b.ifs (15961 Bytes) is now online.
 
 Your Download-Link:	http://rapidshare.de/files/15064418/1BeyazPerde_TR__03b.ifs.html	
	
test and use.
turkish translated.
For turkish help turkvizyon.org >>>bilgisayar destek

edit: minor bug corrected( 09,march,2006) rapid link changed
Last edited by fyper on 2006-03-09 11:30:13, edited 1 time in total.
antp
Site Admin
Posts: 9629
Joined: 2002-05-30 10:13:07
Location: Brussels
Contact:

Post by antp »

Thanks
fyper
Posts: 16
Joined: 2006-03-04 18:34:46

Post by fyper »

new version released
fyper
Posts: 16
Joined: 2006-03-04 18:34:46

latest code

Post by fyper »

Code: Select all

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

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

[Infos]
Authors=FypeR , Karagarga, Tiu Fang(base)
Title=1 beyazperde.com(fyper edition)
Description=BeyazPerde den film ile ilgili bilgi ve mini resim alır.
Site=http://www.beyazperde.com
Language=TR
Version=f0.3.b
Requires=3.5.0
Comments=İstek ve öneriler için boskzbl02[@ntispam]sneakemail.com  irtibata geçiniz.||Beyazperde ile ilgili olarak sayfalarında çok fazla gereksiz veri bulunuyor. |Arama sayfalarıın işlenmesi bu gereksiz veriler yüzünden uzun sürüyor.||
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]
AramaMiktar=1|1|0=25 adet sonuç için arama yapar|1=50 adet sonuç için arama yapar|2=100 adet sonuç için arama yapar|3=200 adet sonuç için arama yapar|4=400 adet sonuç için arama yapar(uzun sürecek)!!!
AramaListeTipi=0|0|0=Arama sonuç listesi Tarih sıralı olur(Geçmişe doğru)|1=Arama Sonuç listesi Ad sıralı olur(0..A....Z)|2=Arama Sonuç listesi Puan Sıralı olur(Azalan)|3=Arama sonuç listesi Ters Tarih sıralı olur(Geçmişten geleceğe|4=Arama sonuç listesi Ad sıralı olur(Z...A...0)|5=Arama sonuç listesi Ters puan sıralı olur(Artan)
Tanekle=1|1|0=Hazırda varolan filmin tanımı temizler ve beyazperde içindeki tanımı ekler|1=Hazırda var olan tanımı beyazperde tanımının arkasına ekler

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

//FypeR edit 9,3,2006 13:19 gmt+2
//tanım alanındaki fazla kırpma düzeltildi.
//FypeR edit 3,3,2006 16:00 gmt +2
//sonsuz döngü hatalarına yol açan kontroller değiştirildi
//ek arama fonksiyonu düzenlendi(anti amele sistem eklendi)
//bilgilendirmeler eklendi
//film tanımı alma düzenlendi
//FypeR  edit 24,2,2006 17:37 gmt+2
//arama fonksiyonunun sonlandırma noktası değiştirildi
//FypeR  edit 15,2,2006  01:00 gmt+2
//seçilebilir arama miktarı eklendi
//seçilebilir arama yöntemi eklendi
//arama sayfası değiştirildi
//film seçim sayfası düzenlendi
//ek arama eklendi
//FypeR  edit 07-02-2006 16:16 gmt+2
//senaryo+kitap alanı düzeltildi
//tarihçe eklendi
//minik bilgilendirmeler eklendi
program BeyazPerde;
var
  MovieName: string;
  denek : integer;
  basdeger,sondeger:integer;
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 AnalyzePage(Address: string);
var
  Page: TStringList;
  LineNr: Integer;
  pozisyon: integer;
begin
  Page := TStringList.Create;
  Page.Text := GetPage(Address);
  pozisyon:=pos('Arama</title>', Page.Text);
  if pozisyon = 0 then
  begin
    SetField(fieldURL, Address);
    AnalyzeMoviePage(Page)
  end else
  begin
  //  PickTreeClear;
    LineNr := 0;
    LineNr := FindLine('<td class="metin3"></td>', Page, LineNr);   //LineNr := FindLine('<td class="metin3">Filmler</td>', Page, LineNr);
    if LineNr > -1 then
    begin
      basdeger:=pos('Toplam: <b>', Page.text)+11;
      sondeger:= pos('</b> ) </font>',page.text);
      PickTreeAdd('Beyaz Perde Filmleri (Toplam:'+copy(page.text,basdeger,sondeger-basdeger)+' film)', '');     //<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<pos('htsearcher',page.text) >0
      AddMoviesTitles(Page, LineNr);
      
    end;

    if PickTreeExec(Address) then
    begin
      if address='  ' then
      begin
        address:='http://www.beyazperde.com/arama.asp?kat=film&keyword='+ urlencode(moviename)+'&sira='+listetipi+'&f='+aramikdeger+'&t='+inttostr(2*strtoint(aramikdeger,0));

        Page.Free;
        //AnalyzePage(Address);
        Page := TStringList.Create;
        showmessage('Ek arama fonksiyonu bir sefer kullanılabilir. Lütfen ikinci kez aynı seçeneği seçmeyiniz.');
        Page.Text := GetPage(Address);
        picktreeadd('BeyazPerde Filmleri arama 2','');
        linenr:=0;
        AddMoviesTitles(Page, LineNr);
        if picktreeexec(address) then
        begin
        //if address = '  ' then
        while address = '  ' do
          begin
            showmessage('İkinci kez ek arama desteklenmiyor. Lütfen tekrar seçin yada iptal edin!! ');
            picktreeexec(address);
          end;
            analyzepage(address);
        end;
      end else
      begin
        AnalyzePage(Address);
      end;
    end;
  end;
  Page.Free;
end;

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

  // Original Title & Year
  LineNr := FindLine('<title>Beyazperde.com - ', Page, 0);
  Line := Page.GetString(LineNr);
  if LineNr > -1 then
  begin
    BeginPos := pos('<title>Beyazperde.com - ', Line);
    if BeginPos > 0 then
      BeginPos := BeginPos + 24;
    EndPos := pos(' / ', Line);
    if EndPos = 0 then
    begin
      EndPos := pos(' (', Line);
      Value := copy(Line, BeginPos, EndPos - BeginPos);
      SetField(fieldTranslatedTitle, Value);
      SetField(fieldOriginalTitle, Value);
    end else
    begin
      BeginPos := pos('<title>Beyazperde.com - ', Line);
      BeginPos := BeginPos + 24;
     // BeginPos := pos(' / ', Line) + 3;
      if BeginPos > 0 then
      begin
        EndPos := pos(' / ', Line);
        Value := copy(Line, BeginPos, EndPos - BeginPos);
        SetField(fieldtranslatedTitle, Value);
        BeginPos := pos(' / ', Line) + 3;
        EndPos := pos(' (', Line);
        Value := copy(Line, BeginPos, EndPos - BeginPos);
        SetField(fieldoriginalTitle, Value);
      end;
    end;

    BeginPos := pos('(', Line) + 1;
    if BeginPos > 0 then
    begin
      EndPos := pos(')', Line);
      Value := copy(Line, BeginPos, EndPos - BeginPos);
      SetField(fieldYear, Value);
    end;
  end;

  // Rating
  LineNr := FindLine('<span class="metin2"><b>SinePuan', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr);
    if Pos('</b>', Line) > 0 then
    begin
      EndPos := pos('</b>', Line);
      BeginPos := pos('tin2>', Line) + 5;
      Value := copy(Line, BeginPos, EndPos - BeginPos);

      if pos(',', Value) > 0 then
      begin
        Value := IntToStr(Round(StrToInt(StrGet(Line, BeginPos), 0) + (StrToInt(StrGet(Line, BeginPos + 2), 0) / 10)));
      end;
      SetField(fieldRating, Value);
    end;
  end;

  // Picture
  LineNr := FindLine('images/film/', Page, 0);
  
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr);
    BeginPos := pos('src="', Line) + 5;
    EndPos := pos('">', Line);
    Value := copy(Line, BeginPos, EndPos - BeginPos);
    GetPicture(Value);
  end;

  // Director
  LineNr := FindLine('<!-- YONETMEN -->', Page, 0);
  if LineNr > -1 then
  begin
    FullValue := '';
    Line := Page.GetString(LineNr + 3);

    BeginPos := pos('item>', Line) + 5;
    EndPos := pos('</a>', Line);
    Value := copy(Line, BeginPos, EndPos - BeginPos);
    HTMLDecode(Value);
    SetField(fieldDirector, Value);
  end;
  // PRODUCER senaryo ve kitap
  LineNr := FindLine('<!-- SENARYO -->', Page, 0);
  if LineNr > -1 then
  begin
    FullValue := '';
    Line := Page.GetString(LineNr + 4);

    BeginPos := pos('item>', Line) + 5;
    EndPos := pos('</a>', Line);
    Value := copy(Line, BeginPos, EndPos - BeginPos);
    Line := Page.GetString(LineNr + 6);
    BeginPos := pos(',', Line);
    if beginpos>0 then
    begin
      Line := Page.GetString(LineNr + 8);
      BeginPos := pos('item>', Line) + 5;
      EndPos := pos('</a>', Line);
      Value := Value + ',' + copy(Line, BeginPos, EndPos - BeginPos);
    end;
    LineNr := FindLine('<!-- KİTAP -->', Page, 0);
    Line := Page.GetString(LineNr + 1);
    BeginPos := pos(',', Line);
    if beginpos>0 then
    begin
      Line := Page.GetString(LineNr + 2);
      BeginPos := pos('item>', Line) + 5;
      EndPos := pos('</a>', Line);
      Value := Value + ',' + copy(Line, BeginPos, EndPos - BeginPos)+ '(Kitap)';
    end;
    HTMLDecode(Value);
    SetField(fieldPRODUCER, Value);
  end;
  // Actors
  FullValue := '';
  LineNr := FindLine('<!-- OYUNCULAR -->', Page, 0);
  
  if LineNr > -1 then
  begin
    repeat
      LineNr := LineNr + 1;
      if linenr>page.count then showmessage('Döngüsel Hata 1');

      Line := Page.GetString(LineNr);

      if pos('href="/kisi/', Line) > 0 then
      begin
        BeginPos := pos('class=item>', Line) + 11;
        EndPos := pos('</a>', Line);
        Value := copy(Line, BeginPos, EndPos - BeginPos);
        BeginPos := pos('(', Line);
        EndPos := pos(')', Line) + 1;
        Value := Value + ' ' + copy(Line, BeginPos, EndPos - BeginPos) + ', ';
        FullValue := FullValue + Value;
      end;
    until pos('</table>', Line) > 0;
    EndPos := Length(FullValue);
    Delete(FullValue, EndPos - 1, EndPos);
    HTMLDecode(FullValue);
    SetField(fieldActors, FullValue);
  end;

  //Country
  LineNr := FindLine('<!-- ULKE -->', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr + 2);
    BeginPos := pos('em>', Line) + 3;
    EndPos := pos('</a>', Line);
    Value := copy(Line, BeginPos, EndPos - BeginPos);
    HTMLDecode(Value);
    SetField(fieldCountry, Value);
  end;

  //Category
 // LineNr := FindLine('arama.asp?kat=tur', Page, 0);
  //if LineNr > -1 then
 // begin
//    Line := Page.GetString(LineNr);
 //   BeginPos := pos('em>', Line) + 3;
 //   EndPos := pos('</a>', Line);
  //  Value := copy(Line, BeginPos, EndPos - BeginPos);
  //  HTMLDecode(Value);
 //   SetField(fieldCategory, Value);
 // end;
 
 
   // kategori
  FullValue := '';
LineNr := FindLine('<!-- TÜRÜ -->', Page, 0);

  if LineNr > -1 then
  begin
    repeat
       LineNr := LineNr + 1 ;
       if linenr>page.count then showmessage('Döngüsel Hata 2');

       Line := Page.GetString(LineNr);
       if pos('arama.asp?kat=tur', Line) > 0 then
       begin
          BeginPos := pos('em>', Line) + 3;
          EndPos := pos('</a>', Line);
          Value := copy(Line, BeginPos, EndPos - BeginPos);
          linenr := linenr + 1;
          if linenr>page.count then showmessage('Döngüsel Hata 3');

          fullvalue := fullvalue +  value + ' / ';
       end;
    until pos('ALT TÜRÜ -->',line)>0 ;
    EndPos := Length(FullValue);
    Delete(FullValue, EndPos - 1, EndPos);
    HTMLDecode(fullValue);
    SetField(fieldCategory, fullValue);
  end
  // Length
  LineNr := FindLine('<!-- SURESI -->', Page, 0);
  if LineNr > -1 then
  begin
    Line := Page.GetString(LineNr + 2);
    BeginPos := pos(', ', Line) + 2;
    EndPos := pos(' dk', Line);
    Value := copy(Line, BeginPos, EndPos - BeginPos);
    SetField(fieldLength, Value);
  end;


  //Description


  LineNr := FindLine('<td width="472" bgcolor="#FFFFFF" class=metin align=left valign="middle">', Page, 0);
  Value := '';
  //while linenr<page.count do
  denek:=page.count;
  if denek=0 then
  begin
  showmessage('hatalı ya da eksik veri alımı 1. İşlem sonlandırılıyor!! Tekrar deneyebilirsiniz.');
  end else
  begin
  repeat
    LineNr := LineNr + 1;
    if linenr>page.count then showmessage('hatalı veri alımı 2');
    denek:=page.count;
    Line := Page.GetString(LineNr);
    if pos('<!-- pt language="">', Line) < 1 then
    begin
      Value := Value + Line;
    end;

    until (pos('<!-- pt src="/beyazperde.js">',line)>0) or (linenr=page.count-1);
  end;
  //until pos('<!-- pt language="">', Line) > 0;

  Value := StringReplace(Value, '<br>', #13#10);
  Value := StringReplace(Value, '<p>', '');
  Value := StringReplace(Value, '</b>', '');
 // Value := StringReplace(Value, #13#10+' ', #13#10);
   Value := trim(StringReplace(Value, #13#10+' ', #13#10));

        HTMLRemoveTags(Value);
  HTMLDecode(Value);
//  endpos := length(value);
 // value := copy(value , 22, EndPos);
    case getOption('Tanekle') of
    1:  value:=value+#13#10+eskitan;
    end;
  SetField(fieldDescription, Value);

  //DisplayResults;
end;

procedure AddMoviesTitles(Page: TStringList; var LineNr: Integer);
var
  Line: string;
  lina: Integer;
  MovieTitle, MovieAddress: string;
  StartPos: Integer;
  TempPos: Integer;
  endpos: integer;
  year: string;
begin
  lina :=0;
  repeat
    LineNr := LineNr + 1;
    if linenr>page.count then showmessage('Eksik ya da hatalı veri alımı 5');
    denek:=page.count;
    Line := Page.GetString(LineNr);
    TempPos := pos('<img src="', Line);
   // TempPos := pos('<!-- FORUMLAR LİSTELENİYOR -->', Line);
    if TempPos < 1 then
    begin
      StartPos := pos('"/film/', Line);   //StartPos := pos('<a href="', Line);
      lina :=pos('Sonraki >>', line);
      if (lina >0)and (extraara=0)  then
      begin
        picktreeadd('Daha film var...','');
        picktreeadd('Aramaya devam..devam için burayı seçin(ikinci ek arama yok)','  ');

        extraara:=1;
      end;
      if StartPos > 0 then
      begin
        Startpos := Startpos + 1;
        MovieAddress := copy(Line, StartPos, pos('" class=metin2>', Line) - StartPos);
        StartPos := pos('</b>', Line) + 4;
        year :=  copy(Line, StartPos, pos(')<br>', Line) - StartPos + 1 );
        startpos := pos('<b>', Line) + 3;
        MovieTitle := copy(Line, StartPos, pos('</b>', Line) - StartPos);

        StartPos := pos(')<br>', Line) + 5;
        endpos :=  pos('<br><span class=', line) ;

          if (endpos =0) then
            begin
              endpos := Length(line)-3 ;
          end;

        movietitle := movietitle + year + ' / ' + copy(line, startpos, endpos - startpos);
        //LineNr := LineNr + 1;
        //Line := Page.GetString(LineNr);
        //StartPos := pos('/ ', Line) + 2;
        //MovieTitle := MovieTitle + ' / ' + copy(Line, StartPos, pos ('<br>', Line) - StartPos);
        HTMLDecode(Movietitle);
        PickTreeAdd(MovieTitle, 'http://www.beyazperde.com' + MovieAddress);
      end;
    end;
    until linenr>page.count-1;
  //until pos('Listelenen', Line) > 0;
end;
  var
  extraara :integer;
  aramikdeger : String;
  listetipi :string;
  eskitan: string;
begin

  if CheckVersion(3,5,0) then
  begin
case GetOption('Tanekle') of
1:eskitan:=GetField(fieldDescription);
end;
    case GetOption('AramaMiktar') of
      0:aramikdeger:='25';
      1:aramikdeger:='50';
      2:aramikdeger:='100';
      3:aramikdeger:='200';
      4:aramikdeger:='400';
    end;
    case GetOption('AramaListeTipi') of
      0:listetipi:='yild';
      1:listetipi:='isima';
      2:listetipi:='puand';
      3:listetipi:='yila';
      4:listetipi:='isimd';
      5:listetipi:='puana';
    end;
    MovieName := GetField(fieldOriginalTitle);
    if MovieName = '' then
      MovieName := GetField(fieldTranslatedTitle);
    if Input('Beyaz Perde script(versiyon FypeR)', 'Lütfen bilgileri yüklenecek filmin ismini girin', MovieName) then
    begin
      PickTreeClear;
      extraara:=0;
      AnalyzePage('http://www.beyazperde.com/arama.asp?kat=film&keyword='+UrlEncode(MovieName)+'&sira='+listetipi+'&f=0&t='+aramikdeger);//AnalyzePage('http://www.beyazperde.com/hizliarama.asp?keyword='+UrlEncode(MovieName));
    end;
  end else
  ShowMessage( 'programın daha yeni versiyonunu kurunuz(minimum versiyon ihtiyacı 3.5.0)');
end.

copy to empty text file and rename to beyazperde.ifs
finally move to scripts folder

butun kodu bos bir text dosyası icine kopyalayip yapistirin .
dosyayi sonra beyazperde.ifs olarak kaydedip/isimlendirin.
script klasörü içine atmayi unutmayin
Last edited by fyper on 2007-11-15 16:31:28, edited 1 time in total.
antp
Site Admin
Posts: 9629
Joined: 2002-05-30 10:13:07
Location: Brussels
Contact:

Post by antp »

Can you provide me a link to download the script, or send it to me by e-mail, so I can include it with the program?
As I cannot copy/paste this one to a text file: some characters are lost as my PC is configured for west-europe character set.
fyper
Posts: 16
Joined: 2006-03-04 18:34:46

updated

Post by fyper »

new beyazperde script
**not completely tested **

http://rapidshare.com/files/43613843/_1BeyazPerde.ifs
antp
Site Admin
Posts: 9629
Joined: 2002-05-30 10:13:07
Location: Brussels
Contact:

Post by antp »

Thanks, I'll add it to my server as soon as possible.
fyper
Posts: 16
Joined: 2006-03-04 18:34:46

release 3

Post by fyper »

antp
Site Admin
Posts: 9629
Joined: 2002-05-30 10:13:07
Location: Brussels
Contact:

Post by antp »

Thanks. Just a remark: it is better to not change the title of the script. As there is a "version" field the "r3" in the title is not very useful I guess (I removed it in the version that I uploaded on my server).
bad4u
Posts: 1148
Joined: 2006-12-11 22:54:46

Post by bad4u »

antp wrote:Just a remark: it is better to not change the title of the script. As there is a "version" field the "r3" in the title is not very useful I guess
Even worse side effect: If the title of the script changes, it will not be possible to show correct update informations for users that use the [ UPDATE SCRIPTS ] script to find recent script updates.
fyper
Posts: 16
Joined: 2006-03-04 18:34:46

current version

Post by fyper »

dustyboy
Posts: 3
Joined: 2009-01-18 17:05:53

error

Post by dustyboy »

Is this version working at the moment? I get an error message while searching for a film.
fyper
Posts: 16
Joined: 2006-03-04 18:34:46

yes working but

Post by fyper »

Yes it is working.
But beyazperde blocking normal moviecatalog.exe you need modified exe
http://rapidshare.com/files/201305725/M ... zperde.rar
rename old exe file and copy this file to program directory.
dustyboy
Posts: 3
Joined: 2009-01-18 17:05:53

its done

Post by dustyboy »

yes, i replaced the modified exe and it is working perfect now. thank you very much. :grinking:
fyper
Posts: 16
Joined: 2006-03-04 18:34:46

for turkish user

Post by fyper »

for Turkish users introductory page http://www.turkvizyon.org/index.php?showtopic=238

Türk kullanıcılar yukarıdaki sayfadan programla ilgili detaylı Türkçe bilgiye ulaşabilirler.
fyper
Posts: 16
Joined: 2006-03-04 18:34:46

update

Post by fyper »

beyazperde script updated
2009.09.26
http://rapidshare.com/files/286622186/M ... e__TR_.ifs
fyper
Posts: 16
Joined: 2006-03-04 18:34:46

update

Post by fyper »

fyper
Posts: 16
Joined: 2006-03-04 18:34:46

updated release

Post by fyper »

Code: Select all

http://hotfile.com/dl/75069386/7076473/Mynet_beyazperde_(TR).ifs.html
sorry for late. i forgot this topic.
fyper
Posts: 16
Joined: 2006-03-04 18:34:46

update

Post by fyper »

new beyazperde new script
http://m.friendfeed-media.com/972776e9e ... 90498c82e4
save as and rename delete .txt part from name
fyper
Posts: 16
Joined: 2006-03-04 18:34:46

Post by fyper »

Post Reply