该技术一般基于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