2

我正在使用代码转发端口。此代码在我的 Windows 7 上运行良好；但我不能在 Windows XP 上使用它。

问题更新 1(2012-10-17 07:32:00Z)

这是我的源代码：

uses
  ActiveX, oleAuto;

Procedure AddUPnPEntry(Port: Integer; const Name: ShortString; LAN_IP: string);
Var
  Nat: Variant;
  Ports: Variant;
  SavedCW: Word;
Begin
  if NOT(LAN_IP = '127.0.0.1') then
  begin
    try
      Nat := CreateOleObject('HNetCfg.NATUPnP');
      Ports := Nat.StaticPortMappingCollection;

      // Error Raized From Here!!!
      ShowMessage(inttostr(Ports.count));

      Ports.Add(Port, 'TCP', Port, LAN_IP, True, name);
    except
      ShowMessage('An Error occured with adding UPnP Ports. The ' + name +
        ' port was not added to the router. Please check to see if  your ' +
        'router supports UPnP and has it enabled or disable UPnP.');
    end;
  end;
End;

procedure TForm1.Button2Click(Sender: TObject);
begin
  AddUPnPEntry(1234, 'Hello3', '192.168.1.1');
end;

AV 错误信息：

Project Project1.exe raised exception class $C0000005 with message 'access violation at 0x00504876: read of address 0x00000000'.
4

4 回答 4

9

如果您遇到访问冲突，当您访问 count 属性时，这意味着该方法IStaticPortMappingCollection返回的接口是哪个，这可能是由于您的设备不支持 UPnP 的多种原因，设备上未启用 UPnP， UPnP 用户界面未安装/未激活，等等。IUPnPNAT.get_StaticPortMappingCollectionnil

无论如何，为了防止这种异常（访问冲突），您必须在使用它之前检查属性或方法返回的值，在这种情况下，您可以VarIsClear像这样使用函数：

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;
于 2012-10-09T18:29:56.737 回答
3

对于任何看到这一点的人来说，UPnP 功能对于 XP 来说是不同的，这是我使用的：

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;

可以跳过windows名称的初始化，而是使用自己的校验算法。

于 2014-01-01T16:00:05.617 回答
0

使用此代码测试您的显示消息

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

于 2013-03-16T17:00:17.897 回答
-1

如果你没有解决问题，这里是答案：

删除“Showmessage ...”，因为当您在路由器上没有任何记录时，您会遇到错误。我测试过，它有效。

于 2013-01-10T13:33:11.573 回答