许多P2P软件比如SKYPE,QQ,电驴之类需要不同内网的两台机子进行通信,而路由器的NAT机制决定了内网访问外网容易,而外网访问内网困难,那如何才能做到这一点呢?有办法------打洞!
为什么网上讲到的P2P打洞基本上都是基于UDP协议的打洞？难道TCP不可能打洞？还是TCP打洞难于实现？
假设现在有内网客户端A和内网客户端B，有公网服务端S。
如果A和B想要进行UDP通信，则必须穿透双方的NAT路由。假设为NAT-A和NAT-B。
A发送数据包到公网S,B发送数据包到公网S,则S分别得到了A和B的公网IP，
S也和A B 分别建立了会话，由S发到NAT-A的数据包会被NAT-A直接转发给A，
由S发到NAT-B的数据包会被NAT-B直接转发给B，除了S发出的数据包之外的则会被丢弃。
所以：现在A B 都能分别和S进行全双工通讯了，但是A B之间还不能直接通讯。
解决办法是：A向B的公网IP发送一个数据包，则NAT-A能接收来自NAT-B的数据包
并转发给A了（即B现在能访问A了）；再由S命令B向A的公网IP发送一个数据包，则
NAT-B能接收来自NAT-A的数据包并转发给B了（即A现在能访问B了）。
以上就是“打洞”的原理。
但是TCP和UDP在打洞上却有点不同。这是因为伯克利socket（标准socket规范）的
API造成的。
UDP的socket允许多个socket绑定到同一个本地端口，而TCP的socket则不允许。
这是这样一个意思：A B要连接到S，肯定首先A B双方都会在本地创建一个socket，
去连接S上的socket。创建一个socket必然会绑定一个本地端口（就算应用程序里面没写
端口，实际上也是绑定了的，至少java确实如此），假设为8888，这样A和B才分别建立了到
S的通信信道。接下来就需要打洞了，打洞则需要A和B分别发送数据包到对方的公网IP。但是
问题就在这里：因为NAT设备是根据端口号来确定session，如果是UDP的socket，A B可以
分别再创建socket，然后将socket绑定到8888，这样打洞就成功了。但是如果是TCP的
socket，则不能再创建socket并绑定到8888了，这样打洞就无法成功。
具体实现方法需要一台服务器,现在假设两台内网PC,A和B想用端口40000通信,网关分别为NATA,NATB.服务器为S,配置如下:
A: 192.168.0.34 40000
NATA: 58.240.157.121 60020
B: 192.168.0.227 40000
NATB: 58.240.157.222 50030
S: 58.240.157.240 40000
打洞过程:
1.A访问S,打一个洞,洞的指向为A<->S
2.B访问S,打一个洞,洞的指向为B<->S
3.S访问A,告诉它:B想访问你
4.A访问B,洞的指向为A<->B,这个包B的路由器NATB收到后不会转发给B,而是丢弃,因为它认为这是来历不明的包:(
5.B访问A,洞的指向为B<->A,此时A与B可以进行双向通信,打洞成功
打洞的目的是为了告诉NAT,我要访问的IP是我"朋友",你不能阻拦它发过来的信息,比如第4步A通过发送这个包,告诉了NATA:B是我朋友;第5步B发送包给A,告诉了NATB:A是我朋友.最后NATA认识了B,而NATB认识了A,A与B终于实现了双向通信.
终于完成了 看过人家实例后自己再做一个: 实现了文字信息如果要现实发送文件其实也一样的
下面是实现的：
封包结构：
unit UPack;
{
KONG 基于UDP 打洞技术 选择 WSAAsyncSelect模型 20100401 封包结构
}
interface
uses Windows,Messages,Winsock2;
const
userLen = 10;
userPas = 10;
type
{服务端命令集} TSendServe = (ServerLogin,ServerLogout,ServerUserInfo,ServerOnline);{登录命令,客户端退出命令,打洞命令,保持连线}
{客户端命令集} TSendClien = (ClienLoginResp,ClienUserListResp,MakeHole,ClienMessage,ClienOutStop);{登录情况,更新客户端用户列表,返回主机信息,文字聊天,服务强行退出}
TUserMessage = (ServerOut); //广播命令
//--------------------------------------------------------------------服务端封包
PServerHead = ^TServerHead; //包头信息
TServerHead = packed record
ISTYPE:TSendServe;
end;
Ppacklogin = ^Tpacklogin; //进入包
Tpacklogin = packed record
ISTYPE:TSendServe; //命令集
logintime:TDateTime; //进入时间
loginName:array[0..userLen] of Char;//用户名字
LoginPass:array[0..userPas] of Char;//用户密码
end;
PUser = ^TUser; //客户信息
TUser = packed record
UserName:array[0..userLen] of Char; //用户名字
Usertime:TDateTime; //进入时间
UserAddr:u_long; //用户地址
Userport:u_short; //用户端口
Userline:Boolean; //是否在线
LoginTickCount:Integer; //心跳
end;
PSerLoginCheck = ^TSerLoginCheck; //登录信息
TSerLoginCheck = packed record
ISTYPE:TSendServe; //命令集
UserName:array[0..userLen] of Char; //用户名字
Check:Boolean; //成功/失败
end;
//--------------------------------------------------------------------服务端封包
//--------------------------------------------------------------------客户端封包
PClienHead = ^TClienHead; //包头信息
TClienHead = packed record
ISTYPE:TSendClien;
end;
PCleLoginCheck = ^TCleLoginCheck; //登录信息
TCleLoginCheck = packed record
ISTYPE:TSendClien; //命令集
UserName:array[0..userLen] of Char; //用户名字
Check:Boolean; //成功/失败
end;
PUserListOut = ^TUserListOut;
TUserListOut = packed record //广播服务退出
ISTYPE:TSendClien; //命令集
UserMessage:TUserMessage; //广播内容
end;
PlistData = ^TlistData;
TlistData = packed record
ISTYPE:TSendClien; //命令集
DataStr:array[0..1022] of Char; //只支持1023个字符
end;
PStrMessage = ^TStrMessage;
TStrMessage = packed record
ISTYPE:TSendClien; //命令集
DataStr:array[0..1022] of Char; //只支持1023个字符
end;
//--------------------------------------------------------------------客户端封包
//---------------------------------------------------------------------P2P
PP2P = ^TP2P;
TP2P = packed record
ISTYPE:TSendServe; //命令集
UserNameA:array[0..userLen] of Char; //用户名字
UserNameB:array[0..userLen] of Char; //用户名字
end;
P2PUserMessage = ^TP2PUserMessage; //返回主客信息
TP2PUserMessage = packed record
ISTYPE:TSendClien; //命令集
UserName:array[0..userLen] of Char; //用户名字
UserAddr:u_long; //用户地址
Userport:u_short; //用户端口
end;
//---------------------------------------------------------------------P2P
implementation
end.
服务端代码：
unit UMain;
{
KONG 基于UDP 打洞技术 选择 WSAAsyncSelect模型 20100401
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Winsock2,IniFiles,UPack, ComCtrls,Contnrs, ExtCtrls;
const
WM_SOCKET_MESSAGE = WM_USER + 2048; //Socket 消息
SERVER_PORT = 5432; //指定端口
initialWSData = $0202; //WSData值
type
TUdpServer = class(TForm)
grp1: TGroupBox;
lv1: TListView;
pnl1: TPanel;
shp1: TShape;
shp2: TShape;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FClientList: TList; //用户列表
FPUser:PUser; //客户端信息
Fini:TIniFile; //Ini
FiniPath:String; //Ini路径
FSocket:TSocket; //套接字
Fshp:Boolean; //状态标志
procedure Socketmessage(var Msg:TMessage); message WM_SOCKET_MESSAGE; //处理 WM_SOCKET_MESSAGE 消息
procedure outclientList;
procedure Logout(UserName:String);//离开
procedure On
procedure SendClienMessageOut(UserMessage:TUserMessage); //广播服务退出消息
procedure SendClienMessageLst; //广播进入客户列表
procedure P2PMakeHole(P2P:TP2P;addr:TSockAddrIn); //打洞过程
Function SelectUser(UserName:string):Boolean;//查询是否有相同的用户 false 存在 True 不存在
public
end;
var
UdpServer: TUdpServer;
implementation
{$R *.dfm}
procedure TUdpServer.FormCreate(Sender: TObject);
var
WSData: TWSAData;
addr:TSockAddrIn;//主机地址
Port:Word;
begin
FclientList := TList.Create;
FiniPath := ExtractFileDir(Application.ExeName) + '\Server.ini';
Fini := TIniFile.Create(FiniPath);
Port := Fini.ReadInteger('Server','Port',SERVER_PORT);
if WSAStartup(initialWSData,WSData) = 0 then
begin
FSocket := Socket(AF_INET,SOCK_DGRAM,IPPROTO_IP);//创建套接字 IPPROTO_IP
addr.sin_family := AF_INET; //要和套接字保持一致
addr.sin_port := htons(Port); //绑定端口
addr.sin_addr.S_addr := INADDR_ANY;//0.0.0.0 地址
if bind(FSocket,@addr,SizeOf(addr)) = SOCKET_ERROR then
begin
closesocket(FSocket);
if Assigned(Fini) then FreeAndNil(Fini);
ShowMessage('Err: bind 绑定失败!');
end;
if WSAAsyncSelect(FSocket,Handle,WM_SOCKET_MESSAGE,FD_READ) = SOCKET_ERROR then
ShowMessage('WSAAsyncSelect 执行失败!');
listen(FSocket,20); // 默认为5 但20 最好 用户过多的时候 很有用
end else
begin
if Assigned(Fini) then FreeAndNil(Fini);
ShowMessage('Err:WSAStartup 执行失败!');
end;
end;
procedure TUdpServer.FormDestroy(Sender: TObject);
var
i:Integer;
begin
SendClienMessageOut(ServerOut); //强制关闭所有客户端
closesocket(FSocket);//闭关套接字
WSACleanup;
if Assigned(FClientList) then
begin
for i := 0 to FClientList.Count - 1 do
FreeMem(PUser(FClientList.Items));
FreeAndNil(FClientList);
end;
if Assigned(Fini) then FreeAndNil(Fini);
end;
procedure TUdpServer.Logout(UserName:String);
var
i:Integer;
begin
for i := 0 to FClientList.Count - 1 do
begin
if not Boolean(StrComp(PUser(FClientList.Items)^.UserName,PChar(UserName))) then
begin
FreeMem(PUser(FClientList.Items));
FClientList.Delete(i);
Break;
end;
end;
end;
procedure TUdpServer.On
var
i:Integer;
begin
for i := 0 to FClientList.Count - 1 do
begin
if not Boolean(StrComp(PUser(FClientList.Items)^.UserName,PChar(UserName))) then
begin
PUser(FClientList.Items).LoginTickCount := GetTickCount;
Break;
end;
end;
end;
procedure TUdpServer.outclientList;
var
i:Integer;
lv:TListItem;
YesLine:string;
tmp:TInAddr;
begin
lv1.Clear;
for i := 0 to FClientList.Count - 1 do
begin
with lv do
begin
lv := lv1.Items.Add;
Caption := PUser(FClientList.Items)^.UserName; //用户名字
SubItems.Add(FormatDateTime('YYYY-MM-DD TT',PUser(FClientList.Items)^.Usertime)); //进入时间
SubItems.Add(inttostr(ntohs(PUser(FClientList.Items)^.Userport))); //用户端口
tmp.S_addr := PUser(FClientList.Items)^.UserAddr;
SubItems.Add(inet_ntoa(tmp)); //用户地址
if PUser(FClientList.Items)^.Userline then YesLine := '在线'
else YesLine := '离线';
SubItems.Add(YesLine); //是否在线
end;
end;
end;
procedure TUdpServer.P2PMakeHole(P2P: TP2P; addr: TSockAddrIn);
var
i:Integer;
NewP2PUserMessage:TP2PUserMessage;//返回主客信息
addrto:TSockAddrIn;
begin
for i := 0 to FClientList.Count - 1 do
begin
if not Boolean(StrComp(P2P.UserNameB,Puser(FClientList.Items)^.UserName)) then
begin
//------------------------回复申请方 对方的主机信息地址
FillChar(NewP2PUserMessage,SizeOf(TP2PUserMessage),#0);
NewP2PUserMessage.ISTYPE := MakeHole;
StrPCopy(NewP2PUserMessage.UserName,Puser(FClientList.Items)^.UserName);
NewP2PUserMessage.UserAddr := Puser(FClientList.Items)^.UserAddr;
NewP2PUserMessage.Userport := Puser(FClientList.Items)^.Userport;
sendto(FSocket,NewP2PUserMessage,SizeOf(TP2PUserMessage),0,@addr,SizeOf(TSockAddrIn));
//------------------------回复结束
//------------------------回复被申请方 告知申请方需要访问 打洞命令
FillChar(NewP2PUserMessage,SizeOf(TP2PUserMessage),#0);
addrto.sin_family := AF_INET;
addrto.sin_port := Puser(FClientList.Items)^.Userport;
addrto.sin_addr.S_addr := Puser(FClientList.Items)^.UserAddr;
NewP2PUserMessage.ISTYPE := MakeHole;
StrPCopy(NewP2PUserMessage.UserName,P2P.UserNameA);
NewP2PUserMessage.UserAddr := addr.sin_addr.S_addr;
NewP2PUserMessage.Userport := addr.sin_port;
sendto(FSocket,NewP2PUserMessage,SizeOf(TP2PUserMessage),0,@addrto,SizeOf(TSockAddrIn));
//------------------------回复结束
Break;
end;
end;
end;
function TUdpServer.SelectUser(UserName: string): Boolean;
var
i:Integer;
TempName:string;
begin
Result := True;
for i := 0 to FClientList.Count - 1 do
begin
Result := Boolean(StrComp(PUser(FClientList.Items)^.UserName,PChar(UserName)));
if not Result then Break;
end;
end;
procedure TUdpServer.SendClienMessageLst;
var
i,addrlen:Integer;
listData:TlistData;//用户列表 以|分开
listName:string; //用户列表 以|分开
addr:TSockAddrIn; //用户地址
begin
addrlen := SizeOf(addr);
FillChar(listData,SizeOf(TlistData),#0);
listData.ISTYPE := ClienUserListResp;
for i := 0 to FClientList.Count - 1 do
listName := listName + PUser(FClientList.Items)^.UserName + '|';
StrPCopy(listData.DataStr,listName);
if Trim(listData.DataStr) <> '' then
begin
for i := 0 to FClientList.Count - 1 do //发送给所有客户端
begin
addr.sin_family := AF_INET;
addr.sin_port := PUser(FClientList.Items)^.Userport;
addr.sin_addr.S_addr := PUser(FClientList.Items)^.UserAddr;
sendto(FSocket,listData,sizeof(TlistData),0,@addr,addrlen);
end;
end;
end;
procedure TUdpServer.SendClienMessageOut(UserMessage:TUserMessage);
var
i:Integer;
UserListOut:TUserListOut;
addrTo:TSockAddrIn;
addrTolen:Integer;
begin
UserListOut.ISTYPE := ClienOutStop;
UserListOut.UserMessage := UserMessage;
addrTolen := SizeOf(TSockAddrIn);
for i := 0 to FClientList.Count - 1 do
begin
addrTo.sin_family := AF_INET;
addrTo.sin_port := PUser(FClientList.Items)^.Userport;
addrTo.sin_addr.S_addr := PUser(FClientList.Items)^.UserAddr;
sendto(FSocket,UserListOut,sizeof(TUserListOut),0,@addrTo,addrTolen);
end;
end;
procedure TUdpServer.Socketmessage(var Msg:TMessage);
var
TempBuf:array[0..9999] of Char;
addr,addrTo: TSockAddrIn; //客户端 地址 A-addr B-addrTo
addrlen,addrToLen:Integer;
NewHead:TServerHead; //包头信息
recvlen:Integer;
login:Tpacklogin; //客户端信息
Ppack:Ppacklogin; //客户端信息
LoginCheck:TCleLoginCheck; //登录信息
NewP2P:TP2P; //打洞
NewP2PUserMessage:TP2PUserMessage;//返回主客信息
begin
case WSAGetSelectEvent(msg.LParam) of
FD_READ:
begin
FillChar(TempBuf,SizeOf(TempBuf),#0);
Fillchar(NewHead,SizeOf(NewHead),#0);
addrlen := SizeOf(addr);
addrToLen:= SizeOf(addrTo);
if recvfrom(FSocket,TempBuf,SizeOf(TempBuf),0,@addr,addrlen) > 0 then //取出数据 存放到 TempBuf 当中
begin
Move(TempBuf[0],NewHead,SizeOf(TServerHead)); //分离包头
case NewHead.ISTYPE of
ServerLogin://用户进入服务--纪录用户信息
begin
FillChar(login,SizeOf(Tpacklogin),#0);
Move(TempBuf[0],login,SizeOf(Tpacklogin)); //分离客户端信息
if SelectUser(login.loginName) then
begin
GetMem(FPUser,SizeOf(TUser)); //申请内存空间
FillChar(FPUser^,SizeOf(TUser),#0);
StrCopy(FPUser^.UserName,login.loginName); //用户名字
FPUser^.Usertime := login.logintime; //用户进入时间
FPUser^.UserAddr := addr.sin_addr.S_addr; //用户地址
FPUser^.Userport := addr.sin_port; //用户端口
FPUser^.Userline := True;
FPUser^.LoginTickCount := GetTickCount; //心跳开始
FclientList.Add(FPUser); //加入到列表
//---------------------成功进入 需要回复客户端 通知完成
FillChar(LoginCheck,SizeOf(TCleLoginCheck),#0);
LoginCheck.ISTYPE :=ClienLoginResp;
StrPCopy(LoginCheck.UserName,login.loginName);
LoginCheck.Check := True;
sendto(FSocket,LoginCheck,SizeOf(TCleLoginCheck),0,@addr,addrlen);
//---------------------成功进入
SendClienMessageLst;//广播客户列表
end else
begin //进入失败 需要回复客户端 通知失败
LoginCheck.ISTYPE := ClienLoginResp;
StrPCopy(LoginCheck.UserName,login.loginName);
LoginCheck.Check := False;
sendto(FSocket,LoginCheck,SizeOf(TCleLoginCheck),0,@addr,addrlen);
end;
outclientList; //更新列表
end;
ServerLogout:
begin
Move(TempBuf[0],LoginCheck,SizeOf(TCleLoginCheck));//分离客户端信息
Logout(LoginCheck.UserName);
outclientList; //更新列表
SendClienMessageLst;//广播客户列表
if FClientList.Count = 0 then
begin
shp1.Brush.Color := clWindow;
shp2.Brush.Color := clWindow;
end;
end;
ServerUserInfo:
begin
Move(TempBuf[0],NewP2P,SizeOf(TP2P));//分离客户端信息
P2PMakeHole(NewP2P,addr);//打洞过程
end;
ServerOnline:
begin
Move(TempBuf[0],LoginCheck,SizeOf(TCleLoginCheck));//分离客户端信息
On
//状态
if Fshp then
begin
shp1.Brush.Color := clLime;
shp2.Brush.Color := clRed;
end
else
begin
shp1.Brush.Color := clRed;
shp2.Brush.Color := clLime;
end;
Fshp := not Fshp;
end;
end;
end;
end;
end;
end;
end.
客户端代码：
unit UMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,Winsock2,IniFiles,UPack;
const
WM_SOCKET_MESSAGE = WM_USER + 2048; //Socket 消息
SERVER_PORT = 8886; //指定端口
initialWSData = $0202; //WSData值
//----------------------------------------------------------------------心跳线程
type
TLogtherad = class(TThread)
private
FSocket:TSocket;
FedtUserName:string;
FCriticalSection: TRTLCriticalSection;
FServeradd:TSockAddrIn;
constructor Create(Socket:TSocket;edtUserName:string;Serveradd:TSockAddrIn);
procedure Execute; override;
public
end;
//----------------------------------------------------------------------心跳线程
type
TFrmmain = class(TForm)
pnl1: TPanel;
mmo1: TMemo;
pnl2: TPanel;
grp1: TGroupBox;
lbl1: TLabel;
lbl2: TLabel;
edtServeradd: TEdit;
edtserverport: TEdit;
edtUserName: TEdit;
edtUserpass: TEdit;
lbl3: TLabel;
lbl4: TLabel;
btn1: TButton;
edtSendTextstr: TEdit;
shp1: TShape;
lbl5: TLabel;
btn3: TButton;
lst1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Act
procedure btn3Click(Sender: TObject);
procedure lst1Click(Sender: TObject);
private
Fini:TIniFile; //Ini
FiniPath:String; //Ini路径
FSocket:TSocket; //套接字
FServeradd:TSockAddrIn; //服务器地址
FLoginTickCount:Integer;//连接检验超时
FLogtherad:TLogtherad; //心跳纯程
FP2pAddr:TSockAddrIn; //P2P地址
procedure Socketmessage(var Msg:TMessage); message WM_SOCKET_MESSAGE; //处理 WM_SOCKET_MESSAGE 消息
procedure UpdateClienList(Newuserlist:String);//更新客户端用户列表
procedure SendMakeHole(P2PName:String);//打洞开始
procedure SetFocusList(P2PName:String);//打洞开始
public
{ Public declarations }
end;
var
Frmmain: TFrmmain;
implementation
{$R *.dfm}
procedure On
begin
if GetTickCount - Frmmain.FLoginTickCount > 2000 then
begin
KillTimer(Frmmain.Handle,2);
ShowMessage('服务器连接失败');
end;
end;
procedure TFrmmain.FormCreate(Sender: TObject);
var
add:TSockAddrIn;
wWSData:TWSAData;
begin
FiniPath := ExtractFileDir(Application.ExeName) + '\config.ini';
Fini := TIniFile.Create(FiniPath);
edtServeradd.Text := Fini.ReadString('Config','edtServeradd','127.0.0.1');
edtserverport.Text:= Fini.ReadString('Config','edtserverport','8886');
edtUserName.Text := Fini.ReadString('Config','edtUserName','KONG_A');
edtUserpass.Text := Fini.ReadString('Config','edtUserpass','888888');
if WSAStartup(initialWSData,wWSData) = 0 then
begin
FSocket := socket(AF_INET,SOCK_DGRAM,IPPROTO_IP); //创建套接字 IPPROTO_IP
add.sin_family := AF_INET;
add.sin_addr.S_addr := INADDR_ANY;
if WSAAsyncSelect(FSocket,Handle,WM_SOCKET_MESSAGE,FD_READ) = SOCKET_ERROR then
begin
if Assigned(Fini) then FreeAndNil(Fini);
ShowMessage('Err:WSAAsyncSelect 执行失败!');
end;
end else
begin
if Assigned(Fini) then FreeAndNil(Fini);
ShowMessage('Err:WSAStartup 执行失败!');
end;
end;
procedure TFrmmain.FormDestroy(Sender: TObject);
begin
Fini.WriteString('Config','edtServeradd',edtServeradd.Text);
Fini.WriteString('Config','edtserverport',edtserverport.Text);
Fini.WriteString('Config','edtUserName',edtUserName.Text);
Fini.WriteString('Config','edtUserpass',edtUserpass.Text);
if Assigned(Fini) then FreeAndNil(Fini);
closesocket(FSocket);//关闭套接字
WSACleanup;
end;
procedure TFrmmain.Socketmessage(var Msg: TMessage);
var
TempBuf:array[0..9999] of Char;
addr: TSockAddrIn; //客户端 地址 A-addr B-addrTo
addrlen:Integer;
NewHead:TClienHead; //包头信息
LoginCheck:TSerLoginCheck; // 登录信息
UserListOut:TUserListOut; //广播消息
listData:TlistData;//用户列表 以|分开
NewP2PUserMessage:TP2PUserMessage;//返回主客信息
StrMessage:TStrMessage; //文字信息
begin
case WSAGetSelectEvent(msg.LParam) of
FD_READ:
begin
FillChar(TempBuf,SizeOf(TempBuf),#0);
if recvfrom(FSocket,TempBuf,SizeOf(TempBuf),0,@addr,addrlen) > 0 then
begin
Move(TempBuf[0],NewHead,SizeOf(TClienHead));
case NewHead.ISTYPE of
ClienLoginResp:
begin
Move(TempBuf[0],LoginCheck,SizeOf(TSerLoginCheck));
if LoginCheck.Check then
begin
shp1.Brush.Color := clLime;
edtServeradd.Enabled := False;
edtUserName.Enabled := False;
edtserverport.Enabled := False;
edtUserpass.Enabled := False;
FLogtherad:=TLogtherad.Create(FSocket,LoginCheck.UserName,addr);
btn1.Enabled := False;
end else ShowMessage(LoginCheck.UserName + ' :有相同的用户名!进入失败！');
end;
ClienUserListResp:
begin
FillChar(listData,SizeOf(TlistData),#0);
Move(TempBuf[0],listData,SizeOf(TlistData));
UpdateClienList(listData.DataStr);
end;
MakeHole: //返回主机信息
begin
FillChar(NewP2PUserMessage,SizeOf(TP2PUserMessage),#0);
Move(TempBuf[0],NewP2PUserMessage,SizeOf(TP2PUserMessage));
FP2pAddr.sin_family := AF_INET;
FP2pAddr.sin_port := NewP2PUserMessage.Userport;
FP2pAddr.sin_addr.S_addr := NewP2PUserMessage.UserAddr;
end;
ClienMessage:
begin
FillChar(StrMessage,SizeOf(TStrMessage),#0);
Move(TempBuf[0],StrMessage,SizeOf(TStrMessage));
mmo1.Lines.Add(NewP2PUserMessage.UserName + ' 对你说=> [ '+StrMessage.DataStr+' ]');
SetFocusList(NewP2PUserMessage.UserName);
end;
ClienOutStop:
begin
Move(TempBuf[0],UserListOut,SizeOf(TUserListOut));
case UserListOut.UserMessage of
ServerOut:
begin
ShowMessage('服务强行退出');
FLogtherad.Suspend;
Close;
end;
end;
end;
end;
end;
end;
end;
end;
procedure TFrmmain.FormShow(Sender: TObject);
begin
edtSendTextstr.SetFocus;
end;
procedure TFrmmain.btn1Click(Sender: TObject);
var
login:Tpacklogin;
begin
FServeradd.sin_family := AF_INET;
FServeradd.sin_addr.S_addr := inet_addr(PChar(Trim(edtServeradd.Text)));
FServeradd.sin_port := htons(StrToIntDef(Trim(edtserverport.Text),8886));
FillChar(login,SizeOf(Tpacklogin),#0);
login.ISTYPE := ServerLogin;
StrPCopy(login.loginName,Trim(edtUserName.Text));
StrPCopy(login.LoginPass,Trim(edtUserpass.Text));
login.logintime := Now;
sendto(FSocket,login,SizeOf(TPacklogin),0,@FServeradd,SizeOf(FServeradd));
FLoginTickCount := GetTickCount;
SetTimer(Handle,2,200,@On
end;
procedure TFrmmain.FormClose(Sender: TObject; var Act
var
LoginCheck:TSerLoginCheck;
begin
LoginCheck.ISTYPE := ServerLogout;
StrPCopy(LoginCheck.UserName,Trim(edtUserName.Text));
LoginCheck.Check := False;
sendto(FSocket,LoginCheck,SizeOf(TSerLoginCheck),0,@FServeradd,SizeOf(FServeradd));
end;
{ TLogtherad }
constructor TLogtherad.Create(Socket: TSocket;edtUserName:string;Serveradd:TSockAddrIn);
begin
InitializeCriticalSection(FCriticalSection);
FSocket := Socket;
FedtUserName := edtUserName;
FServeradd := Serveradd;
FreeOnTerminate := True;
inherited Create(False);
end;
procedure TLogtherad.Execute;
var
LoginCheck:TSerLoginCheck;
begin
EnterCriticalSection(FCriticalSection); //加锁
while not Terminated do
begin
LoginCheck.ISTYPE := ServerOnline;
StrPCopy(LoginCheck.UserName,Trim(FedtUserName));
LoginCheck.Check := True;
sendto(FSocket,LoginCheck,SizeOf(TSerLoginCheck),0,@FServeradd,SizeOf(FServeradd));
Sleep(1000);
Frmmain.FLoginTickCount := GetTickCount;
end;
LeaveCriticalSection(FCriticalSection);//解锁
end;
procedure TFrmmain.UpdateClienList(Newuserlist:String);
var
i:Integer;
userlist:TStrings;
begin
try
userlist := TStringList.Create;
userlist.Delimiter := '|';
userlist.DelimitedText := Newuserlist;
lst1.Clear;
for i := 0 to userlist.Count - 2 do
begin
if Boolean(StrComp(PChar(userlist.Strings),PChar(Trim(edtUserName.Text)))) then //不加入自身
lst1.Items.Add(userlist.Strings);
end;
lst1.ItemIndex := 0;
if lst1.ItemIndex <> - 1 then
SendMakeHole(lst1.Items[lst1.ItemIndex]);//打洞
finally
FreeAndNil(userlist);
end;
end;
procedure TFrmmain.btn3Click(Sender: TObject);
var
StrMessage:TStrMessage; //文字信息
begin
if lst1.ItemIndex <> -1 then
begin
//----------------------------------发送文字信息
FillChar(StrMessage,SizeOf(TStrMessage),#0);
StrMessage.ISTYPE := ClienMessage;
StrPCopy(StrMessage.DataStr,Trim(edtSendTextstr.Text));
sendto(FSocket,StrMessage,SizeOf(TStrMessage),0,@FP2pAddr,SizeOf(TSockAddrIn));
//----------------------------------发送文字信息
end;
mmo1.Lines.Add('你对=> ['+trim(lst1.Items[lst1.ItemIndex])+'] 说 ' + edtSendTextstr.Text);
edtSendTextstr.Clear;
end;
procedure TFrmmain.lst1Click(Sender: TObject);
begin
if lst1.ItemIndex <> - 1 then
SendMakeHole(lst1.Items[lst1.ItemIndex]);//打洞
end;
procedure TFrmmain.SendMakeHole(P2PName: String);
var
NewP2P:TP2P; //打洞
begin
if lst1.ItemIndex <> -1 then
begin
//----------------------------------申请打洞
FillChar(NewP2P,SizeOf(TP2P),#0);
NewP2P.ISTYPE := ServerUserInfo; //打洞命令
StrPCopy(NewP2P.UserNameA,trim(edtUserName.Text));
StrPCopy(NewP2P.UserNameB,trim(P2PName));
sendto(FSocket,NewP2P,SizeOf(TP2P),0,@FServeradd,SizeOf(TSockAddrIn));
//----------------------------------申请结束
end;
end;
procedure TFrmmain.SetFocusList(P2PName: String);
var
index:Integer;
begin
for index := 0 to lst1.Count - 1 do
begin
if not Boolean(StrComp(PChar(lst1.Items),PChar(P2PName))) then
begin
lst1.ItemIndex := index;
Break;
end;
end;
end;
end.
经过以上可以在内网通信外网没有测试过有空的朋友可以试一下
窗体
服务端
object UdpServer: TUdpServer
Left = 297
Top = 146
Width = 520
Height = 494
Caption = '服务端程序'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
On
On
PixelsPerInch = 96
TextHeight = 13
object grp1: TGroupBox
Left = 0
Top = 0
Width = 512
Height = 460
Align = alClient
Caption = '客户信息'
TabOrder = 0
object lv1: TListView
Left = 2
Top = 15
Width = 508
Height = 425
Align = alClient
Columns = <
item
Caption = '用户名字'
Width = 70
end
item
Caption = '进入时间'
Width = 150
end
item
Caption = '用户端口'
Width = 60
end
item
Caption = '用户地址'
Width = 70
end
item
Caption = '是否在线'
Width = 70
end>
TabOrder = 0
ViewStyle = vsReport
end
object pnl1: TPanel
Left = 2
Top = 440
Width = 508
Height = 18
Align = alBottom
Color = clCream
TabOrder = 1
object shp1: TShape
Left = 496
Top = 1
Width = 11
Height = 16
Align = alRight
Brush.Color = clWindow
Pen.Style = psClear
Shape = stCircle
end
object shp2: TShape
Left = 485
Top = 1
Width = 11
Height = 16
Align = alRight
Brush.Color = clWindow
Pen.Style = psClear
Shape = stCircle
end
end
end
end
客户端
object Frmmain: TFrmmain
Left = 391
Top = 181
BorderIcons =
BorderStyle = bsToolWindow
Caption = '客户端程序'
ClientHeight = 521
ClientWidth = 491
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
On
On
On
On
PixelsPerInch = 96
TextHeight = 13
object pnl1: TPanel
Left = 0
Top = 0
Width = 491
Height = 225
Align = alTop
TabOrder = 0
object mmo1: TMemo
Left = 1
Top = 1
Width = 489
Height = 223
Align = alClient
TabOrder = 0
end
end
object pnl2: TPanel
Left = 0
Top = 225
Width = 491
Height = 296
Align = alClient
TabOrder = 1
object lbl5: TLabel
Left = 6
Top = 92
Width = 54
Height = 13
Caption = '在线用户 '
end
object grp1: TGroupBox
Left = 0
Top = 20
Width = 489
Height = 66
Caption = '网络设置'
TabOrder = 0
object lbl1: TLabel
Left = 8
Top = 16
Width = 60
Height = 13
Caption = '服务地址 : '
end
object lbl2: TLabel
Left = 8
Top = 37
Width = 63
Height = 13
Caption = '服务端口 : '
end
object lbl3: TLabel
Left = 136
Top = 15
Width = 63
Height = 13
Caption = '用户姓名 : '
end
object lbl4: TLabel
Left = 136
Top = 40
Width = 63
Height = 13
Caption = '用户密码 : '
end
object shp1: TShape
Left = 440
Top = 16
Width = 49
Height = 41
Brush.Color = clRed
Shape = stCircle
end
object edtServeradd: TEdit
Left = 79
Top = 13
Width = 53
Height = 21
TabOrder = 0
Text = '127.0.0.1'
end
object edtserverport: TEdit
Left = 79
Top = 37
Width = 53
Height = 21
TabOrder = 1
Text = '8886'
end
object edtUserName: TEdit
Left = 199
Top = 12
Width = 90
Height = 21
TabOrder = 2
Text = 'KONG_A'
end
object edtUserpass: TEdit
Left = 199
Top = 36
Width = 90
Height = 21
TabOrder = 3
Text = '123456'
end
object btn1: TButton
Left = 296
Top = 11
Width = 140
Height = 45
Caption = '进入服务'
TabOrder = 4
On
end
end
object edtSendTextstr: TEdit
Left = 6
Top = 242
Width = 476
Height = 21
TabOrder = 1
end
object btn3: TButton
Left = 6
Top = 268
Width = 475
Height = 24
Caption = '发送'
TabOrder = 2
On
end
object lst1: TListBox
Left = 6
Top = 112
Width = 475
Height = 121
ItemHeight = 13
TabOrder = 3
On
end
end
end
2356
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
