用delphi实现自动NAT(1)

作者在 2007-08-07 02:21:00 发布以下内容
自动NAT(端口映射)在Internet应用软件开发中有很广泛的用途,通过该技术,不仅软件的通信速度能得到有效提升、编程的复杂度减低,而且在软件的安装、维护等方面也变得更加省力。在BT、eMule等软件中,已成功应用了该技术,取得了较好的效果。

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

 

1、程序界面:

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

 

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: s

QuickBurro开发手记 | 阅读 4175 次
文章评论,共0条
游客请输入验证码