DLNA-будильник

///////////////////////////////////////////////////////////////////////////////
// Отправка AVTransport команды устройству
Function AVTransport(sServerAddr, sServiceType, sControlUrl, sCmd: String): String;
Var
  nPort: Integer = 80; sData, sVal, sHeaders, sPayload, sRetHeaders: String;
Begin
  If (HmsRegExMatch2('^(.*?):(\d+)', sServerAddr, sServerAddr, sVal)) Then
    nPort := StrToInt(sVal);
  
  sHeaders := '/\r\nUser-Agent: SEC_HHP_Flipps/1.0'#10#13+
              Format('SOAPACTION: "%s#%s"', [sServiceType, sCmd]);
  
  sPayload := '<?xml version="1.0" encoding="utf-8"?>'#10#13+
              '<s:Envelope s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:s="http://schemas.xmlsoap.org/soap/envelope/">'#10#13+
              '  <s:Body>'#10#13+
              '      <u:' + sCmd + ' xmlns:u="' + sServiceType + '">'#10#13+
              '         <InstanceID>0</InstanceID>'#10#13+
              '      </u:' + sCmd + '>'#10#13+
              '   </s:Body>'#10#13+
              '</s:Envelope>';
  sData := HmsSendRequestEx(sServerAddr, sControlUrl, 'POST', 'text/xml; charset="utf-8"', 
                            sHeaders, sPayload, nPort, 0, sRetHeaders, true);
  Result := sRetHeaders + sData;
End;

///////////////////////////////////////////////////////////////////////////////
// Получение статуса устройства по его IP
Function GetDeviceStatus(sIP: String): String;
Var
  sStatus, sDMRurl, sData, sServiceType, sCtlUrl: String;
  DEVLIST: THmsScriptUPnPDeviceList; DEVICE: THmsScriptUPnPDevice;
  i, n: Integer;
Begin
  sStatus := 'UNKNOWN';
  DEVLIST := THmsScriptUPnPDeviceList.Create;
  Try
    For i := 0 To DEVLIST.Count-1 Do Begin
      DEVICE := DEVLIST[0];
      If (DEVICE.IpAddress <> sIP) Then Continue;
      sDMRurl := DEVICE.Properties[1];
      sData   := HmsRemoveLineBreaks(HmsDownloadURL(sDMRurl));
      HmsRegExMatch2('<serviceType>([^<]+AVTransport.*?)</serviceType>.*?<controlURL>(.*?)</controlURL>', sData, sServiceType, sCtlUrl);
      
      sData := AVTransport(DEVICE.HttpServerAddr, sServiceType, sCtlUrl, 'GetTransportInfo');
      HmsRegExMatch('<CurrentTransportState>(.*?)</CurrentTransportState>', sData, sStatus);
      break;
    End;
    
  Finally
    DEVLIST.Free;
  End;
  //Status - STOPPED|PAUSED_PLAYBACK|PAUSED_RECORDING|PLAYING|RECORDING|TRANSITIONING|NO_MEDIA_PRESENT
  Result := sStatus;
End;

///////////////////////////////////////////////////////////////////////////////
// Запуск воспроизведения, если статус устройства не 'PLAYING'
Procedure PlayIfNotPlaying(sDeviceIP, sFolderID, sFilePath: String);
Var
  Status: String; MediaItem: THmsScriptMediaItem;
Begin
  Status := GetDeviceStatus(sDeviceIP);
  If Status = 'PLAYING' Then Exit;
  
  MediaItem := HmsFindMediaFolder(sFolderID, sFilePath);
  If MediaItem <> nil Then
    HmsPlayToDevice(MediaItem, sDeviceIP)
  Else
    HmsLogMessage(2, "Не найден элемент базы данных, который нужно воспроизвести.");
End;

///////////////////////////////////////////////////////////////////////////////
//                     Г Л А В Н А Я   П Р О Ц Е Д У Р А                     //
///////////////////////////////////////////////////////////////////////////////
Begin

  PlayIfNotPlaying('192.168.1.107', mfVideoInternetTelevisionItemID, 'RTMP_server');  
  
End.

///////////////////////////////////////////////////////////////////////////////
// Отправка AVTransport команды устройству
string AVTransport(string sServerAddr, string sServiceType, string sControlUrl, string sCmd) {
  int nPort = 80; string sData, sVal, sHeaders, sPayload, sRetHeaders;
  
  if (HmsRegExMatch2('^(.*?):(\\d+)', sServerAddr, sServerAddr, sVal)) 
    nPort = StrToInt(sVal);
  
  sHeaders = '/\r\nUser-Agent: SEC_HHP_Flipps/1.0\r\n'+
             Format('SOAPACTION: "%s#%s"', [sServiceType, sCmd]);
  
  sPayload = '<?xml version="1.0" encoding="utf-8"?>\r\n'+
             '<s:Envelope s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:s="http://schemas.xmlsoap.org/soap/envelope/">\r\n'+
             '  <s:Body>\r\n'+
             '      <u:' + sCmd + ' xmlns:u="' + sServiceType + '">\r\n'+
             '         <InstanceID>0</InstanceID>\r\n'+
             '      </u:' + sCmd + '>\r\n'+
             '   </s:Body>\r\n'+
             '</s:Envelope>\r\n';
  sData = HmsSendRequestEx(sServerAddr, sControlUrl, 'POST', 'text/xml; charset="utf-8"', 
                           sHeaders, sPayload, nPort, 0, sRetHeaders, true);
  return sRetHeaders + sData;
}

///////////////////////////////////////////////////////////////////////////////
// Получение статуса устройства по его IP
string GetDeviceStatus(string sIP) {
  string sStatus, sDMRurl, sData, sServiceType, sCtlUrl;
  THmsScriptUPnPDeviceList DEVLIST; THmsScriptUPnPDevice DEVICE;
  int i, n;
  sStatus = 'UNKNOWN';
  DEVLIST = THmsScriptUPnPDeviceList.Create();
  try {
    for (i=0; i < DEVLIST.Count; i++) {
      DEVICE = DEVLIST[0];
      if (DEVICE.IpAddress != sIP) continue;
      sDMRurl = DEVICE.Properties[1];
      sData   = HmsRemoveLineBreaks(HmsDownloadURL(sDMRurl));
      HmsRegExMatch2('<serviceType>([^<]+AVTransport.*?)</serviceType>.*?<controlURL>(.*?)</controlURL>', sData, sServiceType, sCtlUrl);
      
      sData = AVTransport(DEVICE.HttpServerAddr, sServiceType, sCtlUrl, 'GetTransportInfo');
      HmsRegExMatch('<CurrentTransportState>(.*?)</CurrentTransportState>', sData, sStatus);
      break;
    }
    
  } finally { DEVLIST.Free; }
  //Status - STOPPED|PAUSED_PLAYBACK|PAUSED_RECORDING|PLAYING|RECORDING|TRANSITIONING|NO_MEDIA_PRESENT
  return sStatus;
}

///////////////////////////////////////////////////////////////////////////////
// Запуск воспроизведения, если статус устройства не 'PLAYING'
void PlayIfNotPlaying(string sDeviceIP, string sFolderID, string sFilePath) {
  string status; THmsScriptMediaItem MediaItem;
  
  status = GetDeviceStatus(sDeviceIP);
  if (status == 'PLAYING') exit;

  MediaItem = HmsFindMediaFolder(sFolderID, sFilePath);
  if (MediaItem != nil)
    HmsPlayToDevice(MediaItem, sDeviceIP);
  else
    HmsLogMessage(2, "Не найден элемент базы данных, который нужно воспроизвести.");
}

///////////////////////////////////////////////////////////////////////////////
//                     Г Л А В Н А Я   П Р О Ц Е Д У Р А                     //
///////////////////////////////////////////////////////////////////////////////
{
  
  PlayIfNotPlaying('192.168.1.107', mfVideoInternetTelevisionItemID, 'RTMP_server');  
  
}