UPnP port mapping problem

[simo9000]

Hello, new to VBForums. I am trying to automate the mapping of ports as part of the setting up of a server program intended for PC usage. I am familiar with networking theory but just getting my feet wet with implementations. I stumbled upon this C# routine -> http://bytes.com/topic/c-sharp/answe...s-nat-firewall and have translated it to VB to my best ability.

Sub setPF()
        Dim nics() As System.Net.NetworkInformation.NetworkInterface = System.Net.NetworkInformation.NetworkInterface.GetAllNetworkInterfaces()
        'For Each nic As System.Net.NetworkInformation.NetworkInterface In nics
        Dim nic As System.Net.NetworkInformation.NetworkInterface = nics(2)
        Dim machineIP As String = nic.GetIPProperties().UnicastAddresses(0).Address.ToString()
        For Each gwInfo As System.Net.NetworkInformation.GatewayIPAddressInformation In nic.GetIPProperties.GatewayAddresses
            openFireWallPort(machineIP, gwInfo.Address.ToString(), 40)
        Next

        'Next
    End Sub

    Sub openFireWallPort(ByVal machineIP As String, ByVal firewallIP As String, ByVal openPort As Integer)
        Dim svc As String = getServicesFromDevice(firewallIP)

        openPortFromService(svc, "urn:schemas-upnp-org:service:WANIPConnection:1", machineIP, firewallIP, 80, openPort)
        openPortFromService(svc, "urn:schemas-upnp-org:service:WANPPPConnection:1", machineIP, firewallIP, 80, openPort)

    End Sub

    Function getServicesFromDevice(ByVal firewallIP As String)
        Dim queryResponse As String = ""
        Dim query As String = "M-SEARCH * HTTP/1.1" & vbCrLf & "Host:" & firewallIP & ":1900" & vbCrLf & "ST:upnp:rootdevice" & vbCrLf & _
                              "Man:""ssdp:discover""" & vbCrLf & "MX:3" & vbCrLf & vbCrLf & vbCrLf

        Dim client As System.Net.Sockets.Socket = New System.Net.Sockets.Socket(System.Net.Sockets.AddressFamily.InterNetwork, System.Net.Sockets.SocketType.Dgram, System.Net.Sockets.ProtocolType.Udp)
        Dim endPoint As System.Net.IPEndPoint = New System.Net.IPEndPoint(System.Net.IPAddress.Parse(firewallIP), 1900)
        client.SetSocketOption(Net.Sockets.SocketOptionLevel.Socket, Net.Sockets.SocketOptionName.ReceiveTimeout, 1500)

        Dim q As Byte() = System.Text.Encoding.ASCII.GetBytes(query)
        client.SendTo(q, q.Length, Net.Sockets.SocketFlags.None, endPoint)
        Dim sender As System.Net.IPEndPoint = New System.Net.IPEndPoint(System.Net.IPAddress.Any, 0)
        Dim senderEP As System.Net.EndPoint = CType(sender, System.Net.EndPoint)

        Dim data As Byte() = New Byte(1024) {}

        Dim recv As Integer = client.ReceiveFrom(data, senderEP)
        queryResponse = System.Text.Encoding.ASCII.GetString(data)

        If queryResponse.Length = 0 Then Return ""

        ' QueryResult is somthing like this:

        'HTTP/1.1 200 OK
        'Cache-Control:max-age=60
        'Location:http://10.10.10.1:80/upnp/service/des_ppp.xml
        'Server:NT/5.0 UPnP/1.0
        'ST:upnp:rootdevice
        'EXT:

        'USN:uuid:upnp-InternetGatewayDevice-1_0-00095bd945a2::upnp:rootdevice


        Dim location As String = ""

        Dim parts() As String = queryResponse.Split(New String() {System.Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)
        For Each part As String In parts
            If part.ToLower().StartsWith("location") Then
                location = part.Substring(part.IndexOf(":") + 1)
                Exit For
            End If
        Next

        If location.Length() = 0 Then Return ""

        Dim webClient As System.Net.WebClient = New System.Net.WebClient()
        Dim ret As String = webClient.DownloadString(location)
        MsgBox("webClient String: " & ret)
        Return ret

    End Function

    Sub openPortFromService(ByVal services As String, ByVal serviceType As String, _
                                ByVal machineIP As String, ByVal firewallIP As String, _
                                ByVal gatewayPort As Integer, ByVal portToForward As Integer)

        If services.Length = 0 Then Exit Sub

        Dim svcIndex As Integer = services.IndexOf(serviceType)
        If svcIndex = -1 Then Exit Sub

        Dim controlUrl As String = services.Substring(svcIndex)
        Dim tag1 As String = "<controlURL>"
        Dim tag2 As String = "</controlURL>"
        controlUrl = controlUrl.Substring(controlUrl.IndexOf(tag1) + tag1.Length)
        controlUrl = controlUrl.Substring(0, controlUrl.IndexOf(tag2))

        Dim soapBody As String = "<s:Envelope " & "xmlns:s=""http://schemas.xmlsoap.org/soap/envelope/"" " & _
            "s:encodingStyle=""http://schemas.xmlsoap.org/soap/encoding/ "">" & "<s:Body>" & _
            "<u:AddPortMapping xmlns:u=""" + serviceType + """>" & "<NewRemoteHost></NewRemoteHost>" & _
            "<NewExternalPort>" & portToForward.ToString() & "</NewExternalPort>" & _
            "<NewProtocol>TCP</NewProtocol>" & "<NewInternalPort>" + portToForward.ToString() & _
            "</NewInternalPort>" & "<NewInternalClient>" & machineIP & "</NewInternalClient>" & _
            "<NewEnabled>1</NewEnabled>" & "<NewPortMappingDescription>Woodchop Client</NewPortMappingDescription>" &
            "<NewLeaseDuration>0</NewLeaseDuration>" & "</u:AddPortMapping>" & "</s:Body>" & "</s:Envelope>"

        Dim body() As Byte = System.Text.UTF8Encoding.ASCII.GetBytes(soapBody)

        Dim url As String = "http://" & firewallIP & ":" & gatewayPort.ToString() & controlUrl
        Dim wr As System.Net.WebRequest = System.Net.WebRequest.Create(url)
        wr.Method = "POST"
        Dim header As String = Chr(34) & serviceType & "#AddPortMapping"""
        wr.Headers.Add("SOAPAction", header)
        wr.ContentType = "text/xml;charset=""utf-8"""
        wr.ContentLength = body.Length

        Dim stream As System.IO.Stream = wr.GetRequestStream()
        stream.Write(body, 0, body.Length)
        stream.Flush()
        stream.Close()

        Dim wres As System.Net.WebResponse = wr.GetResponse()
        Dim sr As System.IO.StreamReader = New System.IO.StreamReader(wres.GetResponseStream())
        Dim ret As String = sr.ReadToEnd()
        sr.Close()

        MsgBox("Setting port forwarding:" & portToForward.ToString() & vbcrlf & vbcrlf & ret)

This code runs fine until the end when the SOAP message with the port mapping details is sent. Here my router is returning a 404 error after i send it the message. I have tried two routers of different manufacturers and i'm getting the same response. Any help would be greatly appreciated.

[dilettante]

Have you tried the techniques described in Easy UPnP NAT Traversal yet?