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

Code: Select all

const               
  csItem        = '<a href=\".*?\">(.*?)</a>';
  csTitle       = '<title>(.*?)</title>';
  csProducer    = '<td class="type">продюсер</td><td>(.*?)</td>';
  csActors      = '<span class="title">В главных ролях:</span>(.*?)<span class="title">';
  csDirector    = '<td class="type">режиссер</td><td>(.*?)</td>';
  csGenre       = '<td class="type">жанр</td><td>(.*?)</td>';
  csYear        = '<td class="type">год</td><td class=""><a href=\".*?\">(.*?)</a></td>';
  csRate        = 'alt='#39'рейтинг (.*?)'#39' border';

function FindMediaInfo(const aHtmlText: string; const aRegEx: string; var aMatch: string): Boolean;
begin
  with TRegExpr.Create(aRegEx) do
  try
    Result := Search(aHtmlText);
    if Result then 
      aMatch := Match
  finally
    Free
  end    
end;

function FindMediaInfoMulti(const aHtmlText: string; const aRegExAll: string; const aRegExItem: string; var aMatch: string): Boolean;
var
  sMatch: string;
begin
  if FindMediaInfo(aHtmlText, aRegExAll, sMatch) then
  begin
    with TRegExpr.Create(aRegExItem) do 
    try
      if Search(sMatch) then             
      repeat
        if Match <> '...' then
        begin
          aMatch := aMatch + Match + ', ';
        end;
      until not SearchAgain; 
    finally
      Free;
    end;    
    Delete(aMatch, Length(aMatch) - 1, 2);
  end;
end;

procedure ProcessItem(aItem: THmsScriptMediaItem; var aSuccessCount: Integer);
var
  i: Integer;
  html: string;
  filmName: string;
  res: Boolean;
  sMatch: string;
  
begin
  filmName := HmsHttpEncode(LeftCopy(aItem.Properties[4], Length(aItem.Properties[4]) - 4)); 
  html := HmsDownloadURL('http://www.kinopoisk.ru/index.php?kp_query=' + filmName);
  res := FindMediaInfo(html, '<a class="all" href=\"(.*?)\">.*?</a>', sMatch);
  html := HmsDownloadURL('http://www.kinopoisk.ru' + sMatch);

  if FindMediaInfo(html, csTitle, sMatch) then 
  begin
    aItem.Properties[4] := sMatch;
  end;

  sMatch := '';
  if FindMediaInfoMulti(html, csDirector, csItem, sMatch) then 
  begin
    aItem.Properties[28] := sMatch;
  end;

  sMatch := '';
  if FindMediaInfoMulti(html, csProducer, csItem, sMatch) then 
  begin
    aItem.Properties[29] := sMatch;
  end;

  sMatch := '';
  if FindMediaInfoMulti(html, csGenre, csItem, sMatch) then 
  begin
    aItem.Properties[9] := sMatch;
  end;
  
  sMatch := '';
  if FindMediaInfoMulti(html, csActors, csItem, sMatch) then 
  begin
    aItem.Properties[36] := sMatch;
  end;

  if FindMediaInfo(html, csYear, sMatch) then 
  begin
    aItem.Properties[8] := sMatch;
  end;

  if FindMediaInfo(html, csRate, sMatch) then 
  begin
    aItem.Properties[30] := sMatch;
  end;

  aSuccessCount := aSuccessCount + 1;
end;
 
var
  i, iSuccessCount: Integer;
  MediaItemList: THmsScriptMediaItemList;

begin
  MediaItemList := HmsCurrentMediaListItems;
  try
    iSuccessCount := 0;  
    if MediaItemList.Count > 0 then begin
      HmsShowProgress('Загрузка метаданных...');
      try
        for i := 0 to MediaItemList.Count - 1 do begin
          if HmsCancelPressed then
            Break
          else begin  
            ProcessItem(MediaItemList[i], iSuccessCount);
            HmsSetProgress(Round(((i + 1) / MediaItemList.Count) * 100))
          end  
        end  
      finally
        HmsHideProgress
      end      
    end;
    if HmsCancelPressed then
      MessageDlg('Загрузка прервана пользователем.', mtError, mbOK, 0)
    else if iSuccessCount > 0 then
      MessageDlg('Загрузка метаданных прошла успешно.', mtInformation, mbOK, 0)
    else
      MessageDlg('Нет информации для загрузки.', mtError, mbOK, 0)
  finally
    MediaItemList.Free
  end;
  HmsDatabaseAutoSave;
  ProcessMediaResult := True      
end.