UPnP — Википедия

uses   ..., WinSock, ComObj, ActiveX....  //Для свежих версий Delphi вместо юнита "ComObj" добавляйте "OleAuto".  ...  function GetLocalIP: String; //Получить локальный IP-адрес const WSVer = $101; var   wsaData: TWSAData;   P: PHostEnt;   Buf: array [0..127] of Char; begin   Result := '';   if WSAStartup(WSVer, wsaData) = 0 then begin     if GetHostName(@Buf, 128) = 0 then begin       P := GetHostByName(@Buf);       if P <> nil then Result := iNet_ntoa(PInAddr(p^.h_addr_list^)^);     end;     WSACleanup;   end; end;  procedure AddUPnPEntry(Port: Integer; const Name: ShortString; LAN_IP: string); var   Nat: Variant;   Ports: Variant; begin   if NOT(LAN_IP = '127.0.0.1') then begin     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;   end; end;  procedure RemoveUPnPEntry(Port: Integer); var   Nat: Variant;   Ports: Variant; begin   try     Nat := CreateOleObject('HNetCfg.NATUPnP');     Ports := Nat.StaticPortMappingCollection;     Ports.Remove(Port, 'TCP');   except     ShowMessage('An Error occured with removing UPnP Ports. ' +       'Please check to see if your router supports UPnP and ' +       'has it enabled or disable UPnP.');   end; end;  procedure ListUPnPEntry; var   Nat: Variant;   Ports: Variant;   Enum : IEnumVARIANT;   MyPort : OLEVariant;   IntPort, ExtPort : Integer;   Desc, Protocol, IntClient, ExtIP : WideString;   Enabled: Boolean;   iValue: LongWord; begin   try     Nat := CreateOleObject('HNetCfg.NATUPnP');     Ports := Nat.StaticPortMappingCollection;      if not VarIsClear(Ports) then begin       Enum := IUnknown(Ports._NewEnum) as IEnumVARIANT;       while Enum.Next(1, MyPort, iValue) = S_OK do begin         Desc := MyPort.Description;         Enabled := MyPort.Enabled;         ExtIP := MyPort.ExternalIPAddress;         ExtPort := MyPort.ExternalPort;         IntClient := MyPort.InternalClient;         IntPort := MyPort.InternalPort;         Protocol := MyPort.Protocol;         Form1.Memo1.Lines.Add(Desc + ^I + ^I + IntToStr(ExtPort) + ^I + Protocol + ^I + IntToStr(IntPort) + ^I + IntClient);       end;     end;    except     ShowMessage('An Error occured with listing UPnP Ports.Please check to see if your router supports UPnP and has UPnP enabled.');   end; end;  procedure TForm1.Button1Click(Sender: TObject); begin   AddUPnPEntry(8090, 'MyProgram', GetLocalIP); //Добавить порт end;  procedure TForm1.Button2Click(Sender: TObject); begin   RemoveUPnPEntry(8090); //Удалить порт end;  procedure TForm1.Button3Click(Sender: TObject); begin   ListUPnPEntry; //Обновить end;