Скрипт загрузки фоток с сайта.

Post Reply
dburg

Скрипт загрузки фоток с сайта.

Post by dburg »

Возможно кому-то будет интересно.
Добавил скрипт в Настройка-Медиа-Ресурсы-Список каталогов-Обработка
Запускается по расписанию каждые 2 минуты. Загружает фотки с сайта на комп.
Включил автоматическое сканирование каталогов при изменении.
Включил группирование если количество элементов в папке превышает 100

Выражение для группировки сделал по дате создания
Copy(mpCreateDate,7,4) + "\" + Copy(mpCreateDate,4,2) + "\" + Copy(mpCreateDate,1,2)

За код скрипта строго не судите - документации по программированию нет. Главное работает.
Так методом проб и ошибок напримере имеющихся скриптов в программе.

Мож кто доработает или расширит возможности.
Изначально хотелось не сами фотки грузить а http ссылки на них.
Но не получилось. Ссылки в каталог добавляются миниатюры видны но на медиаплеере (WDTV LIVE) их не видно.
Может у кого получится это сделать.

Code: Select all

Const
  PCRE_CASELESS   = $00000001;
  PCRE_DOTALL     = $00000004;
  PCRE_SINGLELINE = PCRE_CASELESS + PCRE_DOTALL;
  HttpFilePath = "http://www.photodom.com/daily_photos/";
  LocalFilePath = "d:/photodom/";

  procedure ProcessItem(const aItemDescr: string);
  var
    Item, ItemFolder: THMSScriptMediaItem;
  var
    i, j: Integer;
    sItemDate, sItemID, sItemLink, sItemTitle, sItemThumbnail,sItemFile,
    sMediaConfig, sVideoDuration, sVideoID, sVideoLink, sVideoType: string;

  begin
          sItemLink := ReplaceStr(aItemDescr,"thumb_","");
          i := EndPos(sItemLink,'/');
          j := Length(SItemLink);
          sItemFile :=  Copy(sItemLink,i+1,j+1-i);
          sItemFile := LocalFilePath + sItemFile;
          i := EndPos(sItemFile,"jpg");
          if i <> 0 then
            if FileExists(sItemFile) then
                sItemFile := ""
            else
                HmsDownloadURLToFile(sItemLink, sItemFile);
  end;

  procedure ProcessPage(const aWebPage: string);
  var
    ItemsRegExpr: TRegExpr;
  begin
    ItemsRegExpr := TRegExpr.Create('tmpsrc="(.*?)" src=', PCRE_SINGLELINE);
    try
      if ItemsRegExpr.Search(aWebPage) then repeat
       ProcessItem(ItemsRegExpr.Match)
      until not ItemsRegExpr.SearchAgain
    finally
      ItemsRegExpr.Free
    end
  end;

var
  sWebPage: string;
begin
  sWebPage := HMSDownloadURL(HttpFilePath);
  ProcessPage(sWebPage);
end.
Post Reply