使用「HNetCfg.NATUPnP」Ole對象失敗的端口轉發

Question

我正在使用代碼轉發端口。此代碼在我的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'. 

Answer 1

如果您獲得訪問衝突，則在訪問count屬性時，這意味着IUPnPNAT.get_StaticPortMappingCollection方法返回的IStaticPortMappingCollection接口是nil，這可能是由於設備不支持UPnP的許多原因造成的，設備上未啓用UPnP，UPnP用戶界面未安裝/啓用等。

反正防止此類異常（訪問衝突），你必須檢查的屬性或方法的返回值之前使用它，在這種情況下，你可以使用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; 

Answer 2

如果你沒有解決問題，這裏是答案：

刪除「Showmessage ...」，因爲當你在路由器上沒有任何記錄時，你有錯誤。我測試過，它的工作原理。

Answer 3

測試與驗證碼

Showmessage（VarToStrDef（Ports.Count， '無'）的showmessage;

Answer 4

對於任誰看到這一點，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名稱的初始化，並把自己的校驗算法來代替。