问题
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)
This is my source code:
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 Error Message:
Project Project1.exe raised exception class $C0000005 with message 'access violation at 0x00504876: read of address 0x00000000'.
回答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;
回答2:
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.
回答3:
Test your showmessage with this code
Showmessage(VarToStrDef(Ports.Count,'nothing');
回答4:
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.
来源:https://stackoverflow.com/questions/12805067/port-forwarding-by-using-hnetcfg-natupnp-ole-object-failed