UPnP Port Forwarding

[Aphton]

Ich hab mich auch gerade eben damit befasst und an diversen Beispielcodes, die im Internet so dazu zu finden sind, rumgebastelt.. Diese Lösung funktioniert bei mir:

Delphi-Quellcode:

unit aphtonUPnP;

interface

uses
  Windows, ActiveX, oleAuto, Variants, SysUtils;

type
  TUPnP_PortMapTable = class
  public
    class function add(const active: Boolean; const extPort, intPort: DWORD;
      const ip, proto, desc: String): Boolean;
    class function remove(const extPort: DWORD; const proto: String): Boolean;
  end;

implementation

class function TUPnP_PortMapTable.add(const active: Boolean; const extPort, intPort: DWORD;
  const ip, proto, desc: String): Boolean;
var
  n, p: Variant;
Begin
  Result := False;
  try
    n := CreateOleObject('HNetCfg.NATUPnP');
    p := n.StaticPortMappingCollection;
    if not VarIsClear(p) then
    begin
      p.Add(extPort, UpperCase(proto), intPort, ip, active, desc);
      Result := True;
    end;
  except
//    on e: exception do showmessage(e.Message);
  end;
end;

class function TUPnP_PortMapTable.remove(const extPort: DWORD; const proto: String): Boolean;
var
  n, p: Variant;
Begin
  Result := False;
  try
    n := CreateOleObject('HNetCfg.NATUPnP');
    p := n.StaticPortMappingCollection;
    if not VarIsClear(p) then
      Result := p.Remove(extPort, UpperCase(proto)) = S_OK;
  except
//    on e: exception do showmessage(e.Message);
  end;
end;

end.

möglicher Aufruf:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not TUPnP_PortMapTable.remove(1234, 'tcp') then showmessage('remove failed');
  if not TUPnP_PortMapTable.add(true, 1234, 4444, '192.168.1.4', 'TCP', 'test') then showmessage('add failed');
end;