Jump to content

This site uses cookies. By continuing to browse the site you are agreeing to our use of cookies. Find out more here. X
X


Photo

UPnP using COM objects


  • Please log in to reply
1 reply to this topic

#1 Olish

Olish

    Wayfarer

  • Active Members
  • Pip
  • 60 posts

Posted 13 June 2008 - 01:43 PM

Hello !

I found some VBS scripts to forward my ports on my UPnP router.

Here is the working VBS script named test.vbs : (from http://www.knoxscape.com/Upnp/NAT.htm)

'This program enables an IRC file transfer port 'And then puts up a prompt waiting for the user 'to be finished transferring files Set theNatter = CreateObject( "HNetCfg.NATUPnP") Dim mappingPorts Set mappingPorts = theNatter.StaticPortMappingCollection 'We add a new port saying that externally accept from port 1024 'route to internal port 1024 on computer with IP 192.168.1.101 'Enabling the forward, and giving a name of the forward to be IRC mappingPorts.Add 1024, "TCP", 1024, "192.168.1.101", TRUE, "VBS Test"


Here is the not working AutoIt script :

$oRouter = ObjCreate("HNetCfg.NATUPnP") $oPortList = $oRouter.StaticPortMappingCollection $oPortList.Add(9123, "TCP", 9123, "192.168.1.101", TRUE, "AutoItCOM")


It stops with this error :

>Running:(3.2.12.0):C:\Program Files\AutoIt3\autoit3.exe "D:\Development\NWGLauncher - AU3\COMUPnP2.au3"    D:\Development\NWGLauncher - AU3\COMUPnP2.au3 (5) : ==> The requested action with this object has failed.: $oPortList.Add(9123, "TCP", 9123, "192.168.1.101", TRUE, "AutoItCOM") $oPortList.Add(9123, "TCP", 9123, "192.168.1.101", TRUE, "AutoItCOM")^ ERROR ->15:28:21 AutoIT3.exe ended.rc:1 >Exit code: 1   Time: 1.565


Am I right in my way to create the object, then with the methods ? "HNetCfg.NATUPnP" is a COM object isn't it ?

Thanks in advance for your help.

Regards,
Olish.
Olivier, from France.Free Wake On LAN script







#2 IvanGalabov

IvanGalabov

    Seeker

  • Normal Members
  • 1 posts

Posted 17 July 2012 - 02:30 PM

First of all sorry for me English,
Second I am very new to AutoIt Script .

I try to mange your way to open port on Pfsense 2.0.1 and 1.2.3 version with no luck at all. Router is discoverable via UpnP.UPnPDeviceFinder and torrent programs and skype open successfully ports .
Than I try at home on cheep Chinese router and it work :) . Pfsense and some other router distribution use MiniUPnP Project link to site → http://miniupnp.free.fr/ for more information.
There is other way to open port on such routers , you can download and use standalone upnpc-shared.exe and upnpc-static.exe . Those executable work on Chinese router too :) .

Part of code below I use as “proof of concept” about simple updater based on aria2c and to control it via XML-RPC , I am very new to AutoIt Script . I modify I little bit this code to try first with COM and if fails than with MiniUPnP Project executable. May be opposite is more good way but any way see my code :) hope it will help you .


AutoIt         
#include <Constants.au3> Global $g_eventerror = 0 ; to be checked to know if com error occurs. Must be reset after handling. $oMyError = ObjEvent("AutoIt.Error","MyErrFunc") ; Install a custom error handler Global $debuglog = "debug.log" ; for windows you can use bare tail -> http://www.baremetalsoft.com/baretail/ to see output ; i preffer this way Global $debug =1 ; 1 = Log , 0 = no log ; port 6800 is default port for aria2c here is the site link: http://aria2.sourceforge.net/ ; i need NAT UPnP/NAT-PMP to open port wich is part of "proof of concept" -> to provide a simple updater for our software ; based on aria2c and control it via XML-RPC requests $int_port = "6800" ; aria2c default port $ext_port = "6800" ; aria2c default port $aria2c_protol = "UDP" ; default protocol $Description = "Aria2C p2p" DebugMsg("-------------------Script Start-----------------") DebugMsg("------------------------------------------------") DebugMsg("------------------------------------------------") DebugMsg("OSType:"&@OSType&" OSVersion:"&@OSVersion&" OSServicePack:"&@OSServicePack&" OSBuild:"&@OSBuild&" OSArch:"&@OSArch&" OSLang:"&@OSLang&" Number of Params:"&@NumParams&" ScriptFullPath:"&@ScriptFullPath&" Start Time:"&@YEAR&"-"&@MON&"-"&@MDAY&" "&@HOUR&":"&@MIN&":"&@SEC&":"&@MSEC) if FindDevice() Then ; if we find IGD Upnp device ; at this point we know that we have IGD device and will try to open our port ; comunication between HNetCfg.NATUPnP and root device MiniUPnP is not OK ; i tested on Pfsense v2.0.1 and v1.2.3 without any luck , but works perfect ot chinies ; 20$ routers :) so will try 2-nd way firs HNetCfg.NATUPnP if fail than upnpc-static.exe or upnpc-shared.exe ;MiniUPnP Project link to site http://miniupnp.free.fr/ If UpnpPortMap(@IPAddress1,$int_port,$ext_port,$aria2c_protol,$Description) Then DebugMsg("ok port is open on router") ; we are ok port is open on router Else DebugMsg("fail to open on router") ; fail :) Endif Endif Func UpnpPortMap($InternalIP,$InternalPort,$ExternalPort,$Protocol,$Description ) Local $theNatter = ObjCreate( "HNetCfg.NATUPnP") If IsObj($theNatter) Then DebugMsg ("HNetCfg.NATUPnP.StaticPortMappingCollection now") Local $mappingPorts = $theNatter.StaticPortMappingCollection DebugMsg ("HNetCfg.NATUPnP.StaticPortMappingCollection.Add now") $mappingPorts.Add($InternalPort,$Protocol,$ExternalPort,@IPAddress1,1,$Description) ; at this point we know that we have IGD divece and we was unable to open port via HNetCfg.NATUPnP StaticPortMappingCollection.Add ; so lets try with MiniUPnP Project link to site http://miniupnp.free.fr/ ; many distribution use this project If $g_eventerror = 1 Then if miniupnpcaddstatic($InternalIP,$InternalPort,$ExternalPort,$Protocol) Then Return 1 EndIf Return 1 Endif Return 0 EndFunc ; this is taken from forum :) Func FindDevice() Dim $deviceFinder Dim $DeviceType Dim $Devices Dim $Device Dim $strDescDocURL $deviceFinder = ObjCreate("UPnP.UPnPDeviceFinder") $DeviceServices = ObjCreate("UPnP.UPnPServices") $DeviceService = ObjCreate("UPnP.UPnPService") $Device = ObjCreate("UPnP.UPnPDevice") ; we need any version of IGD device curently there only 1 and 2 :) $DeviceType = "urn:schemas-upnp-org:device:InternetGatewayDevice:*" $Devices = $deviceFinder.FindByType ($DeviceType, 0) DebugMsg($strDescDocURL ) DebugMsg("Found # :" & $Devices.Count & " Devices") If $Devices.Count = 0 Then DebugMsg("Unable to find Device.") EndIf For $DeviceObj In $Devices $deiceDescription = "Children " & $DeviceObj.Children & @CRLF & "Description " & $DeviceObj.Description & @CRLF & "FriendlyName " & $DeviceObj.FriendlyName & @CRLF & "HasChildren " & $DeviceObj.HasChildren & @CRLF & "IsRootDevice " & $DeviceObj.IsRootDevice & @CRLF & "ManufacturerName " & $DeviceObj.ManufacturerName & @CRLF & "ManufacturerURL " & $DeviceObj.ManufacturerURL & @CRLF & "ModelName " & $DeviceObj.ModelName & @CRLF & "ModelNumber " & $DeviceObj.ModelNumber & @CRLF & "ModelURL " & $DeviceObj.ModelURL & @CRLF & "ParentDevice " & $DeviceObj.ParentDevice & @CRLF & "PresentationURL " & $DeviceObj.PresentationURL & @CRLF & "RootDevice " & $DeviceObj.RootDevice & @CRLF & "SerialNumber " & $DeviceObj.SerialNumber & @CRLF & "Services " & $DeviceObj.Services & @CRLF & "Device URN Type " & $DeviceObj.Type & @CRLF & "UniqueDeviceName " & $DeviceObj.UniqueDeviceName & @CRLF & "Product Code - UPC " & $DeviceObj.UPC & @CRLF DebugMsg("Found The Following Device(s)" & @CRLF & $deiceDescription ) Next If $Devices.Count > 0 Then Return 1 Return 0 EndFunc Func miniupnpcaddstatic($InternalIP,$InternalPort,$ExternalPort,$Protocol) Local $ResultMiniUpnp = Run (@ComSpec & " /c " & ' upnpc-static.exe -a '&$InternalIP&" "&$InternalPort&" "&$ExternalPort&" "&$Protocol , @ScriptDir, @SW_HIDE, $STDERR_CHILD + $STDOUT_CHILD) Local $upnpc_static_output While 1 ; read output from cmd command $upnpc_static_output = StdoutRead($ResultMiniUpnp) ;exit on error If @error Then ExitLoop ; send output to window If $upnpc_static_output Then DebugMsg($upnpc_static_output ) Wend EndFunc ; This is my custom error handler ; we don't want script to fail if HNetCfg.NATUPnP fails Func MyErrFunc() $HexNumber=hex($oMyError.number,8) If @error Then Return Local $msg = "COM Error with HNetCfg.NATUPnP!" & @CRLF & @CRLF & _ "err.description is: " & @TAB & $oMyError.description & @CRLF & _ "err.windescription:" & @TAB & $oMyError.windescription & @CRLF & _ "err.number is: " & @TAB & $HexNumber & @CRLF & _ "err.lastdllerror is: " & @TAB & $oMyError.lastdllerror & @CRLF & _ "err.scriptline is: " & @TAB & $oMyError.scriptline & @CRLF & _ "err.source is: " & @TAB & $oMyError.source & @CRLF & _ "err.helpfile is: " & @TAB & $oMyError.helpfile & @CRLF & _ "err.helpcontext is: " & @TAB & $oMyError.helpcontext DebugMsg ($msg) $g_eventerror = 1 ; something to check for when this function returns Return Endfunc Func DebugMsg ($debugtext) If $debug Then Local $file = FileOpen(@ScriptDir&"\"&$debuglog, 1) If $file = -1 Then MsgBox(0, "Error", "Unable to open file."&$debuglog) Return 0 EndIf FileWriteLine($file, @HOUR&":"&@MIN&":"&@SEC&":"&@MSEC&"->"&$debugtext) FileClose($file) EndIf Return 1 EndFunc

Attached Files

  • Attached File  upnp.au3   6.13KB   279 downloads

Edited by IvanGalabov, 17 July 2012 - 02:34 PM.





0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users