Добавил скрипт в Настройка-Медиа-Ресурсы-Список каталогов-Обработка
Запускается по расписанию каждые 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.