UDP安全传输

UDP安全传输（Delphi完整源码）2008-08-28 02:21UDP安全传输（Delphi完整源码）
UDP安全传输（完整源码）
大家都知道UDP比TCP好用发送速度快很多，程序写起来也简单的多，可缺点也同样明显UDP容易丢包，而且不能自动重发也不能自动组包没有数据安全机制，发的包不能超过2K（INDY，NMUDP等控件都是这样）否则就出错。
可很多需求中又需要发送大量数据包并且需要保证速度（如语音和视频通讯或者点对点点播服务。）而且有些重要的数据不允许丢包这个时候就需要安全UDP了。
有朋友可能会说那你干嘛不用TCP？TCP不就是安全的UDP吗?
主要因为
1、TCP无法很好的穿透NAT，来进行点对点通讯。
2、通讯过程中需要某些重要的命令不丢失，TCP需要首先建立连接，每个包都需要确认。这样发送速度会慢不少。
所以偶需要一个安全的UDP可以发送任意大小包，可以保证某些重要的包不会丢失，并且可以轻松穿透NAT来进行点对点通讯。
网上四处寻找未果SO自己动手写了一个。具有以下功能（本类是站在前人的肩膀上实现，基类为偶稍加修改过的NMUDP）
1、自动分包组包
2、支持一次性发送任意大小的包
3、支持安全控制
4、根据丢包率和网速度动态控制发包速度（因时间的局限此功能未很好的实现）
5、对于用户透明的接口（开发人员不用关心实现细节可以和使用其它UDP控件一样简单的使用本类）
接口的简单说明，使用本类很简单
当想要发送大数据包或者具有安全控制的数据包就使用方法
SafeSendBuff
即可：）
当然接收方必须使用本类（即服务端。因为偶需要自动处理分包、组包、重发等细节）
给事件成员OnDataCase付值即可该事件是接收到数据时触发

具体使用方法请见演示程序
DemoClient.exe 为接收窗体 :
DemoServer.exe 为发送窗体
发送202575字节的东东需要3秒时间：
听同事说C++有不少此方面的代码，不过我找了DELPHI方面的没找到。
现在安全控制时的发送速度比较慢因为智能根据网络流量调整的功能还没时间去弄。
安全UDP的用途十分广泛，希望对此有兴趣的朋友能和偶一起完善它
偶准备把它用于点对点通讯程序上：）

///////// 服务端///////

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, UntUdpCtl,
IdSocketHandle, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
btn1: TButton;
Edit6: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;

procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure OnCaseClentData(ISender: TudpCtl; IData: Pointer; ISize: Cardinal; IFromIP: string; IPort: integer);
public
ClientUdpCtl: TudpCtl;
Lmem: TMemoryStream;
procedure OnError(Sender: TObject; IData: PSafeUdpData; IErrorKind: SHeadLv);
end;

var
Form1: TForm1;

implementation

uses UntProctol, pmybasedebug;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
ClientUdpCtl := TudpCtl.Create(Self);
ClientUdpCtl.OnDataCase := OnCaseClentData;
ClientUdpCtl.RemoteHost := '127.0.0.1';
ClientUdpCtl.RemotePort := 1001;
ClientUdpCtl.ServerPort := 1002;
ClientUdpCtl.OnDataError := OnError;
Lmem := TMemoryStream.Create;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Lhead: Rhead;
LP: PChar;
begin
Lhead.Id := 1;
Lmem.Position := 0;
Lmem.WriteBuffer(lHead, Sizeof(Lhead));
LP := GetMemory(Memo1.GetTextLen + 1);
Lmem.SetSize(Memo1.GetTextLen + 1);
Memo1.GetTextBuf(LP, Memo1.GetTextLen + 1);
Lmem.WriteBuffer(lp^, Memo1.GetTextLen + 1);
FreeMemory(LP);
ClientUdpCtl.RemoteHost := Edit2.Text;
ClientUdpCtl.PeerSize := StrToInt(Edit5.Text);
ClientUdpCtl.ReSendTime := StrToInt(Edit3.Text);
ClientUdpCtl.FreeWindowsCount := StrToInt(Edit4.Text);
ClientUdpCtl.SleepTime := StrToInt(Edit6.Text);
ClientUdpCtl.SafeSendBuff(Lmem.Memory^, Lmem.Size);
Edit1.Text := IntToStr(Lmem.Size);
end;

procedure TForm1.OnCaseClentData(ISender: TudpCtl; IData: Pointer; ISize:
Cardinal; IFromIP: string; IPort: integer);
begin
with ISender do begin
case PInteger(IData)^ of //
1: begin
ShowMessage('Svr Resp Hello');
end;
end; // case
end;
end;

procedure TForm1.OnError(Sender: TObject; IData: PSafeUdpData;
IErrorKind: SHeadLv);
begin
Gob_Debug.AddLogShower('第%d-%d个包异常了 类型%d',
[Idata^.Head.PackedId, Idata^.Head.Part, ord(IErrorKind)]);
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
Gob_Debug.ShowDebugform;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Lmem.Free;
end;

end.

/////// 客户端//////

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, UntUdpCtl;

type
TForm1 = class(TForm)
Memo2: TMemo;
Edit2: TEdit;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
procedure OnCaseSvrData(ISender: TudpCtl; IData: Pointer; ISize: Cardinal;
IFromIP: string; IPort: integer);
{ Private declarations }
public
SvrUDPCtl: TudpCtl;
procedure OnError(Sender: TObject; IData: PSafeUdpData; IErrorKind: SHeadLv);
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses pmybasedebug, UntProctol;

{$R *.dfm}

pr

ocedure TForm1.FormCreate(Sender: TObject);
begin
SvrUDPCtl := TudpCtl.Create(Self);
SvrUDPCtl.OnDataCase := OnCaseSvrData;
SvrUDPCtl.RemoteHost := '127.0.0.1';
SvrUDPCtl.RemotePort := 1002;
SvrUDPCtl.ServerPort := 1001;
SvrUDPCtl.OnDataError := OnError;
end;

procedure TForm1.OnCaseSvrData(ISender: TudpCtl; IData: Pointer; ISize:
Cardinal; IFromIP: string; IPort: integer);
var
Lp, LTep: PChar;
begin
with ISender do begin
case PInteger(IData)^ of //
1: begin
LTep := IData;
Edit2.Text := IntToStr(ISize);
Lp := GetMemory(ISize);
inc(LTep, Sizeof(rhead));
CopyMemory(Lp, LTep, ISize);
Memo2.Text := StrPas(Lp);
FreeMemory(Lp);
end;
end; // case
end; // with
end;

procedure TForm1.OnError(Sender: TObject; IData: PSafeUdpData; IErrorKind:
SHeadLv);
begin
Gob_Debug.AddLogShower('第%d-%d个包异常了 类型%d',
[Idata^.Head.PackedId, Idata^.Head.Part, ord(IErrorKind)]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Gob_Debug.ShowDebugform;
end;

end.