По кнопке "Воспроизвести на" можно запустить воспроизведение текущего медиа-ресурса в главной форме программы на выбранное устройство. По таймеру обновляется текущее состояние выбранного устройства и позиция воспроизведения.
Специалисты Web-интерфейсов могут использовать данную функциональность для реализации "Воспроизвести на" в скрипте Web-навигации.
Описание UPnP-сервисов на сайте http://www.upnp.org (http://upnp.org/resources/upnpresources.zip)
В данном примере используется сервис AVTransport, описание в "\standardizeddcps\MediaServer_1 and MediaRenderer_1\UPnP-av-AVTransport-v1-Service-20020625.pdf"
Code: Select all
const
ciFormWidth = 370;
ciFormHeight = 320;
UPNP_DEVICE_MEDIA_SERVER = 2;
UPNP_DEVICE_MEDIA_RENDERER = 3;
udtServiceAvTransport = 7;
var
UPnpDeviceListBox: TListBox;
UPnPDeviceListForm: TForm;
UPnPDeviceList: THmsScriptUPnpDeviceList;
UPnpDeviceStatusLabel, UPnpDevicePositionLabel: TLabel;
function CreateButton(aParent: TWinControl; const aCaption: string; aLeft, aTop, aWidth, aHeight: Integer; aModalResult: Integer = mrNone): TButton;
begin
Result := TButton.Create(UPnPDeviceListForm);
Result.SetBounds(aLeft, aTop, aWidth, aHeight);
Result.Caption := aCaption;
Result.ModalResult := aModalResult;
Result.Parent := aParent
end;
function CreateLabel(aParent: TWinControl; const aCaption: string; aLeft, aTop: Integer): TLabel;
begin
Result := TLabel.Create(UPnPDeviceListForm);
Result.Left := aLeft;
Result.Top := aTop;
Result.Caption := aCaption;
Result.Parent := aParent
end;
function CreateGroupBox(aParent: TWinControl; const aCaption: string; aLeft, aTop, aWidth, aHeight: Integer): TGroupBox;
begin
Result := TGroupBox.Create(UPnPDeviceListForm);
Result.SetBounds(aLeft, aTop, aWidth, aHeight);
Result.Caption := aCaption;
Result.Parent := aParent
end;
function CreateListBox(aParent: TWinControl; aLeft, aTop, aWidth, aHeight: Integer): TListBox;
begin
Result := TListBox.Create(UPnPDeviceListForm);
Result.SetBounds(aLeft, aTop, aWidth, aHeight);
Result.Parent := aParent
end;
procedure DoPlayToDevice(Sender: TObject);
begin
if (HmsCurrentMediaListItem <> nil) and (UPnpDeviceListBox.ItemIndex <> - 1) then
HmsPlayToDevice(HmsCurrentMediaListItem, UPnPDeviceList[UPnpDeviceListBox.ItemIndex].Properties[udpIpAddress])
end;
procedure DoPause(Sender: TObject);
var
UPnPService: THmsScriptUPnPService;
begin
if UPnpDeviceListBox.ItemIndex <> - 1 then begin
UPnPService := UPnPDeviceList[UPnpDeviceListBox.ItemIndex].FindService(udtServiceAvTransport);
if UPnPService <> nil then
UPnPService.InvokeUPnPAction('Pause', ['InstanceID', '0'])
end
end;
procedure DoPlay(Sender: TObject);
var
ResponseItem: TXmlItem;
UPnPService: THmsScriptUPnPService;
begin
if UPnpDeviceListBox.ItemIndex <> - 1 then begin
UPnPService := UPnPDeviceList[UPnpDeviceListBox.ItemIndex].FindService(udtServiceAvTransport);
if UPnPService <> nil then begin
if UPnPService.InvokeUPnPActionWithResponseItem('Play', UPnPService.BuildActionContent('Play', ['InstanceID', '0', 'Speed', '1']), ResponseItem) <> 0 then
if ResponseItem <> nil then
ShowMessage(ResponseItem.SaveToString);
UPnPService.FreeResponseItem(ResponseItem)
end
end
end;
procedure DoDeviceStatus(Sender: TObject);
var
UPnPService: THmsScriptUPnPService;
vResultValues: Variant;
begin
if UPnpDeviceListBox.ItemIndex <> - 1 then begin
UPnPService := UPnPDeviceList[UPnpDeviceListBox.ItemIndex].FindService(udtServiceAvTransport);
if UPnPService <> nil then begin
if UPnPService.InvokeUPnPActionWithResultValues('GetTransportInfo', ['InstanceID', '0'], ['CurrentTransportState'], vResultValues) = 0 then begin
UPnpDeviceStatusLabel.Caption := vResultValues[0];
if UPnpDeviceStatusLabel.Caption = 'PLAYING' then begin
if UPnPService.InvokeUPnPActionWithResultValues('GetPositionInfo', ['InstanceID', '0'], ['RelTime'], vResultValues) = 0 then
UPnpDevicePositionLabel.Caption := vResultValues[0]
else
UPnpDevicePositionLabel.Caption := ''
end else
UPnpDevicePositionLabel.Caption := ''
end
end
end
end;
var
i: Integer;
UPnpDeviceListGroupBox: TGroupBox;
UPnPDeviceStatusTimer: TTimer;
begin
UPnPDeviceListForm := TForm.Create(Application);
try
UPnPDeviceListForm.BorderStyle := bsDialog;
UPnPDeviceListForm.ClientWidth := ciFormWidth;
UPnPDeviceListForm.ClientHeight := ciFormHeight;
UPnPDeviceListForm.Caption := 'Пример использования класса THmsScriptUPnpDeviceList';
UPnPDeviceListForm.Position := poScreenCenter;
UPnpDeviceListGroupBox := CreateGroupBox(UPnPDeviceListForm, '', 10, 10, ciFormWidth - 20, ciFormHeight - 55);
UPnpDeviceListBox := CreateListBox(UPnpDeviceListGroupBox, 10, 10, ciFormWidth - 50, UPnpDeviceListGroupBox.Height - 80);
CreateButton(UPnPDeviceListForm, 'OK', ciFormWidth - 170, ciFormHeight - 35, 75, 25, mrOK);
CreateButton(UPnPDeviceListForm, 'Отмена', ciFormWidth - 85, ciFormHeight - 35, 75, 25, mrCancel);
CreateButton(UPnpDeviceListGroupBox, 'Воспроизвести на', 10, UPnpDeviceListGroupBox.Height - 35, 100, 25).OnClick := @DoPlayToDevice;
CreateButton(UPnpDeviceListGroupBox, 'Пауза', 120, UPnpDeviceListGroupBox.Height - 35, 100, 25).OnClick := @DoPause;
CreateButton(UPnpDeviceListGroupBox, 'Продолжить', 230, UPnpDeviceListGroupBox.Height - 35, 100, 25).OnClick := @DoPlay;
CreateLabel(UPnpDeviceListGroupBox, 'Состояние: ', 15, UPnpDeviceListGroupBox.Height - 60);
UPnpDeviceStatusLabel := CreateLabel(UPnpDeviceListGroupBox, '', 85, UPnpDeviceListGroupBox.Height - 60);
CreateLabel(UPnpDeviceListGroupBox, 'Позиция: ', 200, UPnpDeviceListGroupBox.Height - 60);
UPnpDevicePositionLabel := CreateLabel(UPnpDeviceListGroupBox, '', 255, UPnpDeviceListGroupBox.Height - 60);
UPnPDeviceList := THmsScriptUPnPDeviceList.Create(UPNP_DEVICE_MEDIA_RENDERER);
try
for i := 0 to UPnPDeviceList.Count - 1 do
UPnpDeviceListBox.Items.Add(UPnPDeviceList[i].Properties[udpDisplayName]);
UPnPDeviceStatusTimer := TTimer.Create(UPnPDeviceListForm);
UPnPDeviceStatusTimer.OnTimer := @DoDeviceStatus;
UPnPDeviceStatusTimer.Enabled := True;
UPnPDeviceListForm.ShowModal;
UPnPDeviceStatusTimer.Enabled := False;
finally
UPnPDeviceList.Free
end
finally
UPnPDeviceListForm.Free
end
end.