查看 UPnP 服务，以及查看 UPnP DLNA 服务
4.91/5 (4投票s)
一个用于查看 UPnP 服务和 UPnP DLNA 服务的应用程序
引言
有两个选项卡，一个用于查看 UPnP 服务，另一个用于查看 DLNA 服务。每个选项卡都有一个按钮来获取数据。对于 UPnP，我们以树形结构显示：设备、服务、动作，最后是参数。
右键单击一个动作会显示一个弹出菜单，允许在填充弹出窗口中的参数后执行该动作。动作的输出参数显示在树形结构下方。
单击树形结构中的一个节点会显示该节点的数据。
对于 DNLA，DNLA 数据也以树形结构显示。双击树形结构中的一个节点可以
- 如果它是一个容器，则可视化其内容
- 如果它是一个叶子节点，则在控制 Windows Media Player 中显示它（图像、音乐、电影）。
UPNP 部分
微软建议不要在 Windows 消息循环中获取设备、服务、动作和设置。因此，我创建了一个使用事件进行同步的线程。
由于动作的调用必须在与获取相同的执行上下文中完成，因此动作也在线程中调用，该线程将在应用程序活动期间保持活动状态。与动作的参数交换通过两个对象数组（数组中存在不同的类型）完成，一个用于输入，一个用于输出。这对我来说是一个难题。
DLNA UPnP
我没有为这部分使用线程，因为管理起来过于繁琐。因此，获取操作都在消息循环中进行，并带有等待光标的定位。
这部分非常简单，我遇到的唯一问题是 Browse 动作的 Filter 参数，它不是对元素的过滤，而是对每个元素显示的值的过滤。其中，要获得元素的显示 URL，必须放置 * 或放置 "res"。为了测试我的应用程序，我使用了 Synology 和 Windows 10 的 DLNA。这是一个了解 PC 所有多媒体的好方法。
Using the Code
线程代码
Public Class UCUPnPDisplay
Dim MyThread As Thread = Nothing
' Event of end of display of Devices, Services, Actions, Parameters
Public Event FinThread(ByVal sender As Object, ByVal e As EventArgs)
' Event of end of call action
Public Event FinInvokeAction(ByVal sender As Object, ByVal e As EventArgsFinInvokeAction)
' for calls from thread of the function of the form
Public Delegate Sub MySubDelegateEventFinThread()
' parameters of InvokeAction between form and thread
Dim MyInvokeMyAction As InvokeMyAction
' Synchronization between form and thread for InvokeAction
ReadOnly MyEvent As New AutoResetEvent(False)
' to finish the thread
Dim NotFini As Boolean = True
Private Sub RaiseMyEventFinThread()
RaiseEvent FinThread(Me, New EventArgs)
End Sub
Public Sub RaiseEventArgsFinInvokeAction(ByRef vInvokeMyActionElem As InvokeMyAction)
RaiseEvent FinInvokeAction(Me, New EventArgsFinInvokeAction(vInvokeMyActionElem))
End Sub
' code of the thread
Public Sub ThreadProc()
Dim deviceFinder As New UPnPDeviceFinder()
Dim myupnpDev As UPnPDevice = Nothing
' "upnp:rootdevice"
Dim mediaServerDevices As UPnPDevices = deviceFinder.FindByType("upnp:rootdevice", 0)
ClTreeNodeUPnP.BuildDevice(mediaServerDevices, MyRacine.Nodes)
' Create an instance of the delegate.
Dim msd As MySubDelegateEventFinThread = AddressOf RaiseMyEventFinThread
' Call the method.
Me.Invoke(msd)
While NotFini
MyEvent.WaitOne()
If NotFini Then
MyInvokeMyAction.InvokeAction()
End If
End While
End Sub
浏览所有设备的的代码。我使用递归来遍历设备/服务的树形结构
Public Shared Sub BuildDevice(ByRef vDevices As UPnPDevices, _
ByRef vNodes As TreeNodeCollection)
For Each upnpDev As UPnPDevice In vDevices
Dim node As New ClTreeNodeUPnPDevice(upnpDev)
vNodes.Add(node)
Try
If upnpDev.Services.Count > 0 Then
For Each service As UPnPService In upnpDev.Services
Dim nodeServ As New ClTreeNodeUPnPService(service, node)
node.Nodes.Add(nodeServ)
Next
End If
Catch ex As Exception
End Try
If upnpDev.HasChildren Then
BuildDevice(upnpDev.Children, node.Nodes)
End If
Next
End Sub
现在是显示设备的的代码。节点没有添加到 Treeview（表单的控件），因为我们在线程中，不在相同的执行环境中。
Public Class ClTreeNodeUPnPDevice
Inherits ClTreeNodeUPnP
Public MyDevice As UPnPDevice
Public IconURL As String = ""
Public localIconFileName As String = ""
Public descDocURL As String = ""
Public Sub New(ByRef vUPnPDevice As UPnPDevice)
MyDevice = vUPnPDevice
BuildDisplayString()
Me.ToolTipText = MyDisplayString
Me.Text = MyDevice.FriendlyName
IconURL = MyDevice.IconURL("image/png", 48, 48, 24)
If IconURL IsNot Nothing Then
localIconFileName = String.Concat_
(My.Computer.FileSystem.SpecialDirectories.CurrentUserApplicationData, "\", _
MyDevice.UniqueDeviceName.Substring(MyDevice.UniqueDeviceName.IndexOf(":") _
+ 1), ".png")
ClassGetHTTPFile.URLDownLoadToFile(IconURL, localIconFileName)
End If
Dim pDescDoc As IUPnPDeviceDocumentAccess
pDescDoc = vUPnPDevice
descDocURL = pDescDoc.GetDocumentURL()
localXmlFileName = String.Concat_
(My.Computer.FileSystem.SpecialDirectories.CurrentUserApplicationData, "\", _
MyDevice.UniqueDeviceName.Substring(MyDevice.UniqueDeviceName.IndexOf(":") _
+ 1), ".xml")
ClassGetHTTPFile.URLDownLoadToFile(descDocURL, localXmlFileName)
'création d'une nouvelle instance du membre xmldocument
XmlDoc = New XmlDocument()
'création du document
XmlDoc.Load(localXmlFileName)
End Sub
现在是显示服务、动作和参数的代码。节点没有添加到 Treeview（表单的控件），因为我们在线程中，不在相同的执行环境中。
Public Class ClTreeNodeUPnPService
Inherits ClTreeNodeUPnP
Public MyService As UPnPService
Public Sub New(ByRef vService As UPnPService, vNServ As ClTreeNodeUPnPDevice)
MyService = vService
BuildDisplayString()
Me.ToolTipText = MyDisplayString
Me.Text = MyService.ServiceTypeIdentifier
Dim nt As XmlNode = RechercherNoeudValeurArbre_
(vNServ.XmlDoc.ChildNodes, "UDN", vNServ.MyDevice.UniqueDeviceName).ParentNode
Dim racineUrl As String = vNServ.descDocURL
Dim index As Integer
For i As Integer = 0 To 2
index = racineUrl.IndexOf("/", index + 1)
Next
racineUrl = racineUrl.Substring(0, index)
nt = RechercherNoeudValeurArbre(nt.ChildNodes, "serviceID", vService.Id).ParentNode
Dim UrlXml As String = RechercherValeurNoeud(nt.ChildNodes, "SCPDURL")
localXmlFileName = String.Concat_
(My.Computer.FileSystem.SpecialDirectories.CurrentUserApplicationData, _
"\", MyService.Id.Replace(":", "_"), ".xml")
ClassGetHTTPFile.URLDownLoadToFile_
(String.Concat(racineUrl, UrlXml), localXmlFileName)
'création d'une nouvelle instance du membre xmldocument
XmlDoc = New XmlDocument()
'création du document
XmlDoc.Load(localXmlFileName)
'
' traitement des actions
'
Dim xmlNodeListAction = RechercherNoeudArbre(XmlDoc.ChildNodes, "actionList")
Dim xmlNodeDescParam = RechercherNoeudArbre(XmlDoc.ChildNodes, "serviceStateTable")
For Each xmlNodeAction As XmlNode In xmlNodeListAction.ChildNodes
Dim nodeAction As New ClTreeNodeUPnPServiceAction With {
.Text = RechercherValeurNoeud(xmlNodeAction.ChildNodes, "name")}
Me.Nodes.Add(nodeAction)
Dim xmlNodeListParametre = _
RechercherNoeud(xmlNodeAction.ChildNodes, "argumentList")
If xmlNodeListParametre IsNot Nothing Then
For Each xmlNodeParametre As XmlNode In xmlNodeListParametre.ChildNodes
Dim nodeParametre As New ClTreeNodeUPnPServiceActionParametre
nodeAction.Nodes.Add(nodeParametre)
nodeParametre.Text = RechercherValeurNoeud_
(xmlNodeParametre.ChildNodes, "name")
nodeParametre.SiDirectionIn = String.Compare_
(RechercherValeurNoeud(xmlNodeParametre.ChildNodes, "direction"), _
"in", True) = 0
Dim str As String = RechercherValeurNoeud_
(xmlNodeParametre.ChildNodes, "relatedStateVariable")
Dim xmlNodeCarPar As XmlNode = _
RechercherNoeudValeurArbre(xmlNodeDescParam.ChildNodes, _
"name", str).ParentNode
nodeParametre.DataType = RechercherValeurNoeud_
(xmlNodeCarPar.ChildNodes, "dataType")
Dim xmlNodeValueList As XmlNode = RechercherNoeud_
(xmlNodeCarPar.ChildNodes, "allowedValueList")
If xmlNodeValueList IsNot Nothing Then
For Each xmlNodeValue As XmlNode In xmlNodeValueList
nodeParametre.AllowedValue.Add(xmlNodeValue.InnerText)
Next
End If
Dim xmlNodeDefaultValue As XmlNode = _
RechercherNoeud(xmlNodeCarPar.ChildNodes, "defaultValue")
If xmlNodeDefaultValue IsNot Nothing Then
nodeParametre.DefaultValue = xmlNodeDefaultValue.InnerText
nodeParametre.IfDefauktValue = True
End If
Dim xmlNodeValueRange As XmlNode = _
RechercherNoeud(xmlNodeCarPar.ChildNodes, "allowedValueRange")
If xmlNodeValueRange IsNot Nothing Then
Dim xmlNodeMinmum As XmlNode = _
RechercherNoeud(xmlNodeValueRange.ChildNodes, "minimum")
If xmlNodeMinmum IsNot Nothing Then
nodeParametre.Minimum = xmlNodeMinmum.InnerText
End If
Dim xmlNodeMaximum As XmlNode = _
RechercherNoeud(xmlNodeValueRange.ChildNodes, "maximum")
If xmlNodeMaximum IsNot Nothing Then
nodeParametre.Maximum = xmlNodeMaximum.InnerText
End If
nodeParametre.IfMinMax = True
End If
Next
End If
Next
End Sub
调用带有参数的动作的代码如下所示
Private Sub ExécuterLactionToolStripMenuItem_Click(sender As Object, e As EventArgs) _
Handles ExécuterLactionToolStripMenuItem.Click 'AppelerLactionToolStripMenuItem
If TypeOf TvwUPnP.SelectedNode Is ClTreeNodeUPnPServiceAction Then
Dim dlg As New FrmGetInParameter
Dim objectOut As New Object
dlg.NodeAction = TvwUPnP.SelectedNode
If dlg.ShowDialog() = DialogResult.OK Then
MyInvokeMyAction = New InvokeMyAction_
(CType(dlg.NodeAction.Parent, ClTreeNodeUPnPService).MyService, _
dlg.NodeAction.Text, dlg.TabParametre, Me, dlg.NodeAction)
MyEvent.Set()
End If
Else
MessageBox.Show(My.Resources.YouMustSelectAnActionNode)
End If
End Sub
历史
- 2019年7月2日：初始版本