[转载]用delphi实现自动NAT(1)

delphi_笔记 2019-07-04

展开全文

用delphi实现自动NAT(1)

[ quickburro 发表于 2007-8-6 18:19:00 ]

自动NAT（端口映射）在Internet应用软件开发中有很广泛的用途，通过该技术，不仅软件的通信速度能得到有效提升、编程的复杂度减低，而且在软件的安装、维护等方面也变得更加省力。在BT、eMule等软件中，已成功应用了该技术，取得了较好的效果。

该技术一般基于UPnP协议进行实现。而网上有许多资料介绍其实现过程，有的也提供源代码，但是，我们发现这些资源都是概述性的介绍，或者又是基于C语言的为多，而用delphi进行实现的例子很难找到。为此，笔者专门使用delphi工具进行了技术实现，并将源代码公布于此，让各位delphi程序员共享，如有技术问题，请与我联系、交流。

1、程序界面：

在delphi中新建一工程，里面放置TMemo、TNMUDP、TClientSocket、TButton等若干个控件，组成一个用UPnP技术进行路由器自动端口映射的测试程序，界面如下图所示：

[转载]用delphi实现自动NAT(1)

2、源代码：

unit uPnpMain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, NMUDP, ScktComp;

type
TForm1 = class(TForm)
    Memo1: TMemo;
    UDP: TNMUDP;
    Button1: TButton;
    Button2: TButton;
    ClientSocket: TClientSocket;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    ControlSocket: TClientSocket;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
    procedure UDPDataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure Button2Click(Sender: TObject);
    procedure ClientSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocketWrite(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    ResponseFinished(ResponseData: string): boolean;
    procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ControlSocketConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ControlSocketWrite(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ControlSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure ControlSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ControlSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
    location,server,usn: string;
    routerip: string;
    routerport: integer;
    url: string;
    requested: boolean;
    response: string;
    urlbase: string;
    controlurl: string;
//
    controled: boolean;
    controltype: integer;   {1:增加 2：删除 3：获取信息}
    controlresponse: string;
end;