Looking for VB.NET equivilent

Jan 18, 2012 at 9:37 AM

looking at the example post made i've tried to perform the simple UPNP mapping task in VB.NET 2010.

however, i'm not sure how to cast this line:

-------------------

  object[] loObj = new object[] { "", 29679, "UDP", 29679, "192.168.0.24", true, "Custom Mapping", 0 };
     

--------------------

if you could show me a VB.NET2010 example of UPNP mapping in ManagedUPnP then i would appreciate it.

What i have is:

------------------------------------------------------

Imports ManagedUPnP
Public Class Server_ManagedUPNP
    Public Sub New()

    End Sub
    Public Sub OpenNewPort(ByVal Port As Integer, ByVal Protocol As String)
        ' Finding service...


        Dim lsService As Service = Nothing

        Dim lsServices As Services = Discovery.FindServices("urn:schemas-upnp-org:service:WANPPPConnection:1")

        If lsServices.Count > 0 Then
            lsService = lsServices(0)
            msg("SERVICE LOCATED")
        Else
            ' No Valid Service Found
            msg("ERROR - NO SERVICE FOUND")
        End If
        Try
            ' Add the port mapping
            Dim loObj() As Object = New Object()
            loObj.SetValue("", 0) 'blank string for target machine
            loObj.SetValue(Port, 1) 'port #
            loObj.SetValue(Protocol, 2) 'UDP or TCP only, as string
            loObj.SetValue(Port, 3) 'port #

            Dim tempstring As String
            tempstring = ServerUPnP.LocalIP 'LocalIP address - from another addin
            loObj.SetValue(tempstring, 4)

            loObj.SetValue(True, 5) 'enabled = true
            loObj.SetValue("Dust Server", 6) 'description of app?
            loObj.SetValue(0, 7) 'unknown
            lsService.InvokeAction("AddPortMapping", loObj)
        Catch loE As Exception
            ' MsgBox(String.Format("{0}: HTTPSTATUS: {1}", loE.Message, lsService.LastTransportStatus) & "   " & loE.ToString)
            MsgBox("ERROR:" & loE.Message)
            ' can't lsService.LastTransportStatus if lsService.InvokeAction fails
        End Try
    End Sub
   

End Class
----------------------------------------------

thank you for any help you can give.
 

Coordinator
Jan 18, 2012 at 11:05 AM
Edited Jan 18, 2012 at 11:08 AM

vburgess,

 
Have you tried this notation:
 
Dim loObj() As Object = { "", 29679, "UDP", 29679, "192.168.0.24", true, "Custom Mapping", 0 }
 
Basically you want to create a fixed length object array and initialise its values, I havnt done any VB.NET programming in years so im a little rusty, but according to this site:
 
 
That syntax should do the trick.
By using the syntax that you are using, you are actually creating a dynamic array and settings its elements manually, you need a static array, which im pretty sure this syntax will create.

If that dosnt work, let me know what error your getting with the mapping.

Regards,
TheToid
PS: Sorry for the lateness of my reply.
Coordinator
Jan 18, 2012 at 11:47 AM
Edited Jan 18, 2012 at 11:49 AM

Ok, I decided to test this for myself, and it does work fine, here is the code:

 

    Public Function FindService() As Service
        Dim lsService As Service = Nothing

        Dim lsServices As Services = Discovery.FindServices("urn:schemas-upnp-org:service:WANPPPConnection:1")

        If lsServices.Count > 0 Then
            Return lsServices(0)
        Else
            Throw New Exception("Compatible service not found.")
        End If
    End Function

    Public Sub ClosePort(ByVal Service As Service, ByVal Port As Integer, ByVal Protocol As String)
        ' RemoteHost, ExternalPort, Protocol
        Dim loObj() As Object = {"", Port, Protocol}
        Service.InvokeAction("DeletePortMapping", loObj)
    End Sub

    Public Sub OpenPort(ByVal Service As Service, ByVal MappingName As String, ByVal Host As String, ByVal Port As Integer, ByVal Protocol As String)
        ' RemoteHost, ExternalPort, Protocol, InternalPort, InternalClient, Enabled, PortMappingDescription, LeaseDuration
        Dim loObj() As Object = {"", Port, Protocol, Port, Host, True, MappingName, 0}
        Service.InvokeAction("AddPortMapping", loObj)
    End Sub

    Public Sub TestIt()
        Try
            Dim lsService As Service = FindService()
            Dim lsHost As String = "192.168.0.23"
            Dim liPort As Integer = 49495
            Dim lsProtocol As String = "UDP"
            Dim lsName As String = "Test Mapping"

            ' Open the port
            OpenPort(lsService, lsName, lsHost, liPort, lsProtocol)

            ' Close the port
            ClosePort(lsService, liPort, lsProtocol)
        Catch loE As Exception
            MsgBox("ERROR:" & loE.Message)
        End Try
    End Sub

 

You can find more information on the AddPortMapping and DeletePortMapping actions here:

http://www.upnp-hacks.org/igd.html

Or you can get it from the official UPnP site in this PDF file (Pages 33 & 34):

http://www.upnp.org/specs/gw/UPnP-gw-WANPPPConnection-v1-Service.pdf

 

Im here to help to let me know if you need more.

Jan 18, 2012 at 12:31 PM

it appears to compile and run just fine.

unfortunately...


************** Exception Text **************
System.Exception: Compatible service not found.

this may be why UPNPNAT with windows 7 doesnt work.

from the UPNPDiscovery test app:

This program demonstrates how easy it is to use the UPnPDiscovery
component, simply drop it onto your form, and use the Events and 
set the Active property to true. The component will automatically 
ensure that all events are running in the GUI thread, as long as the 
event handlers are assigned from a GUI thread control.

It will scan your UPnP devices for a WANIPConnection service, 
this service allows for the ability to get your External IP address from your 
UPnP enabled Modem or Gateway, click the Start button to begin, when 
a compatible device is found the Show IP Address button will enable.

See the property and event descriptions of the UPnPDiscovery component
and the XML comments for the source of the component for more 
information.

Started...
Device Found 'DANCEHALL' - uuid:9E61FB79-3209-DA4E-077C-DD35997F763C - urn:schemas-upnp-org:device:InternetGatewayDevice:1
Service Found: 'urn:upnp-org:serviceId:L3Forwarding1' - DANCEHALL => Layer3Forwarding:1 on DANCEHALL - urn:schemas-upnp-org:service:Layer3Forwarding:1
Device Found 'WANDevice' - uuid:DAE8E8D3-3464-00DA-5AEE-3ACB2F27F8BD - urn:schemas-upnp-org:device:WANDevice:1
Service Found: 'urn:upnp-org:serviceId:WANCommonIFC1' - DANCEHALL => WANCommonInterfaceConfig:1 on WANDevice - urn:schemas-upnp-org:service:WANCommonInterfaceConfig:1
Device Found 'WAN Connection Device' - uuid:EF2255C3-3C2C-FD79-B456-03CFA4AA0028 - urn:schemas-upnp-org:device:WANConnectionDevice:1
Service Found: 'urn:upnp-org:serviceId:WANIPConn1' - DANCEHALL => WANIPConnection:1 on WAN Connection Device - urn:schemas-upnp-org:service:WANIPConnection:1
[Service Located]
Device Found 'LANDevice' - uuid:B15382DF-A3A8-14AF-ED32-483009EF093E - urn:schemas-upnp-org:device:LANDevice:1
Service Found: 'urn:upnp-org:serviceId:LANHostCfg1' - DANCEHALL => LANHostConfigManagement:1 on LANDevice - urn:schemas-upnp-org:service:LANHostConfigManagement:1
Completed Initial Stage... (no more output printed)

of our test machines all NICs and routers are UPnP compatible and enabled and other upnp apps work fine.

i'm just going to have to buckle down and read a lot of docs that are over my head. The trouble with UPnP has held up our garage DIY team for a month already.

 

ugh.

(Cisco Linksys E3000 router)

Coordinator
Jan 18, 2012 at 12:47 PM
Edited Jan 18, 2012 at 12:51 PM

There is no need to do that, the code I posted searches for a service which is of type "WANPPPConnection:1", however, as per the log above, the device you are using does NOT have that service, but it does have a "WANIPConnection:1" service:

FROM THE LOG:

[Service Found: 'urn:upnp-org:serviceId:WANIPConn1' - DANCEHALL => WANIPConnection:1 on WAN Connection Device - urn:schemas-upnp-org:service:WANIPConnection:1]

So please try changing this line:

Dim lsServices As Services = Discovery.FindServices("urn:schemas-upnp-org:service:WANPPPConnection:1")

To

Dim lsServices As Services = Discovery.FindServices("urn:schemas-upnp-org:service:WANIPConnection:1")

Both services have the ability to Add and Delete port mappings, however, most routers have a WANPPPConnection to represent the endpoint mappings, but your router dosnt, you could even make it search for the WANPPPConnection first then the WANIPConnection if the first isnt found.

Or alternatively, do an Asynchronous search for all devices and just filter by Services found using those two types.

Give the WANIPConnection:1 service type a try and let me know how it works.

The PDF file from the official UPnP documentation for the WANIPConnection service can be found here:

http://upnp.org/specs/gw/UPnP-gw-WANIPConnection-v1-Service.pdf

Also, when you get some spare time, could I trouble you to please post a review of this framework on codeplex, thanks :)

Jan 18, 2012 at 1:06 PM

 

so, something off the top of my head like:

 Public Function FindService() As Service
        Dim lsService As Service = Nothing

        Dim lsServices As Services = Discovery.FindServices("urn:schemas-upnp-org:service:WANPPPConnection:1")

        If lsServices.Count > 0 Then
            Return lsServices(0)
        Else
           lsServices = Discovery.FindServices("urn:schemas-upnp-org:service:WANIPConnection:1")

        End If

        If lsServices.Count > 0 Then
            Return lsServices(0)
        Else

            Throw New Exception("Compatible service not found.")
        End If
    End Function

in the applicable routines.

is the remaining code such as:

    Public Sub OpenPort(ByVal Service As Service, ByVal MappingName As String, ByVal Host As String, ByVal Port As Integer, ByVal Protocol As String)
        ' RemoteHost, ExternalPort, Protocol, InternalPort, InternalClient, Enabled, PortMappingDescription, LeaseDuration
        Dim loObj() As Object = {"", Port, Protocol, Port, Host, True, MappingName, 0}
        Service.InvokeAction("AddPortMapping", loObj)
    End Sub

stay the same? if not then wit the examples and links you provided i should be able to find it.

Thank you so much for your support! you saved me some hair :)

Coordinator
Jan 18, 2012 at 1:17 PM

Thats correct, the signatures for both the AddPortMapping and DeletePortMapping on the WANIPConnection:1 and the WANPPPConnection:1 Service Types are identical, so nothing else should need to be changed.

However, because the synchronous searches take a while to search, you are probably much better off using the search component, or the asynchronous functions to find the services as this can be done in the fraction of the time it takes to do possible 2 synchronous searches.

Jan 18, 2012 at 1:19 PM

honest review posted.... btw, you should know that i'm hard to please.

(Being a self taught coder makes me expect more from the educated than I am capable of.)

Coordinator
Jan 18, 2012 at 1:33 PM

No, thats great, thank you for the review.

I am totally self taught myself, started coding when I was 4 years old in GWBASIC (it came with the Tandy 1000), so I know exactly what you mean! :)

Jan 18, 2012 at 1:36 PM

bout the same age. commadore64 then Tandy1000 AX (yes, they made an AX before the SX)

i'll be sending you a msg.

Jan 19, 2012 at 2:59 AM
Edited Jan 19, 2012 at 3:01 AM

Somethings Wrong. I have the feeling I'm over the hill.

I didn't code the actual open/close yet, it's incomplete. I'm testing the Discover.FindServices and it's coming up empty.

 

Output:
---------------------------------------------------------------

 >>               IS Private IP(192.168.1.13) ....
 >>                      TRUE - Quad2=168
 >> Find UPNP Service
 >> search 1..
 >> search 2....
 >> search 3.....
 >> Compatible service not found.
 >> WARNING: SERVICE NOT FOUND!
 >> exiting module1 'OpenPort' sub.
 >> returned from request to open port
 >> beginning main routine...
 >> Starting Virtual Grapics Device...
------------------------------------------------------------------------------




my class: (look for the line ' FIND SERVICE BEGINS HERE==========)
----------------------------------------------------------------------------------------------
 

 

Imports ManagedUPnP
Imports System.Windows.Forms
Imports System.Net
Imports System.Runtime.InteropServices
Imports UPNPLib

Public Class Server_ManagedUPNP
    ' Implements IDisposable
    Private lsServices As Services = Nothing
    Private lsService As Service = Nothing
    Private lsHost As String = LocalIP()
    Private lsProtocol As String
    Public Shared UPnPStarted As Boolean = False
    Private liPort As Integer
    Private Shared ServiceFound As Boolean = False


    Private upnpnat As NATUPNPLib.UPnPNAT
    Private staticMapping As NATUPNPLib.IStaticPortMappingCollection
    Private dynamicMapping As NATUPNPLib.IDynamicPortMappingCollection

    Private staticEnabled As Boolean = True
    Private dynamicEnabled As Boolean = True
    Public ExternalIP As String
    ''' <summary>
    ''' The different supported protocols
    ''' </summary>
    ''' <remarks></remarks>
    Public Enum Protocol

        ''' <summary>
        ''' Transmission Control Protocol
        ''' </summary>
        ''' <remarks></remarks>
        TCP

        ''' <summary>
        ''' User Datagram Protocol
        ''' </summary>
        ''' <remarks></remarks>
        UDP

    End Enum


    Public Sub New()

        ServiceFound = FindService()
        If ServiceFound = False Then msg("WARNING: SERVICE NOT FOUND!")
    End Sub
    Public Sub BeginUPNP(ByVal Port As Integer, ByVal Protocol As Protocol, ByVal lsName As String)
        If UPnPStarted = True Then
            EndUPnP()
        End If
        UPnPStarted = True
        lsProtocol = Protocol.ToString
        liPort = Port
        OpenPort(lsName, lsHost, liPort, lsProtocol)


    End Sub
    Public Function FindService() As Boolean
        '
        '
        '    FIND SERVICE BEGINS HERE==========
        '
        '
        msg("Find UPNP Service")
        msg("search 1..")
        Application.DoEvents()
        lsServices = Discovery.FindServices("urn:schemas-upnp-org:service:WANPPPConnection:1")

        If lsServices.Count > 0 Then
            msg("service found -WANPPP")
            lsService = lsServices(0)
            Application.DoEvents()
            Return True
        Else
            msg("search 2....")
            lsServices = Discovery.FindServices("urn:schemas-upnp-org:service:WANIPConnection:1")
            Application.DoEvents()
        End If

        '

        If lsServices.Count > 0 Then
            msg("Service Found -WANIP")
            Application.DoEvents()
            lsService = lsServices(0)
            Return True
        Else
            msg("search 3.....")
            lsServices = Discovery.FindServices("urn:upnp-org:serviceId:WANIPConn1")
            Application.DoEvents()
        End If
        If lsServices.Count > 0 Then
            msg("service found -WANip shorthand")
            lsService = lsServices(0)
            Application.DoEvents()
            Return True
        Else
            msg("Compatible service not found.")
            Application.DoEvents()
            Return False

        End If

    End Function

    Public Sub ClosePort(ByVal Port As Integer, ByVal Protocol As String)
        ' RemoteHost, ExternalPort, Protocol
        Dim loObj() As Object = {"", Port, Protocol}
        lsService.InvokeAction("DeletePortMapping", loObj)
    End Sub

    Public Sub OpenPort(ByVal MappingName As String, ByVal Host As String, ByVal Port As Integer, ByVal Protocol As String)
        ' RemoteHost, ExternalPort, Protocol, InternalPort, InternalClient, Enabled, PortMappingDescription, LeaseDuration
        Dim loObj() As Object = {"", Port, Protocol, Port, Host, True, MappingName, 0}
        lsService.InvokeAction("AddPortMapping", loObj)
    End Sub

    Public Sub EndUPnP()
        UPnPStarted = True
        Try
            ClosePort(liPort, lsProtocol)
        Catch loE As Exception
            MsgBox("ERROR:" & loE.Message)
        End Try
    End Sub

    Public Function GetExternalIP() As String
        Dim lMapper = upnpnat.StaticPortMappingCollection
        Dim lMappedPort As NATUPNPLib.IStaticPortMapping
        Dim lExtIP As String = ""

        If Not lMapper Is Nothing Then
            For Each lMappedPort In lMapper
                lExtIP = lMappedPort.ExternalIPAddress().ToString
                Exit For
            Next
            ExternalIP = lExtIP
            msg("EXTERNAL IP=" & lExtIP)
            GetExternalIP = lExtIP
        Else
            GetExternalIP = "<Unable to resolve external IP>"
        End If
    End Function
    ''' <summary>
    ''' Attempts to locate the local IP address of this computer.
    ''' </summary>
    ''' <returns>String</returns>
    ''' <remarks></remarks>
    Public Shared Function LocalIP() As String
        Dim IPList As System.Net.IPHostEntry = System.Net.Dns.GetHostEntry(System.Net.Dns.GetHostName)
        For Each IPaddress In IPList.AddressList
            If (IPaddress.AddressFamily = Sockets.AddressFamily.InterNetwork) AndAlso IsPrivateIP(IPaddress.ToString()) Then
                Return IPaddress.ToString
            End If
        Next
        Return String.Empty
    End Function

    ''' <summary>
    ''' Checks to see if an IP address is a local IP address.
    ''' </summary>
    ''' <param name="CheckIP">The IP address to check.</param>
    ''' <returns>Boolean</returns>
    ''' <remarks></remarks>
    Private Shared Function IsPrivateIP(ByVal CheckIP As String) As Boolean
        Dim Quad1, Quad2 As Integer
        msg("              IS Private IP(" & CheckIP & ") ....")
        Quad1 = CInt(CheckIP.Substring(0, CheckIP.IndexOf(".")))
        Quad2 = CInt(CheckIP.Substring(CheckIP.IndexOf(".") + 1).Substring(0, CheckIP.IndexOf(".")))
        Select Case Quad1
            Case 10
                msg("                     TRUE - 10")
                Return True
            Case 172
                If Quad2 >= 16 And Quad2 <= 31 Then
                    msg("                     TRUE - 172, quad2>=16 && quad2<=31")
                    Return True
                End If

            Case 192
                If Quad2 = 168 Then
                    msg("                     TRUE - Quad2=168")
                    Return True
                End If

        End Select
        msg("                     Returning FALSE")

        Return False
    End Function
End Class

------------------------------------------------------------------------------------------------

 

am i missing something?

PS: the third search is based on the line from the tool:

Service Found: 'urn:upnp-org:serviceId:WANIPConn1' - DANCEHALL => WANIPConnection:1 on WAN Connection Device - urn:schemas-upnp-org:service:WANIPConnection:1
[Service Located]
Coordinator
Jan 19, 2012 at 3:37 AM

The service ID will only work on devices which have that service ID, and the IDs can really be anything across devices, so for it to work on a range of devices you need to get it working by service type. However the code you have should work, so it must be something to do with the implementation on the specific device you are using.

Have you used the ManagedUPnP Test program which comes with the framework, click on the links in the Device and Service information to the XML documents, if you dont understand what you are reading then send me the XML code.

If this fails to find the problem, you will need to install C# Express and step through the code and find out why its not matching, unfortunately I cant help with this much because I dont have access to your hardware and it works fine on my hardware, Netgear DG834Gv5.

The other thing is, you should be using an asynchronous search, this way you can filter the services yourself (ie. Search for all services and look at them yourself to select the one you want), look under the "How To..." and then "Discover Devices and Services" in the CHM help file for examples on how to discover the services as there are many different ways apart from what you are doing now. I would suggest using the "Asynchronously using Non GUI Thread Safe Events" method:

Converted to VB.NET from the help:

 

Private mdDiscovery As Discovery

Public Sub DiscoveryExample()
	mdDiscovery = New Discovery(Nothing)
	ldDiscovery.DeviceAdded += New DeviceAddedEventHandler(AddressOf mdDiscovery_DeviceAdded)
	ldDiscovery.DeviceRemoved += New DeviceRemovedEventHandler(AddressOf mdDiscovery_DeviceRemoved)
	ldDiscovery.SearchComplete += New SearchCompleteEventHandler(AddressOf mdDiscovery_SearchComplete)

	ldDiscovery.Start()
End Sub

Private Sub mdDiscovery_SearchComplete(sender As Object, a As SearchCompleteEventArgs)
	' NOTE: Event handler is not running in GUI thread
	Console.WriteLine("Initial Search complete, scanning for new devices.")
End Sub

Private Sub mdDiscovery_DeviceRemoved(sender As Object, a As DeviceRemovedEventArgs)
	' NOTE: Event handler is not running in GUI thread
	Console.WriteLine(String.Format("Device Removed: {0}", a.UDN))
End Sub

Private Sub mdDiscovery_DeviceAdded(sender As Object, a As DeviceAddedEventArgs)
	' NOTE: Event handler is not running in GUI thread
	Console.WriteLine(String.Format("Device Added: {0}", a.Device.ToString()))
	Dim msServices As Services = New Services(a.Device, Nothing, False)
	' CODEHERE: Iterate through services finding any that are applicable
End Sub

 

Look at the CODEHERE comment on how to iterate through all immediate services, change the False to True to search for all services in child devices as well.