Port Forwarding by Using “HNetCfg.NATUPnP” Ole Object Failed

Question

I am using a code for forwarding a port. this code works fine on My Windows 7; but I can\'t use It on Windows XP.

Update 1 For Problem(2012-10-17 07:32:00Z)<

Answer 1

If you are getting an access violation, when you access the count property, this means which the IStaticPortMappingCollection interface returned by the IUPnPNAT.get_StaticPortMappingCollection method is nil, this can be caused by many reasons your device doesn't supports UPnP, The UPnP is not enabled on the device, The UPnP User Interface is not installed/active, and so on.

Anyway to prevent this kind of exceptions (the access violation) you must check the value returned by the property or method before to use it, in this case you can use the VarIsClear function like so :

try
  Nat := CreateOleObject('HNetCfg.NATUPnP');
  Ports := Nat.StaticPortMappingCollection;

  if not VarIsClear(Ports) then
  begin
    //do something
    ShowMessage(inttostr(Ports.count));
    Ports.Add(Port, 'TCP', Port, LAN_IP, True, name);
  end;

except on E:Exception do
  ShowMessage('An Error occured with adding UPnP Ports. '+E.Message);
end;

Answer 2

Test your showmessage with this code

Showmessage(VarToStrDef(Ports.Count,'nothing');

Answer 3

If you didn't resolve the problem, here is the answer:

remove "Showmessage..." because when you don't have any record on router you got error. I tested and it works.

Answer 4

For any who sees this, UPnP functionality is different for XP, here is what I use:

TWindowsName = ( WINXP, WINVISTA, WIN7, WIN80, WIN81 );

var
  fWindowsName : TWindowsName;

procedure InitializeWindowsName;
var
  WinVersion  : TOSVersionInfo;

begin

  WinVersion.dwOSVersionInfoSize := sizeof ( WinVersion );
  GetVersionEx ( WinVersion );

  if WinVersion.dwMajorVersion = 5 then
    fWindowsName := WINXP    
  else if WinVersion.dwMajorVersion = 6 then
    fWindowsName := TWindowsName ( WinVersion.dwMinorVersion + 1 );

end;

procedure AddPortThroughUPnP ( const APort: WORD; const AProtocol, ALocalIP, AName: String );
var
  NAT      : Variant;
  Profile  : Variant;
  Ports    : Variant;
  Protocol : Integer;

begin

  if not fEnableUPnP then exit;

  if fWindowsName = WINXP then
  begin

    NAT      := CreateOleObject ( 'HNetCfg.FwMgr' );
    Profile  := NAT.LocalPolicy.CurrentProfile;

    if not VarIsClear ( Profile ) then
    begin

      if AProtocol = 'UDP' then Protocol := 17
      else if AProtocol = 'TCP' then Protocol := 35; 

      Ports          := CreateOLEObject('HNetCfg.FWOpenPort');
      Ports.Name     := AName;
      Ports.Port     := APort;
      Ports.Scope    := 0;
      Ports.Protocol := Protocol;
      Ports.Enabled  := True;

      Profile.GloballyOpenPorts.Add ( Ports );

    end;

  end
  else
  begin

    NAT   := CreateOleObject ( 'HNetCfg.NATUPnP' );
    Ports := NAT.StaticPortMappingCollection;

    if not VarIsClear ( Ports ) then
       Ports.Add ( APort, AProtocol, APort, ALocalIP, True, AName );

  end;

end;

One can skip the initialization of windows name and put their own check algorithm instead.