Домашний медиа-сервер (UPnP, DLNA, HTTP)

Решения пользователей программы "Домашний медиа-сервер (UPnP, DLNA, HTTP)"
https://www.homemediaserver.ru/forum/

Универсальные функции и скрипты

https://www.homemediaserver.ru/forum/viewtopic.php?t=2793

Page 1 of 1

Универсальные функции и скрипты

Posted: Mon Feb 18, 2013 11:29 pm
by WendyH
Здесь предлагаю выкладывать, обсуждать и предлагать какие-то универсальные функции, которые могут быть использованы во многих подкастах, готовые и неочень решения.

Начну с универсальной динамической папки настроек для подкаста. Может быть использована в любых подкастах, где используются какие-либо ключи или настройки в полях "Комментарий". Скрипт полностью отдельно самодостаточен, автономен и не привязан к какому либо подкасту. Для работы скрипта, необходимо в подкасте создать папку с типом "Динамическая (скрипт) - зависит от устройства" и вставить этот скрипт. Для использования скрипта необходимо будет только отредактировать ту часть, где задаются какие настройки и ключи мы хотим устанавливать и снимать.

Для удобства добавления подобных папок в любой подкаст, можно воспользоваться заметкой Евгения и вывести кнопку добавления в панель программы.

Устанавливаемые настройки применяются для папки, которая содержит эту динамическую папку настроек.
Динамическая папка настроек подкаста должна иметь ссылку "-SettingsFolder" и может иметь любое наименование.
[+] Динамическая папка настроек подкаста

Code: Select all

///////////////////////////////////////////////////////////////////////////////
//               Г Л О Б А Л Ь Н Ы Е   П Е Р Е М Е Н Н Ы Е                   //
THmsScriptMediaItem goRoot = FolderItem;    // Корневая папка настроек
string    gsRootPath   = '-SettingsFolder', // Значение поля путь (ссылка) корневой папки настроек
          gsKey        = '',                // Ключ (определяется ниже)
          gsValue      = '';                // Значение ключа (устанавливается ниже)
TDateTime gTimeStart   = Now;    // Время запуска скрипта 
TStrings  SETTINGS;              // Объект TStrings для хранения описания настроек
int
  gnTotalItems         = 0,      // Глобальный счетчик 
  // Константы параметров этой динамической папки
  mpiFolderType        = 200,    // Тип папки     
  mpiDynamicScript     = 500,    // Скрипт 
  mpiDynamicSyntaxType = 501,    // Язык скрипта
  mpiPreviousItemID    = 200104, // Предыдущий ItemID
  ;
///////////////////////////////////////////////////////////////////////////////
//                             Ф У Н К Ц И И                                 //

// ----------------------------------------------------- Структура настроек ---
void SettingsStructure() {
  // Указываем ключи и их наименования
  // Также указываем ключ и далее знак ':' и после - значение ключа (или '+' - добавить, '-' - удалить ключ)
  
  SETTINGS.Values["--getinfofromkp"] = "Информация c Кинопоиск.ru";
  SETTINGS.Values["--getinfofromkp:-"] = 'Не запрашивать инф. c Кинопоиск.ru';   
  SETTINGS.Values["--getinfofromkp:+"] = 'Запрашивать инф. c Кинопоиск.ru';   

  SETTINGS.Values["--info"] = "Cоздание информационных ссылок";   
  SETTINGS.Values["--info:0"] = 'Не создавать инф. ссылки';   
  SETTINGS.Values["--info:1"] = 'Cоздавать одну: "Информация"';   
  SETTINGS.Values["--info:2"] = 'Cоздавать все (подробно)';
}

// ---------------------------------- Проверка текущего состояния настройки ---
bool CheckKeyState(string sVal) {
  string PARAMS = goRoot.ItemParent[mpiPodcastParameters]+' '; // Строка установленных параметров подкаста
  bool   bExist = (Pos(gsKey+' ', PARAMS)>0);      // Проверяем, указан ли уже ключ
  if      (sVal=='-') return !bExist;              // Если проверяемое значение '-' - ключ не должен быть указан       
  else if (sVal=='+') return bExist;               // Если проверяемое значение '+' - указан ли ключ
  else return (Pos(gsKey+'='+sVal+' ', PARAMS)>0); // Иначе проверяем, установлено ли в параметрах заданное значение 
}
  
// ---------------------------------------------- Создание ссылки-сообщения ---
void ShowMessageLink(string sMsg) {
  THmsScriptMediaItem Item = HmsCreateMediaItem(sMsg, FolderItem.ItemID);
  Item[mpiThumbnail] = 'http://wonky.lostcut.net/icons/ok.png';
}

// ---------- Функция создания динамической папки с унаследованным скриптом ---
void CreateItem(string sTitle, string sLink) {
  THmsScriptMediaItem Folder = FolderItem.AddFolder(sLink, true);
  Folder[mpiTitle     ] = sTitle;
  Folder[mpiCreateDate] = VarToStr(IncTime(gTimeStart,0,-gnTotalItems,0,0)); gnTotalItems++;
  Folder.CopyProperties(FolderItem, [mpiFolderType, mpiDynamicScript, mpiDynamicSyntaxType, mpiFolderSortOrder]); 
}
///////////////////////////////////////////////////////////////////////////////
// ----------------------------------------------- Создание списка настроек ---
void CreateMainMenu() {
  for (int i=0; i<SETTINGS.Count; i++) { // Обходим в цикле все настройки
    string sKey = SETTINGS.Names[i];     // Получаем ключ настроек
    if (Pos(':', sKey)>0) continue;      // Если там есть ':', то это вариант настройки - пропускаем
    CreateItem(SETTINGS.Values[sKey], '-showValues='+sKey); // Создаём пункт настройки
  }
}
// ------------------------------------ Создание списка вариантов настройки ---
void CreateValuesList() {
  int i; string sVal, sKey, sName, sState; // При входе в процедуру в gsKey уже сам ключ
  for (i=0; i<SETTINGS.Count; i++) { // Обходим в цикле все настройки
    sKey   = SETTINGS.Names[i];      // Получаем ключ настроек
    sName  = SETTINGS.Values[sKey];  // Наименование варианта настройки
    if (!HmsRegExMatch('^'+gsKey+':(.*)', sKey, sVal)) continue; // Если не получили значение нашего ключа, пропускаем
    if (CheckKeyState(sVal)) sState='[v]'; else sState='[ ]';    // Проверка: установлено ли данное значение, ставим пометку 
    CreateItem(sState+' '+sName, '-key='+gsKey+' -value='+sVal); // Создаём пункт варианта настройки    
  }
}
// ------------------------ Включение/Отключение настройки или его значения ---
void ApplyKeyValue() {
  // При входе в процедуру уже в gsKey - ключ, в gsValue - его значение (может быть '+' или '-', это установить или удалить параметр) 
  bool bExist; string sOldVal=gsKey, sNewVal, PARAMS;        // По-умолчанию в sOldVal сам ключ
  
  PARAMS = goRoot.ItemParent[mpiPodcastParameters]+' ';      // Строка установленных параметров подкаста
  HmsRegExMatch('('+gsKey+'=.*?)\\s', PARAMS, sOldVal);      // Вылавливаем в sOldVal установленное значение
  bExist = (Pos(sOldVal, PARAMS)>0);                         // Устанавливаем флаг присутсвия ключа в параметрах
  
  if      (gsValue=='-') sNewVal = '';                       // Замена на пустое значение = удалению
  else if (gsValue=='+') sNewVal = gsKey;                    // Просто устанавливаем ключ 
  else                   sNewVal = gsKey+'='+gsValue;        // Устанавливаем ключ с новым значением 

  if (bExist) PARAMS = ReplaceStr(PARAMS, sOldVal, sNewVal); // Если ключ уже присутствует - заменяем
  else        PARAMS += sNewVal;                             // Иначе просто добавляем
  ShowMessageLink('ВЫБРАНО: '+Copy(mpTitle, 5, 99));         // Пропускаем '[ ] ' в mpTitle и сообщаем о выбранном варианте
  goRoot.ItemParent[mpiPodcastParameters] = Trim(ReplaceStr(PARAMS, '  ', ' ')); // Сохраняем параметры подкаста
}

// ----------------------------------------------------------------------------
// Проверка значения ссылки текущей папки и извлечение группировок регулярного выражения в gsKey и gsValue
bool CheckPath(string sPattern) { return HmsRegExMatch2(sPattern, mpFilePath, gsKey, gsValue); }

///////////////////////////////////////////////////////////////////////////////
//                    Г Л А В Н А Я   П Р О Ц Е Д У Р А                      //
// ----------------------------------------------------------------------------
{
  // Поиск корневой динамической папки (ибо этот скрипт может выполнятся и в подпапках)
  while ((goRoot[mpiFilePath]!=gsRootPath) && (goRoot.ItemParent!=nil)) goRoot = goRoot.ItemParent;
  if (goRoot[mpiFilePath]!=gsRootPath) { ShowMessageLink('Не найдена папка настроек с путём '+gsRootPath); return; }
  
  // Если это повторный вызов, смены папки не произошло - ничего не делаем
  if ((FolderItem.ItemID==goRoot[mpiPreviousItemID]) && (FolderItem!=goRoot) && !DebugMode) return;
  FolderItem.DeleteChildItems(); goRoot[mpiPreviousItemID] = FolderItem.ItemID;

  SETTINGS = TStringList.Create();
  try {
    SettingsStructure();
    if      (CheckPath(gsRootPath))               CreateMainMenu();   // Если это корень - создаём список настроек
    else if (CheckPath('-showValues=(.*)'))       CreateValuesList(); // Зашли в настройку - показываем список вариантов значений
    else if (CheckPath('-key=(.*?) -value=(.*)')) ApplyKeyValue();    // Зашли в вариант значения настройки - применяем этот вариант 
      
  } finally { SETTINGS.Free(); }
  HmsIncSystemUpdateID(); // Говорим устройству об обновлении содержания
}
Также прикрепляю папку, в которой есть динамическая папка с данным скриптом. Для примера. Также пример использования такой папки в подкасте.

UPD 21.02.2013:
Освежил скрипт.
Для ленивцев (таких как я) можно добавить ещё кнопку.
В программе - "Настройки" -> "Обработка" -> "Загрузить" и выбрать файл, прикреплённый ниже (заранее распакованный) "Обработка медиаресурса - Добавить папку настроек подкаста.cfg" -> на вопрос "Очистить список... ?" отвечаем "Нет" -> OK -> OK. После этого на панели должна появиться кнопка "Добавить папку настр. подкаста".
Работает так - встаём на подкаст или папку подкаста в программе и нажимаем эту кнопку. По кнопке произойдёт загрузка скрипта с этого форума (да да, мне нечего было делать) и добавиться динамическая папка с данным скриптом в текущий подкаст.
UPD 27.12.2014: Обновлён скрипт и обработка загрузки и добавления динамической папки в подкаст.

Re: Универсальные функции и скрипты

Posted: Wed Feb 20, 2013 11:51 pm
by WendyH
Набор универсальных функций и процедур визуальной формы настроек подкаста. Та же тема что и выше, только для работы с компьютера. Это простой велосипед, чтобы не изобретать потом. Для простых настроек.
Можно воспользоваться так:
1) Вставляем приведённый код набора функций в скрипт создания подкаст лент своего подкаста в верхнюю часть.
2) Сам код формирования подкаст лент оформляем отдельной процедурой, например procedure CreateMyPodcast();...
3) В главную процедуру скрипта ставим вызов показа формы настроек

Code: Select all

begin
  ShowParametersForm();
end.
4) В первой процедуре визуальной формы ParametersFormInit настраиваем и устанавливаем параметры формы:
[*]устанавливаем имя процедуры создания подкаст лент, например PARAMS.Values['ProcCreatePodcasts'] := 'CreateMyPodcast';
[*]Вписываем своё имя (Author), дату (Date) и текст приветов (About).
[*]Ниже редактируем под свои нужды список параметров

Список параметров может отображать визуальные элементы пока трёх классов CheckBox, ComboBox и Edit. Для простых задач этого может хватить.
По образу и подобию существующих там параметров задаёте свои.
Пояснения некоторых свойств параметров.
P.Values['Caption'] - Заголовок
P.Values['Hint' ] - всплывающая подсказка
Если класс CheckBox:
P.Values['Param' ] - сам параметр, который будет устанавливаться или сниматься.
Если класс ComboBox:
P.Values['caWidth'] - Caption width, ширина заголовка (до элемента ComboBox).
P.Values['coWidth'] - ComboBox width, ширина ComboBox
P.Values['Param0' ]
P.Values['Param1' ]
...
P.Values['ParamN ] - список параметров с их заголовком. Сначала идёт заголовок и сам параметр разделяются символом "|"
Если класс Edit:
P.Values['edWidth']- Edit width, ширина элемента Edit
P.Values['Default'] - значение по-умолчанию
P.Values['OnlyNum'] - если присвоить значение "Yes", "Y" или "1", то ввод в текстовое поле Edit будет органичен только цифрами
P.Values['Param'] - в этом случае параметр может выглядеть как --param=<N> или --param=<S>. Если используется <N>, то значение после знака равно будет добавлено как есть (например цифры), если будет стоять <S>, то значение будет добавлено после знака равно в кавычках, вот так -param="значение параметра".

На самом деле пользоваться просто. И куда меньше затрат по времени, чем писать для каждого случая свою форму.
Ну и редактировать её под свои нужды никто не запретит.
С первого взгляда может показаться чем-то замудрёным, если присмотреться - всё просто. Минимум операций для внедрения кода в свой скрипт.
[+] Набор функций визуальной формы настроек PascalScript

Code: Select all

// ============================================================================
// Форма настроек 21.02.2013 | НАЧАЛО НАБОРА ВИЗУАЛЬНЫХ ФУНКИЙ И ПРОЦЕДУР
// ============================================================================
var
  FORMOBJECTS: TStrings; // Глобальная переменная, для доступа из любых функций
// ----------------------------------------------------------------------------
procedure ParametersFormInit();
var
  P: TStrings; PARAMS: Variant;
begin
  PARAMS := GetFormObject('PARAMS');

  // Размеры формы
  PARAMS.Values['FormWidth' ] := '700';
  PARAMS.Values['FormHeight'] := '515';

  // Имя процедуры создания подкаст лент
  PARAMS.Values['ProcCreatePodcasts'] := '';

  // Значения, отображающиеся на вкладке "О программе"
  PARAMS.Values['About' ] := ' |Подкаст|-='+mpTitle+'=-|[ Home Media Server ]|***';
  PARAMS.Values['Date'  ] := '19.02.2013';
  PARAMS.Values['Author'] := 'NickName';

  // Список параметров
  P := CreateNewParam(PARAMS);
  P.Values['Class'  ] := 'CheckBox';
  P.Values['Caption'] := 'Не показывать прогресс обновления';
  P.Values['Hint'   ] := 'Отключить показ окна прогресса загрузки и обновлений на компьютере';
  P.Values['Param'  ] := '--noprogress';
  P := CreateNewParam(PARAMS);
  P.Values['Class'  ] := 'ComboBox';
  P.Values['Caption'] := 'Группировка';
  P.Values['caWidth'] := '114';
  P.Values['Hint'   ] := 'Включение особого способа руппировки';
  P.Values['coWidth'] := '270';
  P.Values['Param0' ] := 'По первым буквам названия ("А", "Б", ...)|--group=alph';
  P.Values['Param1' ] := 'По группам букв ("А..Г", "Д..З", ...)    |--group=alph2';
  P.Values['Param2' ] := 'По годам                                 |--group=year';
  P.Values['Param3' ] := 'Отключить группировку                    |--group=none';
  P := CreateNewParam(PARAMS);
  P.Values['Class'  ] := 'Edit';
  P.Values['Caption'] := 'Количество элементов в группе';
  P.Values['Hint'   ] := 'Максимальное количество элементов в группе при обычной группировке по количнеству';
  P.Values['caWidth'] := '270';
  P.Values['edWidth'] := '50';
  P.Values['Default'] := '100';
  P.Values['OnlyNum'] := 'Yes';
  P.Values['Param'] := '--maxingroup=<N>';
  P := CreateNewParam(PARAMS);
  P.Values['Class'  ] := 'Edit';
  P.Values['Caption'] := 'Макс. кол-во загружаемых страниц';
  P.Values['Hint'   ] := 'Максимальное количество загружаемых страниц (глубина просмотра). 0 - не ограничивать';
  P.Values['caWidth'] := '270';
  P.Values['edWidth'] := '50';
  P.Values['OnlyNum'] := 'Yes';
  P.Values['Default'] := '0';
  P.Values['Param'] := '--pages=<N>';
  P := CreateNewParam(PARAMS);
  P.Values['Class'  ] := 'ComboBox';
  P.Values['Caption'] := 'Добавить год в название';
  P.Values['caWidth'] := '194';
  P.Values['Hint'   ] := 'Добавление года в название видео, если его нет в названии и он установлен';
  P.Values['coWidth'] := '190';
  P.Values['Param0' ] := 'Добавлять год   |--yearintitle';
  P.Values['Param1' ] := 'Отключить добавление|--noyearintitle';
  P := CreateNewParam(PARAMS);
  P.Values['Class'  ] := 'ComboBox';
  P.Values['Caption'] := 'Удаление старых ссылок';
  P.Values['caWidth'] := '194';
  P.Values['Hint'   ] := 'Очистка списка уже добавленных ссылок при обновлении';
  P.Values['coWidth'] := '190';
  P.Values['Param0' ] := 'Не удалять старые ссылки |--nodelitems';
  P.Values['Param1' ] := 'Включить удаление ссылок |--delitems';
end;
// ----------------------------------------------------------------------------
procedure ShowParametersForm();
var
  i, iFormWidth, iFormHeight: Integer; T: TStrings; s: String;
  Control, frmMain, PodcastTree, PageCntrl, Page, Panel, PARAMS: Variant;
begin
  frmMain     := TForm.Create(Application);
  FORMOBJECTS := TStringList.Create();
  FORMOBJECTS.AddObject('frmMain', frmMain);
  FORMOBJECTS.AddObject('Timer',   TTimer.Create(frmMain));
  FORMOBJECTS.AddObject('PARAMS',  TStringList.Create()  );
  FORMOBJECTS.Values['IdStoreParams'] := IntToStr(mpiComment);

  ParametersFormInit();
  PARAMS := GetFormObject('PARAMS');
  iFormWidth  := StrToIntDef(PARAMS.Values['FormWidth' ], 700);
  iFormHeight := StrToIntDef(PARAMS.Values['FormHeight'], 515);
  
  try
    frmMain.Color     := $F0F0F0;
    frmMain.Width     := iFormWidth;
    frmMain.Height    := iFormHeight;
    frmMain.Caption   := 'Параметры подкаста '+mpTitle;
    frmMain.Position  := poScreenCenter;
    frmMain.Font.Size := 10;
    frmMain.OnResize    := 'evntFormOnResize';
    frmMain.OnCanResize := 'evntFormOnCanResize';

    CreateControl(frmMain, frmMain, TButton, 'btnOK',     'OK',     '', mrOK);
    CreateControl(frmMain, frmMain, TButton, 'btnCancel', 'Отмена', '', mrCancel);

    PageCntrl := CreateControl(frmMain, frmMain, TPageControl, 'PageCntrl');
    PageCntrl.SetBounds(0, 0, iFormWidth, iFormHeight - 40);

    // Страница "Параметры"
    Page := CreateControl(PageCntrl, PageCntrl, TTabSheet, 'Page1', 'Параметры');
    Page.SetBounds(0, 0, iFormWidth, iFormHeight);
    Page.PageControl := PageCntrl;
    Page.Visible     := true;
    Page.Tag         := 12;
    Page.OnEnter     := 'evntPageOnEnter';
    AddCaptionToPage(frmMain, Page, 'Установка параметров');

    PodcastTree := CreateControl(frmMain, Page, TTreeView, 'PdcstTree');
    PodcastTree.HideSelection := false;
    PodcastTree.RowSelect     := true;
    PodcastTree.ReadOnly      := true;
    PodcastTree.OnClick       := 'evntTreeOnClick';
    PodcastTree.Align         := alLeft;
    PodcastTree.Width         := 248;
    PodcastTree.Hint          := 'Структура подкаста. (Помните: вложенные папки наследуют параметры!)';
    PodcastTree.ShowHint      := true;
    BuildPodcastTree(PodcastTree.Items, FolderItem, nil);

    Control := CreateControl(frmMain, Page, TSplitter, 'splitter');
    Control.SetBounds(50, 10, 4, iFormHeight-44);
    Control.Align  := alLeft;

    Control := CreateControl(frmMain, Page, TScrollBox, 'prmPanel');
    Control.Align := alClient;
    ShowParameters();

    // Страница "Сервис"
    Page := CreateControl(PageCntrl, PageCntrl, TTabSheet, 'Page2', 'Сервис');
    Page.SetBounds(0, 0, iFormWidth, iFormHeight);
    Page.Visible     := true;
    Page.PageControl := PageCntrl;
    Page.Tag         := 12;
    Page.OnEnter     := 'evntPageOnEnter';

    AddCaptionToPage(frmMain, Page, 'Сервисные функции');
    if PARAMS.Values['ProcCreatePodcasts']<>'' then begin
      Panel := CreateControl(frmMain, Page, TGroupBox, 'G1', 'Инициализация:');
      Panel.Color := $F0F0F0;
      Panel.SetBounds(10, 50, 300, 140);
      Panel.Align := alLeft;
      AddText2Panel(frmMain, Panel, 'Пересоздание структуры подкаста.', 0, 11, false, 'Tahoma');
      AddText2Panel(frmMain, Panel, 'Внимание! Все добавленные ссылки будут удалены и настройки установлены по-умолчанию.', $333390, 9, true);
      AddText2Panel(frmMain, Panel, 'Структура и список категорий будут созданы заного, как они есть на сайте ресурса.', 0, 9);
      AddText2Panel(frmMain, Panel, '', 0, 4);
      Control := CreateControl(frmMain, Panel, TButton, 'BC1', 'Создать структуру');
      Control.Align := alTop;
      Control.OnClick := PARAMS.Values['ProcCreatePodcasts'];
    end;

    // Страница "О подкасте"
    Page := CreateControl(PageCntrl, PageCntrl, TTabSheet, 'Page3', 'О подкасте');
    Page.SetBounds(0, 0, iFormWidth, iFormHeight);
    Page.Visible     := true;
    Page.PageControl := PageCntrl;
    Page.Tag         := 33;
    Page.OnEnter     := 'evntPageOnEnter';
    T := TStringList.Create();
    
    s := PARAMS.Values['About'];
    for i:=1 to WordCount(s, '|') do begin
      Control := AddText2Panel(frmMain, Page, ExtractWord(i, s, '|'), $866649, 24, false, 'Impact', false);
    end;
    AddText2Panel(frmMain, Page, '________________________', $247FFF, 14, true);

    AddText2Panel(frmMain, Page, PARAMS.Values['Date'  ], $B8997C, 16, false, 'Impact');
    AddText2Panel(frmMain, Page, PARAMS.Values['Author'], $FB8936, 20, true, 'Tahoma');

    PageCntrl.ActivePage := PageCntrl.Pages[1];
    PageCntrl.ActivePage := PageCntrl.Pages[0];
    frmMain.ActiveControl := PodcastTree;
    if (PodcastTree.Items.Count>1) then PodcastTree.Selected := PodcastTree.Items[1];
    PodcastTree.Selected  := PodcastTree.Items[0];

    evntTreeOnClick(PodcastTree);
    if (frmMain.ShowModal() = mrOK) then begin
      StoreParamsToPodcast(PodcastTree, PodcastTree.Items[0]);
    end;
  finally
    FORMOBJECTS.Free();
    PodcastTree.Free();
    frmMain.Free();
  end;
end;
// ----------------------------------------------------------------------------
procedure AddText2Panel(frmMain, Panel: Variant; sText: String;
  nColor, nFontSize: Integer=nil; bBold: Boolean=false; sFont: String=''; bWrap: Boolean=true);
var
  aLabel: Variant;
begin
  aLabel := CreateControl(frmMain, Panel, TLabel);
  aLabel.Transparent := true;
  aLabel.WordWrap    := bWrap;
  aLabel.Caption     := sText;
  aLabel.Width       := Panel.Width;
  aLabel.Alignment   := 2;
  if (bBold)          then aLabel.Font.Style := fsBold;
  if (nColor<>nil)    then aLabel.Font.Color := nColor;
  if (nFontSize<>nil) then aLabel.Font.Size  := nFontSize;
  if (sFont<>'')      then aLabel.Font.Name  := sFont;
  aLabel.Align       := alTop;
end;
// ----------------------------------------------------------------------------
procedure StoreParamsToPodcast(PodcastTree: TTreeView; Node: TTreeNode);
var
  NodeData, PodcastItem: Variant; sParams: String; i, n, iIdStoreParams: Integer;
begin
  iIdStoreParams := StrToIntDef(FORMOBJECTS.Values['IdStoreParams'], mpiComment);
  for i:=0 to PodcastTree.Items.Count-1 do begin
    NodeData := PodcastTree.Items[i].Data;
    sParams  := Trim(NodeData.Values['Params']);
    n := NodeData.IndexOf('Item'); if (n<0) then continue;
    PodcastItem := NodeData.Objects[n];
    PodcastItem[iIdStoreParams] := sParams;
  end;
end;
// ----------------------------------------------------------------------------
procedure evntFormOnResize(frm: Variant);
var
  iW, iH: Integer; Control: Variant;
begin
  iW := frm.ClientWidth;
  iH := frm.ClientHeight;
  BoundControl('PageCntrl', 0, 0, iW, iH - 44);
  BoundControl('btnOK',     iW -  85, iH - 35,  75,  25);
  BoundControl('btnCancel', iW - 170, iH - 35,  75,  25);

  Control := GetFormObject('LineAbout');
  if (Control<>nil) then Control.Left := Round(iW/2 - Control.Width/2)-4;
end;
// ----------------------------------------------------------------------------
procedure AddCaptionToPage(frmMain, Page: Variant; sCapt: String='';
            Color: Integer = $866649; nHeight: Integer=36; nSize: Integer=18);
var
  TopPanel, aLabel, Line, aClrs1, aClrs2: Variant; iClr: Integer;
begin  
  // Не мог определиться с палитрой...
  aClrs1 := [$866649, $555555, $FB8936, $247FFF, $2A7CCA, $666666];
  aClrs2 := [$B8997C, $808077, $247FFF, $FB8936, $AA8926, $6C60EC];
  frmMain.Tag := 3; // Номер набора цвета заголовков страниц
  if frmMain.Tag=0 then frmMain.Tag := Round(Random()*(Length(aClrs1)-1))+1;
  TopPanel := CreateControl(frmMain, Page, TPanel);
  TopPanel.Color     := $F0F0F0;
  TopPanel.Height    := nHeight;
  TopPanel.Align     := alTop;
  Line := CreateControl(frmMain, TopPanel, TShape, Page.Name+'Line', sCapt);
  Line.Brush.Color := aClrs2[frmMain.Tag-1];
  Line.Pen.Style   := psClear;
  Line.SetBounds(10, 24, 0, 3);
  aLabel := CreateControl(frmMain, TopPanel, TLabel, Page.Name+'Capt', sCapt);
  aLabel.Font.Size  := nSize;
  aLabel.Font.Style := fsBold;
  aLabel.Font.Color := aClrs1[frmMain.Tag-1];
  aLabel.Font.Name  := 'Trebuchet MS';
  aLabel.Transparent:= true;
  aLabel.AutoSize   := true;
  aLabel.Left :=  10;
  aLabel.Top  := -84;
end;
// ----------------------------------------------------------------------------
procedure evntPageOnEnter(Page: Variant);
var
  aLabel, Line, Timer: Variant;
begin
  Timer := GetFormObject('Timer');
  if (Page.Tag=33) then begin
    Timer.Interval:= 33;
    Timer.OnTimer := 'evntAboutFXOnTimer';
    Timer.Enabled := true;
  end;
  if (Page.Tag=12) then begin
    aLabel := GetFormObject(Page.Name+'Capt'); if (aLabel = nil) then Exit;
    if (aLabel.Top >0) then Exit;
    aLabel.Top := -84;
    Line  := GetFormObject(Page.Name+'Line'); if (Line  = nil) then Exit;
    Line.Width := 0;
    Timer.Interval:= 20;
    Timer.Tag     := StrToInt(Copy(Page.Name, 5, 2));
    Timer.OnTimer := 'evntPageCaptFXOnTimer';
    Timer.Enabled := true;
  end;
end;
// ----------------------------------------------------------------------------
function CreateNewParam(var PARAMS: TStrings; sText, sParam: String=''): TStrings;
var
  NEWPARAM: TStrings;
begin
  NEWPARAM := TStringList.Create();
  if (sText  <> '') then NEWPARAM.Values['Text' ] := sText;
  if (sParam <> '') then NEWPARAM.Values['Param'] := sParam;
  PARAMS.AddObject(IntToStr(PARAMS.Count), NEWPARAM);
  Result := NEWPARAM;
end;
// ----------------------------------------------------------------------------
function CreateControl(aForm: TWinControl; aParent: TWinControl; CLASS: Variant;
    CntrlName, sCaption, sHint: String=''; nModalResult: Integer=nil): Variant;
var
  Control: Variant;
begin
  Control := CLASS.Create(aForm);
  Control.Parent := aParent;
  if (sCaption     <> '') then Control.Caption     := sCaption;
  if (nModalResult <>nil) then Control.ModalResult := nModalResult;
  if (CntrlName    <> '') then begin
    Control.Name := CntrlName; 
    FORMOBJECTS.AddObject(CntrlName, Control); 
  end;
  if (sHint        <> '') then begin
    Control.Hint := sHint; 
    Control.ShowHint := true; 
  end;
  Result := Control;
end;
// ----------------------------------------------------------------------------
function GetFormObject(CntrlName: String): Variant;
var
  i: Integer;
begin
  i := FORMOBJECTS.IndexOf(CntrlName);
  if (i<0) then Result := nil
  else          Result := FORMOBJECTS.Objects[i];
end;
// ----------------------------------------------------------------------------
procedure BuildPodcastTree(TreeItems: TTreeNodes; ParentItem: THmsScriptMediaItem; Root: TTreeNode; nLevel: Integer=0; bF: Boolean=false);
var
  i, iIdStoreParams: Integer; Item, NodeData: Variant;
begin
  iIdStoreParams := StrToIntDef(FORMOBJECTS.Values['IdStoreParams'], mpiComment);
  // Фильтруем: только папки лент подкастов и подкасты
  if not bF then 
    if ((ParentItem.ItemClassID<>51)AND(ParentItem.ItemClassID<>53)) then Exit;
  NodeData := TStringList.Create();
  NodeData.Values['Params'] := ParentItem[iIdStoreParams];
  NodeData.AddObject('Item', ParentItem);
  Item := TreeItems.AddChild(Root, GetTreeNodeName(NodeData));
  Item.Data := NodeData;
  if (ParentItem.HasChildItems AND (nLevel<3)) then begin
    for i:=0 to ParentItem.ChildCount-1 do begin
      BuildPodcastTree(TreeItems, ParentItem.ChildItems[i], Item, nLevel+1, bF);
    end;
  end;
end;
// ----------------------------------------------------------------------------
procedure UpdateParameters(ParamsData: String='');
var
  i, n: Integer; nMaxLen: Integer=0;
  P, Control, Control2, PARAMS: Variant; sParam, sValue, sPId: String;
begin
  PARAMS := GetFormObject('PARAMS');
  for i:=0 to PARAMS.Count-1 do begin
    P := PARAMS.Objects[i]; if P = nil then continue; sPId := IntToStr(i);
    if        (P.Values['Class'] = 'CheckBox') then begin
      Control := GetFormObject('PCheckBox'+sPId);  if Control =nil then Exit;
      sParam  := P.Values['Param'];
      Control.OnClick := nil;
      Control.Checked := (Pos(sParam, ParamsData)>0);
      Control.OnClick := 'evntParamChanged';
      if Control.Checked then Control.Font.Style := 1 else Control.Font.Style := 0;
    end else if (P.Values['Class'] = 'ComboBox') then begin
      nMaxLen := 0;
      Control := GetFormObject('PCheckBox'+sPId);  if Control =nil then Exit; 
      Control.OnClick := nil;
      Control.Checked := false;
      Control2 := GetFormObject('PComboBox'+sPId); if Control2=nil then Exit;
      Control2.OnClick   := nil;
      Control2.ItemIndex := 0;
      sValue := Trim(P.Values['Param0']);
      n:=0; while (sValue<>'') do begin
        HmsRegExMatch('\|(.*?)$', sValue, sValue);
        if ((Pos(sValue, ParamsData)>0) AND (Length(sValue)>nMaxLen)) then begin
          Control2.ItemIndex := n;
          Control.Checked := true;
          nMaxLen:=Length(sValue);
        end;
        n := n + 1; sValue := Trim(P.Values['Param'+IntToStr(n)]);
      end;;
      Control2.Enabled := Control.Checked;
      Control.OnClick  := 'evntParamChanged';
      Control2.OnClick := 'evntParamChanged';
      if Control.Checked then Control.Font.Style := 1 else Control.Font.Style := 0;
    end else if (P.Values['Class'] = 'Edit') then begin
      Control  := GetFormObject('PCheckBox'+sPId); if Control =nil then Exit;
      Control2 := GetFormObject('PEdit'+sPId);     if Control2=nil then Exit; 
      if ((Control=nil) OR (Control2=nil)) then Exit;
      Control.OnClick := nil;
      Control2.OnExit := nil;
      Control.Checked := false;
      sParam := P.Values['Param'];
      sParam := ReplaceStr(sParam, '<N>', '(\d+)' );
      sParam := ReplaceStr(sParam, '<S>', '"(.*?)"');
      sValue := P.Values['Default'];
      Control.Checked  := HmsRegExMatch(sParam, ParamsData, sValue);
      Control2.Text    := sValue;
      Control2.Enabled := Control.Checked;
      Control.OnClick  := 'evntParamChanged';
      Control2.OnExit  := 'evntParamChanged';
      if Control.Checked then Control.Font.Style := 1 else Control.Font.Style := 0;
    end else if (P.Values['Class'] = 'RadioButton') then begin
    end;
  end;
end;
// ----------------------------------------------------------------------------
function GetTreeNodeName(NodeData: TStrings): String;
var
  sParamsData, PodcastItem: Variant; i: Integer;
begin
  Result := '';
  i := NodeData.IndexOf('Item'); if (i<0) then Exit;
  PodcastItem := NodeData.Objects[i];
  sParamsData := Trim(NodeData.Values['Params']);
  Result := PodcastItem[mpiTitle];
  if (Pos('--', sParamsData)>0) then begin
    Result := '('+IntToStr(WordCount(ReplaceStr(sParamsData, '--', '\n'), '\n'))+') '+PodcastItem[mpiTitle];
  end;
end;
// ----------------------------------------------------------------------------
function IsSetP(P: Variant; sName: String): Boolean;
begin
  Result := (UpperCase(LeftCopy(P.Values[sName], 1))='Y');
end;
// ----------------------------------------------------------------------------
procedure ShowParameters();
var
  P, Line, Control, ParamZone, frmMain, prmPanel, PARAMS: Variant;
  nLeft: Integer=10; nTop: Integer=10; nHeight: Integer=36;
  nWidth, i, n, naLabelWidth, nCntrlWidth: Integer; sValue, sParam: String;
begin
  PARAMS   := GetFormObject('PARAMS');   if (PARAMS  =nil) then Exit;
  frmMain  := GetFormObject('frmMain' ); if (frmMain =nil) then Exit;
  prmPanel := GetFormObject('prmPanel'); if (prmPanel=nil) then Exit;
  nWidth := prmPanel.Width - (nLeft*2) - 16;
  for i:=0 to PARAMS.Count-1 do begin
    P := PARAMS.Objects[i]; if P = nil then continue;
    if        (P.Values['Class'] = 'CheckBox') then begin
      Control := CreateControl(frmMain, prmPanel, TCheckBox, 'PCheckBox'+IntToStr(i), P.Values['Caption'], P.Values['Hint']);
      Control.SetBounds(nLeft, nTop+3, nWidth, 16);
      Control.Tag := i;
      Control.OnClick := 'evntParamChanged';
    end else if (P.Values['Class'] = 'ComboBox') then begin
      naLabelWidth := StrToIntDef(P.Values['caWidth'],  80);
      nCntrlWidth := StrToIntDef(P.Values['coWidth'], 160);
      Control := CreateControl(frmMain, prmPanel, TCheckBox, 'PCheckBox'+IntToStr(i), P.Values['Caption']+':', P.Values['Hint']);
      Control.SetBounds(nLeft, nTop+3, naLabelWidth, 18);
      Control.Tag := i;
      Control.OnClick := 'evntParamChanged';
      Control := CreateControl(frmMain, prmPanel, TComboBox, 'PComboBox'+IntToStr(i), P.Values['Caption'], P.Values['Hint']);
      Control.SetBounds(nLeft+naLabelWidth+4, nTop, nCntrlWidth, 16);
      Control.Enabled := false;
      Control.Style := csDropDownList;
      Control.Tag := i;
      sValue := P.Values['Param0'];
      n:=0; while (sValue<>'') do begin
        HmsRegExMatch2('^(.*?)\|(.*?)$', sValue, sValue, sParam);
        Control.Items.Add(sValue);
        n := n + 1;
        sValue := P.Values['Param'+IntToStr(n)];
      end;
      Control.ItemIndex := 0;
      Control.OnClick   := 'evntParamChanged';
    end else if (P.Values['Class'] = 'Edit') then begin
      naLabelWidth := StrToIntDef(P.Values['caWidth'], 80);
      nCntrlWidth := StrToIntDef(P.Values['coWidth'], 50);
      Control := CreateControl(frmMain, prmPanel, TCheckBox, 'PCheckBox'+IntToStr(i), P.Values['Caption']+':', P.Values['Hint']);
      Control.SetBounds(nLeft, nTop+3, naLabelWidth, 18);
      Control.Tag := i;
      Control.OnClick := 'evntParamChanged';
      Control := CreateControl(frmMain, prmPanel, TEdit, 'PEdit'+IntToStr(i), P.Values['Caption'], P.Values['Hint']);
      Control.SetBounds(nLeft+naLabelWidth+4, nTop, nCntrlWidth, 16);
      Control.Enabled := false;
      Control.Text := P.Values['Default'];
      Control.Tag  := i;
      Control.OnExit := 'evntParamChanged';
      if (IsSetP(P, 'OnlyNum')) then Control.OnKeyDown := 'evntOnKeyDownOnlyNum';
    end else if (P.Values['Class'] = 'RadioButton') then begin
      sValue := P.Values['Param0'];
      n:=0; while (sValue<>'') do begin
        HmsRegExMatch2('^(.*?)\|(.*?)$', sValue, sValue, sParam);
        Control := CreateControl(frmMain, prmPanel, TRadioButton, 'PRB'+IntToStr(i), sValue, P.Values['Hint']);
        n:=n+1; sValue := P.Values['Param'+IntToStr(n)];
        Control.SetBounds(nLeft, nTop, nWidth, 16);
        Control.Tag := i;
        Control.OnClick := 'evntParamChanged';
        nTop := nTop + 20;
      end;;
    end;
    Control := TGroupBox.Create(frmMain);
    Control.Parent := prmPanel;
    Control.SetBounds(nLeft, nTop+nHeight-8, nWidth, 3);
    nTop := nTop + nHeight;
  end;
end;
// ----------------------------------------------------------------------------
procedure BoundControl(CntrlName: String; nLeft, nTop, nWidth, nHeight: Integer);
var
  obj: Variant;
begin
  obj := GetFormObject(CntrlName);
  if obj<>nil then obj.SetBounds(nLeft, nTop, nWidth, nHeight);
end;
// ----------------------------------------------------------------------------
procedure evntOnKeyDownOnlyNum(obj: Variant; nKey: Integer; ShiftState: TShiftState);
begin
  obj.ReadOnly := ((nKey > 30) AND not HmsRegExMatch('[\d]', Chr(nKey), ''));
end;
// ----------------------------------------------------------------------------
function SortStr4Length(S: TStrings): TStrings;
var
  i, j: Integer; x: String;
begin
  for i:=1 to S.Count-1 do begin
    if Length(S[i]) < Length(S[i-1]) then begin
      x := S[i]; j := i;
      repeat begin S[j] := S[j-1]; j:=j-1; end; until not ((j>1) AND (Length(x)<=Length(S[j-1])));
      S[j] := x;
    end;
  end;
  Result := S;
end;
// ----------------------------------------------------------------------------
procedure SetUnsetParameter(sValue: String; AvaliableParams: TStrings);
var
  sParam, sParams, s: String; i: Integer; Node: Variant;
begin
  i := FORMOBJECTS.IndexOf('CurrentNode'); if (i<0) then Exit;
  Node := FORMOBJECTS.Objects[i]; if (Node = nil) then Exit;
  sParams := Node.Data.Values['Params'];
  AvaliableParams.Text := ReplaceStr(AvaliableParams.Text, '<N>', '\d+' );
  AvaliableParams.Text := ReplaceStr(AvaliableParams.Text, '<S>', '".*?"');
  AvaliableParams := SortStr4Length(AvaliableParams);
  i:=AvaliableParams.Count; while i>0 do begin
    i := i - 1;
    sParam := AvaliableParams[i]; if sParam='' then continue;
    if (HmsRegExMatch('('+sParam+')', sParams, s)) then begin
      sParams := ReplaceStr(sParams, ' '+s, '');
      sParams := ReplaceStr(sParams,     s, '');
    end;
  end;
  sParams := Trim(sParams)+' '+sValue;
  Node.Data.Values['Params'] := Trim(sParams);
  Node.Text := GetTreeNodeName(Node.Data);
end;
// ----------------------------------------------------------------------------
procedure evntParamChanged(obj: Variant);
var
  P, Control, Control2, PARAMS: Variant; AvalParams: TStrings;
  sParam, sValue, sPId: String; n: Integer;
begin
  PARAMS := GetFormObject('PARAMS');
  sParam :=''; sPId:=IntToStr(obj.Tag);
  AvalParams := TStringList.Create();
  P := PARAMS.Objects[obj.Tag];
    if        (P.Values['Class'] = 'CheckBox') then begin
      Control := GetFormObject('PCheckBox'+sPId);
      AvalParams.Add(P.Values['Param']);
      if Control.Checked then begin
        sParam := P.Values['Param'];
        Control.Font.Style := 1;
      end else begin
        Control.Font.Style := 0;
      end;
    end else if (P.Values['Class'] = 'ComboBox') then begin
      Control  := GetFormObject('PCheckBox'+sPId);
      if Control.Checked then Control.Font.Style := 1 else Control.Font.Style := 0;
      Control2 := GetFormObject('PComboBox'+sPId);
      if ((Control=nil) OR (Control2=nil)) then Exit;
      Control2.Enabled := Control.Checked;
      sValue := Trim(P.Values['Param0']);
      n:=0; while (sValue<>'') do begin
        HmsRegExMatch('\|(.*?)$', sValue, sValue);
        AvalParams.Add(sValue);
        if (Control2.ItemIndex = n) then sParam := sValue;
        n:=n+1; sValue := Trim(P.Values['Param'+IntToStr(n)]);
      end;;
      if not Control.Checked then sParam := '';
    end else if (P.Values['Class'] = 'Edit') then begin
      Control  := GetFormObject('PCheckBox'+sPId);
      if Control.Checked then Control.Font.Style := 1 else Control.Font.Style := 0;
      Control2 := GetFormObject('PEdit'+sPId);
      if ((Control=nil) OR (Control2=nil)) then Exit;
      Control2.Enabled := Control.Checked;
      AvalParams.Add(P.Values['Param']);
      if Control.Checked then begin
        sParam := P.Values['Param'];
        sParam := ReplaceStr(sParam, '<N>', Trim(Control2.Text));
        sParam := ReplaceStr(sParam, '<S>', '"'+Trim(Control2.Text)+'"');
      end;
    end else if (P.Values['Class'] = 'RadioButton') then begin
    end;
    SetUnsetParameter(sParam, AvalParams);
end;
// ----------------------------------------------------------------------------
procedure evntTreeOnClick(obj: Variant);
var
  Node: Variant; i: Integer;
begin
  Node := obj.Selected; if (Node = nil) then Exit;
  i := FORMOBJECTS.IndexOf('CurrentNode');
  if (i<0) then FORMOBJECTS.AddObject('CurrentNode', Node)
  else          FORMOBJECTS.Objects[i] := Node;
  if (Node.Data <> nil) then UpdateParameters(Node.Data.Values['Params']);
end;
// ----------------------------------------------------------------------------
procedure evntFormOnCanResize(frm: Variant; nNewWidth, nNewHeight: Integer; bResize: Boolean);
var
  nMinWidth, nMinHeight: Integer;
begin
  nMinWidth := 344; nMinHeight := 280;
  if (nNewWidth  < nMinWidth ) then nNewWidth  := nMinWidth;
  if (nNewHeight < nMinHeight) then nNewHeight := nMinHeight;
end;
// ----------------------------------------------------------------------------
procedure evntPageCaptFXOnTimer(obj: Variant);
var
  nSpeed, nTop: Integer; nLeftTo: Integer=10; nTopTo: Integer=0;
  aLabel, Line: Variant;
begin
  aLabel := GetFormObject('Page'+IntToStr(obj.Tag)+'Capt'); if aLabel=nil then Exit;
  aLabel.Top := aLabel.Top + Round((nTopTo - aLabel.Top) / 4) + 1;
  if aLabel.Top>=nTopTo then aLabel.Top := nTopTo;

  Line := GetFormObject('Page'+IntToStr(obj.Tag)+'Line'); if Line=nil then Exit;
  Line.Width := Line.Width + Round((aLabel.Width - Line.Width) / 4) + 1;
  if Line.Width>=aLabel.Width then Line.Width := aLabel.Width;
  if ((aLabel.Top=nTopTo) AND (Line.Width=aLabel.Width)) then obj.Enabled := false;
end;
// КОНЕЦ НАБОРА ВИЗУАЛЬНЫХ ФУНКЦИЙ И ПРОЦЕДУР
// ============================================================================
Незнаю, понадобиться ли кому-нибудь. Кода может быть и много, но ведь удобно же.

Обработка добавления динамической папки поиска в подкаст

Posted: Sun Jun 30, 2013 8:57 pm
by WendyH
Выкладываю обработку добавления динамической папки поиска в подкаст. Это для кодеров, которые хотят в подкаст добавить интерактивный поиск.

Делается это так:
1) скачиваете, распаковываете "Создать ПОИСК.cfg"
2) Домашний медиа-сервер - "Настройки" - в правой панели вторая кнопка снизу "Обработка" - кнопка "Загрузить" - выбрать файл "Создать ПОИСК.cfg", на вопрос "Очистить текущий список скриптов обработки медиаресурсов" ответить "Нет". Ок, Ок.

После этого в программе на панеле справа появится кнопка "Создать ПОИСК".
Встаём на подкаст и нажимаем кнопку.
Всё.
[+] Вот весь откомментированный скрипт C++ Script

Code: Select all

/*BeginDynamicSearchScript*/
#define mpiPreviousItemID 200104
#define mpiDoNothing      201100
THmsScriptMediaItem Root  = GetRoot();
string gsTextSearch       = HmsGetUserSearchText();
string gsMsg              = '';
string gsSuggestUrl       = 'http://www.google.ru/complete/search?sclient=psy-ab&q=';
string gsSuggestResultCut = '';
string gsSuggestRegExp    = '\\["(.*?)",';
string gsSuggestMethod    = 'GET';
int    gnSuggestNoUTFEnc  = 0;
///////////////////////////////////////////////////////////////////////////////
THmsScriptMediaItem GetRoot() {
  THmsScriptMediaItem folder = FolderItem;
  while ((folder[mpiFilePath]!='-SearchCommands') && (folder.ItemParent!=nil)) folder=folder.ItemParent;
  return folder;
}
///////////////////////////////////////////////////////////////////////////////
THmsScriptMediaItem CreateLink(THmsScriptMediaItem folder, string title, string img) {
  THmsScriptMediaItem Item = HmsCreateMediaItem(folder.ItemID, folder.ItemID);
  Item[mpiTitle    ] = title;
  Item[mpiThumbnail] = img;
  return Item;
}
///////////////////////////////////////////////////////////////////////////////
THmsScriptMediaItem CreateFolder(string title, string link) {
  if (Trim(title)=='') title = 'Пробел';
  THmsScriptMediaItem folder = FolderItem.AddFolder(link, true);
  folder[mpiTitle] = title;
  folder.CopyProperties(FolderItem, [200, 500, 501]); // Копируем тип папки, скрипт, язык срипта
  return folder;
}
///////////////////////////////////////////////////////////////////////////////
void AddPodcastSearch(string itemID) {
  THmsScriptMediaItem Folder, Item;
  if (Trim(gsTextSearch)=='') { gsMsg = 'Текст поиска не набран! Добавлять нечего.'; return; }
  if (LowerCase(gsTextSearch)==gsTextSearch) gsTextSearch = NameCase(gsTextSearch);
  if (Trim(itemID)!='') Folder = Root.ItemParent.FindItemByProperty(mpiItemID, itemID);
  else                  Folder = Root.ItemParent;
  Item = Folder.AddFolder(gsTextSearch, false);
  Item[mpiFilePath ] = Format('search="%s"', [gsTextSearch]);
  Item[mpiTitle    ] = gsTextSearch;
  HmsDatabaseAutoSave(false);
  gsMsg = Format('Подкаст "%s" добавлен в "%s"', [gsTextSearch, Folder[mpiTitle]]);
}
///////////////////////////////////////////////////////////////////////////////
void CreateSearchCommands() {
  THmsScriptMediaItem Item; int i;
  CreateFolder('#',   '-Chars=!:');
  CreateFolder('A-Z', '-Chars=AZ');
  CreateFolder('А-Я', '-Chars=АЯ');
  CreateFolder('Очистить текст поиска', '-Clear');
  CreateFolder('Добавить в папку '+Root.ItemParent[mpiTitle], '-Save=');
  for(i=0; i<Root.ItemParent.ChildCount; i++) {
    Item = Root.ItemParent.ChildItems[i];
    if (Item.ItemClassID==51) CreateFolder('Добавить в папку '+Item[mpiTitle], '-Save='+Item[mpiItemID]);
  }
  CreateFolder('Очистить историю поиска в папке '+Root.ItemParent[mpiTitle], '-ClearHistory=');
  for(i=0; i<Root.ItemParent.ChildCount; i++) {
    Item = Root.ItemParent.ChildItems[i];
    if (Item.ItemClassID==51) CreateFolder('Очистить историю поиска в папке '+Item[mpiTitle], '-ClearHistory='+Item[mpiItemID]);
  }
}
///////////////////////////////////////////////////////////////////////////////
void ClearSearchHistory(string itemID) {
  THmsScriptMediaItem Folder, Item;
  if (Trim(itemID)!='') Folder = Root.ItemParent.FindItemByProperty(mpiItemID, itemID);
  else                  Folder = Root.ItemParent;
  for(int i=0; i<Folder.ChildCount; i++) {
    Item = Folder.ChildItems[i]; // Ищем все элементы, у которых значение mpiFilePath начиначется с 'search'
    if (LeftCopy(Item[mpiFilePath], 6)=='search') { Item.Delete(); i--; }
  }
  gsMsg = 'История поиска в папке "'+Folder[mpiTitle]+'" очищена';
}
///////////////////////////////////////////////////////////////////////////////
void CreateCharFolders(string chars) {
  string ch1 = Copy(chars, 1, 1); string ch2 = Copy(chars, 2, 1);
  CreateFolder('Удалить последний символ', '-Char=Delete'); // Вначале - команда удаления символа
  CreateFolder(' ', '-Char= '); // Пробел
  for (int i=ord(ch1); i<=ord(ch2); i++) CreateFolder(Chr(i), '-Char='+Chr(i));
}
///////////////////////////////////////////////////////////////////////////////
void LoadSuggestions() {
  string text, server, page, post, urlBase, headers, retHeaders, sCh, s; int i, nCnt, nPort, nTotalItems;
  // Suggestions ------ Блок работы с подсказками -------
  if ((LeftCopy(gsTextSearch, 1)==' ') || (Trim(gsSuggestUrl)=='') || (Length(gsTextSearch)<2)) return;
  nPort = 80; if (LeftCopy(gsSuggestUrl, 5)=="https") nPort = 443;
  text = gsTextSearch; if (gnSuggestNoUTFEnc==0) text = HmsUtf8Encode(text); // Если не указано не кодировать в UTF - кодируем
  text = HmsPercentEncode(text);
  // Если есть ключ <TEXT> в запросе - заменяем его на значение набранного текста, иначе просто добавляем в конец
  if (Pos('<TEXT>', gsSuggestUrl)>0) gsSuggestUrl = ReplaceStr(gsSuggestUrl, '<TEXT>', text);
  else                               gsSuggestUrl += text;
  HmsRegExMatch3('(https?://(.*?))(/.*)', gsSuggestUrl, urlBase, server, page);
  if (gsSuggestMethod=='POST') HmsRegExMatch2('^(.*?)\\?(.*)', page, page, post);
  headers = urlBase+'/\r\n'+
            'Accept-Encoding: gzip, deflate\r\n'+
            'User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64; rv:13.0) Gecko/20100101 Firefox/13.0\r\n'+
            'Connection: Keep-Alive\r\n'+
            'Origin: '+urlBase+'/\r\n'+
            'Accept: application/json, text/javascript, */*; q=0.01\r\n';    // Для включения возможности gzip в запросах
  text = HmsSendRequestEx(server, page, gsSuggestMethod, 'application/x-www-form-urlencoded; Charset=UTF-8', headers, post, nPort, 0x10, retHeaders, true);
  text = HmsUtf8Decode(text);
  if (gsSuggestResultCut!='') HmsRegExMatch(gsSuggestResultCut, text, text);// Если есть выражение обрезки - обрезаем
  text              = HmsJsonDecode(text); TRegExpr t = TRegExpr.Create('(<[^>]+>)');    // Избавляемся от тегов в середине слов подсказки
  TRegExpr reSearch = TRegExpr.Create(gsSuggestRegExp, PCRE_SINGLELINE);
  if (reSearch.Search(text)) do {
    s = reSearch.Match; nTotalItems=0;
    if (t.Search(s)) do s=ReplaceStr(s, t.Match, ''); while (t.SearchAgain());// (функция HmsHtmlToText не подходит т.к. ставит пробел в середине слова)
    if (HmsRegExMatch('^(.*?)[/\\(\\|]', s, sCh)) {                           // Обрезаем подсказку до знаков /, ( или |
      if (Pos(LowerCase(gsTextSearch), LowerCase(sCh))>0) s = sCh;            // Если после этого в подсказке встречается набранный текст - то так и оставляем
    }
    if (Pos(LowerCase(gsTextSearch), LowerCase(s))<1) continue;
    if (LowerCase(s)==s) s = NameCase(s);                                     // Если подсказки - все маленькие буквы, делаем NameCase
    // Если в подсказке больше одного слова - дополнительно создаём сначала подсказки из слов, которые содержат набранный текст (выделяем слова отдельно)
    if (WordCount(s, ' ')>1) {
      nCnt = WordCount(s, ' ');
      for (i=1; i<=nCnt; i++) {
        sCh=ExtractWord(i, s, ' '); if (Trim(sCh)=='') continue;
        if (Pos(LowerCase(gsTextSearch), LowerCase(sCh))<1) continue;
        if (LowerCase(gsTextSearch)==LowerCase(sCh)) continue;
        sCh = ReplaceStr(ReplaceStr(ReplaceStr(sCh, '\\', ''), ',', ''), ':', '');
        CreateFolder('Вариант: '+sCh, '-SetText='+sCh);
      }
    } nTotalItems++;
    // Создаём папку с предложением варианта (подсказку)
    if (LowerCase(s)!=LowerCase(gsTextSearch)) CreateFolder('Вариант: '+s, '-SetText='+s);
    if (nTotalItems>100) break; // Ограничиваем количество создаваемых элементов = 100
  } while (reSearch.SearchAgain());
}
///////////////////////////////////////////////////////////////////////////////
{
  string chars;
  // Если это повторный вызов, смены папки не произошло - ничего не делаем
  if ((FolderItem.ItemID==Root[mpiPreviousItemID]) && !DebugMode && (FolderItem[mpiFilePath]!='-SearchCommands')) return;
  FolderItem.DeleteChildItems(); Root[mpiPreviousItemID] = FolderItem.ItemID;
  if (Root[mpiDoNothing]=='1') Root[mpiDoNothing] = '';  // Флаг "Ничего не делать" - например, при возврате в команду набирания буквы из подпапки варианта
  else if (mpFilePath=='-SearchCommands') CreateSearchCommands();
  else if (mpFilePath=='-Clear'         ) gsTextSearch = '';
  else if (mpFilePath=='-Char=Delete'   ) gsTextSearch = LeftCopy(gsTextSearch, Length(gsTextSearch)-1); // Удаление последнего символа
  else if (HmsRegExMatch('-Save=(.*)'        , mpFilePath, chars)) AddPodcastSearch  (chars);
  else if (HmsRegExMatch('-ClearHistory=(.*)', mpFilePath, chars)) ClearSearchHistory(chars);
  else if (HmsRegExMatch('-Char=(.+)'   , mpFilePath, chars)) { if (chars=='') chars =' '; gsTextSearch += chars; }
  else if (HmsRegExMatch('-Chars=(.+)'  , mpFilePath, chars)) CreateCharFolders(chars);
  else if (HmsRegExMatch('-SetText=(.+)', mpFilePath, chars)) { gsTextSearch = chars; Root[mpiDoNothing]='1'; } // включаем флаг не выполнять команду при возврате из этой папки
 
  HmsSetUserSearchText(gsTextSearch);
  if (gsMsg!='') CreateLink(FolderItem, gsMsg, 'http://wonky.lostcut.net/icons/ok.png');
  else           CreateLink(FolderItem, 'Текст поиска: '+gsTextSearch, 'http://wonky.lostcut.net/icons/search-icon1.jpg');
  CreateLink(Root, 'Текст поиска: '+gsTextSearch, 'http://wonky.lostcut.net/icons/search-icon1.jpg');
 
  if (HmsRegExMatch('-(Char)=', mpFilePath, '')) LoadSuggestions();
 
  HmsIncSystemUpdateID(); // Говорим устройству об обновлении содержания
}/*EndDynamicSearchScript*/
Динамическая папка поиска непривязана ни к чему и самодостаточна. И она просто создаёт подкасты с названием. А как производить поиск по таким созданным папкам - это уже дела самого подкаста, где эта папка. Если в подкасте уже реализован поиск по таким подкастам (предлагаю отбрабатывать через поиск подкасты, в ссылке которых нет http), то просто добавив такую папку мы добавляем возможность поиска не вставая с дивана.

Вообще, создание именно такой универсальной папки поиска сподвигла меня просьба добавить такой поиск в музыкальный подкаст. И я решил - чтобы вручную не переносить подобные подкасты, написать обработку, которая это будет делать одним движением. Начал делать и ... меня понесло.
Сделал возможность набора с подсказками вариантов и добавлением в разные папки. Универсализировал, функционизировал, переписал всё напрочь, а значит - теперь нет простоты и красоты кода. Но все основные настройки вынес вверх скрипта.
После добавления этой динамической папки, открыв скрипт - вверху можно увидеть все настройки и сообщения.
Т.е. перевести на другой язык, например, можно легко - присвоив другие строковые значения в одном месте.

Также для работы подсказок при набирании слова там есть несколько переменных:

Code: Select all

char gsSuggestQuery    = '';
char gsSuggestResultCut= '';
char gsSuggestRegExpr  = '';
char gsSuggestMethod   = 'GET';                                                                     
int  gnSuggestNoUTFEnc = 0;                                                                         
char gsSuggestMessage  = 'Вариант: ';
Где
gsSuggestQuery - строка запроса на сайт, где можно получить список интересующих выражений (поиск)
gsSuggestResultCut - регулярное выражение обрезки нужного участка в ответе, для поиска в нём данных
gsSuggestRegExpr - регулярное выражение поиска блоков, содержащих варианты предложений (подсказок).

Поиск работать будет и с пустыми значениями этих переменных. Просто без подсказок. Ну а с ними - сооовсем другое дело!
Для включения такой возможности - появления предложений вариантов - нужно всего-лишь заполнить эти переменные.

Например.
для музыкального подкаста Музыка на Yandex.ru от 2012-06-30 эти сроки будут такими:

Code: Select all

char gsSuggestQuery    = 'http://suggest-music.yandex.ru/suggest-ya.cgi?v=3&part=';
char gsSuggestResultCut= '(\\[.*?\\])';
char gsSuggestRegExpr  = '"(.*?)"(?:,|\\])';
Для подкаста Stepashka.com:

Code: Select all

char gsSuggestQuery    = 'http://online.stepashka.com/index.php?do=search&subaction=search&full_search=1&story=<TEXT>&titleonly=3';
char gsSuggestResultCut= '';
char gsSuggestRegExpr  = 'shortstory.*?(<h3.*?</h3>)';
char gsSuggestMethod   = 'POST';
Для HDKinoteatr.ru:

Code: Select all

char gsSuggestQuery    = 'http://www.hdkinoteatr.ru/index.php?do=search&subaction=search&full_search=1&story=<TEXT>&titleonly=3';
char gsSuggestResultCut= '';
char gsSuggestRegExpr  = 'shortstory.*?(<h3.*?</h3>)';
char gsSuggestMethod   = 'POST';
Google подсказки:

Code: Select all

char gsSuggestQuery    = 'http://www.google.ru/complete/search?sclient=psy-ab&q=';
char gsSuggestResultCut= '';
char gsSuggestRegExpr  = '\\["(.*?)",';
Google видео:

Code: Select all

char gsSuggestQuery    = 'http://clients1.google.ru/complete/search?client=video-hp&q=';
char gsSuggestResultCut= '';
char gsSuggestRegExpr  = '\\["(.*?)",';
Всё очень просто.
И при работе с таким режимом - намного удобней что-то искать, я вам скажу.

UPD от 2020.01.27:
Скрипт на языке JScript, который должен одинаково работать на версиях HMS 3.0 и ниже. Постарался сделать его более простым и понятным.
Этот скрипт должен быть в динамической папке с именем "Набрать текст" и ссылкой "-SearchCommands".
[+] Сам скрипт на языке JScript

Code: Select all

/*BeginSearchJScript*/
mpiPreviousItemID  = 200104;
mpiDoNothing       = 201100;
Root               = GetRoot();
gsTextSearch       = HmsGetUserSearchText();
gsMsg              = '';
gsSuggestUrl       = 'http://www.google.ru/complete/search?sclient=psy-ab&q=';
gsSuggestResultCut = '';
gsSuggestRegExp    = '\\["(.*?)",';
gsSuggestMethod    = 'GET';
gnSuggestNoUTFEnc  = 0;
///////////////////////////////////////////////////////////////////////////////
function GetRoot() {
  folder = FolderItem;
  while ((folder[mpiFilePath]!='-SearchCommands') && (folder.ItemParent!=nil)) folder=folder.ItemParent;
  return folder;
}
///////////////////////////////////////////////////////////////////////////////
function CreateLink(folder, title, img) {
  Item = HmsCreateMediaItem(folder.ItemID, folder.ItemID);
  Item[mpiTitle    ] = title;
  Item[mpiThumbnail] = img;
}
///////////////////////////////////////////////////////////////////////////////
function CreateFolder(title, link) {
  if (Trim(title)=='') title = 'Пробел';
  folder = FolderItem.AddFolder(link, true);
  folder[mpiTitle] = title;
  folder.CopyProperties(FolderItem, [200, 500, 501]); // Копируем тип папки, скрипт, язык срипта
}
///////////////////////////////////////////////////////////////////////////////
function AddPodcastSearch(itemID) {
  if (Trim(gsTextSearch)=='') { gsMsg = 'Текст поиска не набран! Добавлять нечего.'; return; }
  if (LowerCase(gsTextSearch)==gsTextSearch) gsTextSearch = NameCase(gsTextSearch);
  if (Trim(itemID)!='') Folder = Root.ItemParent.FindItemByProperty(mpiItemID, itemID);
  else                  Folder = Root.ItemParent;
  Item = Folder.AddFolder(gsTextSearch, false);
  Item[mpiFilePath ] = Format('search="%s"', [gsTextSearch]);
  Item[mpiTitle    ] = gsTextSearch;
  HmsDatabaseAutoSave(false);
  gsMsg = Format('Подкаст "%s" добавлен в "%s"', [gsTextSearch, Folder[mpiTitle]]);
}
///////////////////////////////////////////////////////////////////////////////
function CreateSearchCommands() {
  CreateFolder('#',   '-Chars=!:');
  CreateFolder('A-Z', '-Chars=AZ');
  CreateFolder('А-Я', '-Chars=АЯ');
  CreateFolder('Очистить текст поиска', '-Clear');
  CreateFolder('Добавить в папку '+Root.ItemParent[mpiTitle], '-Save=');
  for(i=0; i<Root.ItemParent.ChildCount; i++) { 
    Item = Root.ItemParent.ChildItems[i];
    if (Item.ItemClassID==51) CreateFolder('Добавить в папку '+Item[mpiTitle], '-Save='+Item[mpiItemID]);
  }
  CreateFolder('Очистить историю поиска в папке '+Root.ItemParent[mpiTitle], '-ClearHistory=');
  for(i=0; i<Root.ItemParent.ChildCount; i++) { 
    Item = Root.ItemParent.ChildItems[i];
    if (Item.ItemClassID==51) CreateFolder('Очистить историю поиска в папке '+Item[mpiTitle], '-ClearHistory='+Item[mpiItemID]);
  }
}
///////////////////////////////////////////////////////////////////////////////
function ClearSearchHistory(itemID) {
  if (Trim(itemID)!='') Folder = Root.ItemParent.FindItemByProperty(mpiItemID, itemID);
  else                  Folder = Root.ItemParent;
  for(i=0; i<Folder.ChildCount; i++) {
    Item = Folder.ChildItems[i]; // Ищем все элементы, у которых значение mpiFilePath начиначется с 'search'
    if (LeftCopy(Item[mpiFilePath], 6)=='search') { Item.Delete(); i--; }
  }
  gsMsg = 'История поиска в папке "'+Folder[mpiTitle]+'" очищена';
}
///////////////////////////////////////////////////////////////////////////////
function CreateCharFolders(chars) {
  ch1 = Copy(chars, 1, 1); ch2 = Copy(chars, 2, 1);
  CreateFolder('Удалить последний символ', '-Char=Delete'); // Вначале - команда удаления символа
  CreateFolder(' ', '-Char= '); // Пробел
  for (i=ord(ch1); i<=ord(ch2); i++) CreateFolder(Chr(i), '-Char='+Chr(i));
}
///////////////////////////////////////////////////////////////////////////////
function LoadSuggestions() {
  // Suggestions ------ Блок работы с подсказками -------
  if ((LeftCopy(gsTextSearch, 1)==' ') || (Trim(gsSuggestUrl)=='') || (Length(gsTextSearch)<2)) return;
 
  nPort = 80; if (LeftCopy(gsSuggestUrl, 5)=="https") nPort = 443;
  text  = gsTextSearch; if (gnSuggestNoUTFEnc==0) text = HmsUtf8Encode(text); // Если не указано не кодировать в UTF - кодируем
  text  = HmsPercentEncode(text);
  // Если есть ключ <TEXT> в запросе - заменяем его на значение набранного текста, иначе просто добавляем в конец
  if (Pos('<TEXT>', gsSuggestUrl)>0) gsSuggestUrl = ReplaceStr(gsSuggestUrl, '<TEXT>', text);
  else                               gsSuggestUrl += text;
  HmsRegExMatch3('(https?://(.*?))(/.*)', gsSuggestUrl, urlBase, server, page);
  if (gsSuggestMethod=='POST') HmsRegExMatch2('^(.*?)\\?(.*)', page, page, post);
  headers = urlBase+'/\r\n'+
            'Accept-Encoding: gzip, deflate\r\n'+
            'User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64; rv:13.0) Gecko/20100101 Firefox/13.0\r\n'+
            'Connection: Keep-Alive\r\n'+
            'Origin: '+urlBase+'/\r\n'+
            'Accept: application/json, text/javascript, */*; q=0.01\r\n';    // Для включения возможности gzip в запросах
  text = HmsSendRequestEx(server, page, gsSuggestMethod, 'application/x-www-form-urlencoded; Charset=UTF-8', headers, post, nPort, 0x10, retHeaders, true);
  text = HmsUtf8Decode(text);
  if (gsSuggestResultCut!='') HmsRegExMatch(gsSuggestResultCut, text, text);// Если есть выражение обрезки - обрезаем
  text              = HmsJsonDecode(text); TRegExpr t = TRegExpr.Create('(<[^>]+>)');    // Избавляемся от тегов в середине слов подсказки
  TRegExpr reSearch = TRegExpr.Create(gsSuggestRegExp, PCRE_SINGLELINE);
  if (reSearch.Search(text)) do {
    s = reSearch.Match; gnTotalItems=0;
    if (t.Search(s)) do s=ReplaceStr(s, t.Match, ''); while (t.SearchAgain());// (функция HmsHtmlToText не подходит т.к. ставит пробел в середине слова)
    if (HmsRegExMatch('^(.*?)[/\\(\\|]', s, sCh)) {                           // Обрезаем подсказку до знаков /, ( или |
      if (Pos(LowerCase(gsTextSearch), LowerCase(sCh))>0) s = sCh;            // Если после этого в подсказке встречается набранный текст - то так и оставляем
    }
    if (Pos(LowerCase(gsTextSearch), LowerCase(s))<1) continue;
    if (LowerCase(s)==s) s = NameCase(s);                                     // Если подсказки - все маленькие буквы, делаем NameCase
    // Если в подсказке больше одного слова - дополнительно создаём сначала подсказки из слов, которые содержат набранный текст (выделяем слова отдельно)
    if (WordCount(s, ' ')>1) {
      nCnt = WordCount(s, ' ');
      for (i=1; i<=nCnt; i++) {
        sCh=ExtractWord(i, s, ' '); if (Trim(sCh)=='') continue;
        if (Pos(LowerCase(gsTextSearch), LowerCase(sCh))<1) continue;
        if (LowerCase(gsTextSearch)==LowerCase(sCh)) continue;
        sCh = ReplaceStr(ReplaceStr(ReplaceStr(sCh, '\\', ''), ',', ''), ':', '');
        CreateFolder('Вариант: '+sCh, '-SetText='+sCh);
      }
    } gnTotalItems++;
    // Создаём папку с предложением варианта (подсказку)
    if (LowerCase(s)!=LowerCase(gsTextSearch)) CreateFolder('Вариант: '+s, '-SetText='+s);
    if (gnTotalItems>100) break; // Ограничиваем количество создаваемых элементов = 100
  } while (reSearch.SearchAgain());
}
///////////////////////////////////////////////////////////////////////////////
{
  // Если это повторный вызов, смены папки не произошло - ничего не делаем
  if ((FolderItem.ItemID==Root[mpiPreviousItemID]) && !DebugMode && (FolderItem[mpiFilePath]!='-SearchCommands')) return;
  FolderItem.DeleteChildItems(); Root[mpiPreviousItemID] = FolderItem.ItemID;
  if (Root[mpiDoNothing]=='1') Root[mpiDoNothing] = '';  // Флаг "Ничего не делать" - например, при возврате в команду набирания буквы из подпапки варианта
  else if (mpFilePath=='-SearchCommands') CreateSearchCommands();
  else if (mpFilePath=='-Clear'         ) gsTextSearch = '';
  else if (mpFilePath=='-Char=Delete'   ) gsTextSearch = LeftCopy(gsTextSearch, Length(gsTextSearch)-1); // Удаление последнего символа
  else if (HmsRegExMatch('-Save=(.*)'        , mpFilePath, chars)) AddPodcastSearch  (chars);
  else if (HmsRegExMatch('-ClearHistory=(.*)', mpFilePath, chars)) ClearSearchHistory(chars);
  else if (HmsRegExMatch('-Char=(.+)'   , mpFilePath, chars)) { if (chars=='') chars =' '; gsTextSearch += chars; }
  else if (HmsRegExMatch('-Chars=(.+)'  , mpFilePath, chars)) CreateCharFolders(chars);
  else if (HmsRegExMatch('-SetText=(.+)', mpFilePath, chars)) { gsTextSearch = chars; Root[mpiDoNothing]='1'; } // включаем флаг не выполнять команду при возврате из этой папки
 
  HmsSetUserSearchText(gsTextSearch);
  if (gsMsg!='') CreateLink(FolderItem, gsMsg, 'http://wonky.lostcut.net/icons/ok.png');
  else           CreateLink(FolderItem, 'Текст поиска: '+gsTextSearch, 'http://wonky.lostcut.net/icons/search-icon1.jpg');
  CreateLink(Root, 'Текст поиска: '+gsTextSearch, 'http://wonky.lostcut.net/icons/search-icon1.jpg');
 
  if (HmsRegExMatch('-(Char)=', mpFilePath, '')) LoadSuggestions();
 
  HmsIncSystemUpdateID(); // Говорим устройству об обновлении содержания
}/*EndSearchJScript*/

Re: Универсальные функции и скрипты

Posted: Mon Jul 01, 2013 12:02 pm
by WendyH
2013.07.01 обновил обработку, вынес скрипт в сообщение выше и обработка теперь загружать будет этот скрипт отсюда. Т.е. скрипт можно будет обновлять здесь и обработка будет добавлять всегда актуальный сприпт.
И сделал приколюху - по умолчанию, пусть гугл нам тогда подсказывает.
Конечно, когда подсказки выводит интересующий сайт это совсем другое - там можно при наборе видеть, есть ли то на сайте, что мы начинаем искать.
All times are UTC+03:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited