MainUnit.pas
上传用户:xgd119
上传日期:2007-05-02
资源大小:514k
文件大小:14k
- unit MainUnit;
- {
- P2P方式模拟QQ即时消息通讯
- thanksharp@163.com
- 应考虑问题:
- 1.加入TIMER.定时向好友发送握手包,以维护网关NAT的会话SESSION.
- }
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ExtCtrls, ComCtrls, IdBaseComponent, IdComponent,
- IdUDPBase, IdUDPServer,IdSocketHandle,testQQCommon, WinSkinData,AboutUnit;
- type
- TClient = class(TForm)
- Label1: TLabel;
- UserNameEdit: TEdit;
- Label2: TLabel;
- ServerIPEdit: TEdit;
- Label3: TLabel;
- ServerPortEdit: TEdit;
- Panel1: TPanel;
- LogonButton: TButton;
- LogoutButton: TButton;
- Panel2: TPanel;
- SendMsgEdit: TRichEdit;
- UserList: TListView;
- SendMsgButton: TButton;
- StatusBar1: TStatusBar;
- UDPClient: TIdUDPServer;
- RecvEdit: TRichEdit;
- CheckBox1: TCheckBox;
- P2PTestButton: TButton;
- Label4: TLabel;
- Button1: TButton;
- SkinData1: TSkinData;
- Button2: TButton;
- procedure FormCreate(Sender: TObject);
- procedure LogonButtonClick(Sender: TObject);
- procedure LogoutButtonClick(Sender: TObject);
- procedure UDPClientUDPRead(Sender: TObject; AData: TStream;
- ABinding: TIdSocketHandle);
- procedure SendMsgButtonClick(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure P2PTestButtonClick(Sender: TObject);
- procedure Button1Click(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- MyAccount,ServerIP,MyPublicIP:String;
- MyRunPORT,ServerPORT,MyPublicPORT:Integer;
- function StartUp():Boolean;
- function CallLogout():Boolean;
- function SendHandData(toIP:string;toPORT:Integer):Boolean;
- function ProcRecvLogonData(ThisBinding:TIdSocketHandle;LogonData:TLogonData):boolean;
- function ProcRecvLogoutData(ThisBinding:TIdSocketHandle;LogoutData:TLogoutData):boolean;
- function ProcRecvFriendData(ThisBinding:TIdSocketHandle;UserData:TUserData):Boolean;
- function ProcRecvP2PData(ThisBinding:TIdSocketHandle;HandData:THandData):boolean;
- function ProcRecvChatMsgData(ThisBinding:TIdSocketHandle;ChatData:TChatData):boolean;
- end;
- var
- Client: TClient;
- AboutBox: TAboutBox;
- implementation
- function TClient.StartUp():Boolean;
- var Listened:Boolean;
- ClientPort,MaxPort:Integer;
- ASocketHandle:TIdSockethandle;
- begin
- Listened:=false;
- ClientPort:=CLIENT_PORT;
- MaxPort:=ClientPort+10;
- Listened:=true;
- repeat //处理多个程序同时运行的侦听端口问题
- try
- UDPClient.DefaultPort:=ClientPort;
- UDPClient.Active :=true;
- Listened:=true;
- break;
- except on EIdCouldNotBindSocket do
- begin
- UDPClient.Active:=false;
- UDPClient.Bindings.Clear;
- ClientPort:=ClientPort+1;
- if ClientPort>MaxPort then
- break;
- end;
- end;
- until not Listened;
- if Listened then
- begin
- MyRunPORT:=UDPclient.DefaultPort ;
- StatusBar1.Panels.Items[1].Text:='运行端口:['+IntToStr(MyRunPORT)+']';
- Result:=true;
- end
- else
- begin
- StatusBar1.Panels.Items[1].Text:='侦听失败!';
- Result:=false;
- end;
- end;
- {$R *.dfm}
- procedure TClient.FormCreate(Sender: TObject);
- begin
- StartUp();
- end;
- //登录上线
- procedure TClient.LogonButtonClick(Sender: TObject);
- var LogonDataPackage:TLogonDataPackage;
- _ServerIP,_Account:string;
- _ServerPORT:Integer;
- begin
- _ServerIP:=ServerIPEdit.Text;
- _ServerPORT:=StrToInt(ServerPORTEdit.text);
- _Account:=UserNameEdit.Text;
- with LogonDataPackage do
- begin
- Head.MsgType:=IntToStr(LogonSign);
- StrPCopy(Body.Account,_Account);
- StrPCopy(Body.MyPublicIP,'');
- StrPCopy(Body.MyPublicPORT,'');
- StrPCopy(Body.lResult,'');
- //
- end;
- UdpClient.SendBuffer(_ServerIP,_ServerPORT,LogonDataPackage,SizeOf(LogonDataPackage));
- end;
- //注销下线
- procedure TClient.LogoutButtonClick(Sender: TObject);
- begin
- CallLogout();
- end;
- //向服务器注销
- function TClient.CallLogout():Boolean;
- var LogoutDataPackage:TLogoutDataPackage;
- i,_ToPORT:integer;
- _toIP:String;
- begin
- with LogoutDataPackage do
- begin
- Head.MsgType:=IntToStr(LogoutSign);
- StrPCopy(Body.Account,MyAccount);
- StrPCopy(Body.lResult,'');
- end;
- UdpClient.SendBuffer(ServerIP,ServerPort,LogoutDataPackage,SizeOf(LogoutDataPackage));
- //向好友发送下线信号
- for i:=0 to UserList.Items.Count-1 do
- begin
- _ToIP:=UserList.Items.Item[i].SubItems[0];
- _ToPORT:=StrToInt(UserList.Items.Item[i].SubItems[1]);
- with LogoutDataPackage do
- begin
- Head.MsgType:=IntToStr(LogoutSign);
- StrPCopy(Body.Account,MyAccount);
- StrPCopy(Body.lResult,'');
- //
- end;
- UdpClient.SendBuffer(_toIP,_toPORT,LogoutDataPackage,SizeOf(LogoutDataPackage));
- Sleep(1);
- end;
- end;
- //UdpClient 读取数据
- procedure TClient.UDPClientUDPRead(Sender: TObject; AData: TStream;
- ABinding: TIdSocketHandle);
- var _UDPHead:TTQQUDPHead;
- _LogonData:TLogonData;
- _LogoutData:TLogoutData;
- _UserData:TUserData;
- _HandData:THandData;
- _ChatData:TChatData;
- RecvSize,MsgType:integer;
- begin
- try
- MsgType:=-1;
- RecvSize:=adata.Read (_UDPHead,sizeof(_UDPHead) ); //接收数据头
- MsgType:=StrToInt(_UDPHead.MsgType);
- if Msgtype=-1 then exit;
- // UDPSERVER.Binding.Assign(ABinding); //2005-02-17 Updated!
- case MsgType of
- LogonSign:
- begin
- //登录 <--Server ReBack
- Adata.Read(_LogonData,sizeof(TLogonData));
- ProcRecvLogonData(Abinding,_LogonData);
- end;
- LogoutSign:
- begin
- //注销 <--Server or Friend
- Adata.Read(_LogoutData,sizeof(TLogoutData));
- ProcRecvLogoutData(Abinding,_LogoutData);
- end;
- FriendDataSign:
- begin
- //收到好友列表信息
- Adata.Read(_UserData,sizeof(TUserData));
- ProcRecvFriendData(Abinding,_UserData);
- end;
- HandSign:
- begin
- //处理P2P请求
- Adata.Read(_HandData,sizeof(THandData));
- ProcRecvP2PData(Abinding,_HandData);
- end;
- ChatMsgSign:
- begin
- //处理聊天消息
- Adata.Read(_ChatData,sizeof(TChatData));
- ProcRecvChatMsgData(Abinding,_ChatData);
- end;
- end;
- except on E:Exception do
- //Memo1.lines.add(E.Message);
- end;
- end;
- //收到登录服务器的反馈信息处理
- function TClient.ProcRecvLogonData(ThisBinding:TIdSocketHandle;LogonData:TLogonData):boolean;
- var _LogonDataPackage:TLogonDataPackage;
- _HandDataPackage:THandDataPackage;
- _tempUserBasicInfo:TServerUserBasicInfo;
- _Account,_PeerIP,_tempIP,_NeedReBack,_isLogin:string;
- i,_PeerPORT,_tempPORT:integer;
- begin
- _Account:=LogonData.Account;
- _PeerIP:=thisbinding.PeerIP ;
- _PeerPORT:=thisbinding.PeerPort ;
- _IsLogin:=LogonData.lResult;
- //登录成功
- if _IsLogin=IsTrue then
- begin
- ServerIP:=_PeerIP;
- ServerPORT:=_PeerPORT;
- MyPublicIP:=LogonData.MyPublicIP ;
- MyPublicPORT:=StrToInt(LogonData.MyPublicPORT);
- MyAccount:=LogonData.Account ;
- SendMsgButton.Enabled:=true;
- P2PTestButton.Enabled:=true;
- LogoutButton.Enabled:=true;
- LogonButton.Enabled:=false;
- StatusBar1.Panels.Items[0].Text:='登录成功...';
- end;
- end;
- //接收到用户注销处理
- function TClient.ProcRecvLogoutData(ThisBinding:TIdSocketHandle;LogoutData:TLogoutData):boolean;
- var _Account,_tempIP,_PeerIP:string;
- i,TheTag,_tempPort,_PeerPORT:Integer;
- _tempUserBasicInfo:TServerUserBasicInfo;
- LogoutDataPackage:TLogoutDataPackage;
- begin
- _Account:=LogoutData.Account;
- if _Account=MyAccount then
- begin
- MyAccount:='';
- MyPublicIP:='';
- MyPublicPort:=0;
- SendMsgButton.Enabled:=false;
- P2PTestButton.Enabled:=false;
- LogonButton.Enabled:=true;
- LogoutButton.Enabled:=false;
- end
- else //好友离线
- begin
- for i:=0 to UserList.Items.Count -1 do
- begin
- if UserList.Items.Item[0].Caption=_Account then
- begin
- UserList.Items.Delete(i);
- RecvEdit.Lines.Add('['+IntToStr(RecvEdit.Lines.Count)+']Frien is Offline,From:['+_Account+'] ');
- Break;
- end;
- end;
- end;
- _PeerIP:=thisbinding.PeerIP ;
- _PeerPORT:=thisbinding.PeerPort;
- end;
- //收到好友列表处理
- function TClient.ProcRecvFriendData(ThisBinding:TIdSocketHandle;UserData:TUserData):Boolean;
- var _Account,_FriendIP,_FriendPort:String;
- tempItem:TListItem;
- HandDataPackage:THandDataPackage;
- begin
- _Account:=UserData.Account ;
- _FriendIP:=UserData.IP;
- _FriendPort:=UserData.PORT;
- if UserData.IsFirstOne=IsTrue then
- begin
- UserList.Items.Clear;
- end;
- tempItem:=UserList.Items.Add;
- tempItem.Caption:=_Account;
- tempItem.SubItems.Add(_FriendIP);
- tempItem.SubItems.Add(_FriendPort);
- with HandDataPackage do
- begin
- Head.MsgType:=IntToStr(HandSign);
- StrPCopy(Body.Account,MyAccount);
- StrPCopy(Body.Mark,'');
- StrPCopy(Body.DesIP,MyPublicIP);
- StrPCopy(Body.DesPORT,IntToStr(MyPublicPORT));
- StrPCopy(Body.NeedReBack,IsTrue);
- //
- end;
- UdpClient.SendBuffer(_FriendIP,StrToInt(_FriendPort),HandDataPackage,SizeOf(HandDataPackage));
- end;
- //处理握手P2P请求
- function TClient.ProcRecvP2PData(ThisBinding:TIdSocketHandle;HandData:THandData):boolean;
- var _Account,Mark,toIP,toPort:string;
- HandDataPackage:THandDataPackage;
- tempItem:TListItem;
- begin
- _Account:=HandData.Account ;
- toIP:=HandData.DesIP ;
- toPort:=HandData.DesPORT;
- Mark:=HandData.Mark ;
- if HandData.NeedReBack=IsTrue then
- begin
- with HandDataPackage do
- begin
- Head.MsgType:=IntToStr(HandSign);
- Body.Account:=HandData.Account;
- Body.DesIP:=HandData.DesIP;
- Body.DesPORT:=HandData.DesPORT;
- Body.NeedReBack:=IsFalse;
- //Head.DataSize:=SizeOf(HandDataPackage);
- end;
- if HandData.IsDirected=IsTrue then
- UdpClient.SendBuffer(ThisBinding.PeerIP,ThisBinding.PeerPort,HandDataPackage,SizeOf(HandDataPackage))
- else
- UdpClient.SendBuffer(toIP,StrToInt(toPort),HandDataPackage,SizeOf(HandDataPackage));
- RecvEdit.Lines.Add('['+IntToStr(RecvEdit.Lines.Count)+']Recv HandData,From:['+_Account+'] ['+toIP+':'+toPORT+'] SentBack!');
- Sleep(1);
- end
- else
- begin
- RecvEdit.Lines.Add('['+IntToStr(RecvEdit.Lines.Count)+']Recv HandData,From:['+_Account+'] ['+toIP+':'+toPORT+'] ');
- end;
- if Mark=IsTrue then //是好友的上线信息
- begin
- tempItem:=UserList.Items.Add ;
- tempItem.Caption:=_Account;
- tempItem.SubItems.Add(toip);
- tempItem.SubItems.Add(toPort);
- end;
- end;
- //处理聊天消息
- function TClient.ProcRecvChatMsgData(ThisBinding:TIdSocketHandle;ChatData:TChatData):boolean;
- var ChatDataPackage:TChatDataPackage;
- _fromAccount,_Msg:string;
- begin
- _fromAccount:=ChatData.fromAccount ;
- _Msg:=ChatData.Msg ;
- if ChatData.IsNeedReBack=IsTrue then
- begin
- with ChatDataPackage do
- begin
- Head.MsgType:=IntToStr(ChatMsgSign);
- StrPCopy(Body.fromAccount,MyAccount);
- StrPCopy(Body.Msg,'');
- StrPCopy(Body.IsNeedReBack,IsFalse);
- StrPCopy(Body.IsReBackSigh,IsTrue);
- //
- UdpClient.SendBuffer(ThisBinding.PeerIP,ThisBinding.PeerPort,ChatDataPackage,SizeOf(ChatDataPackage));
- end;
- end;
- //接收到的是消息
- if ChatData.IsReBackSigh=IsTrue then
- begin
- RecvEdit.Lines.Add('['+IntToStr(RecvEdit.Lines.Count)+']Peer Recv ChatMsg OK,From:['+_fromAccount+']');
- end
- else
- begin
- RecvEdit.Lines.Add('['+IntToStr(RecvEdit.Lines.Count)+']Recv ChatMsg From:['+_fromAccount+']');
- RecvEdit.Lines.Add('['+IntToStr(RecvEdit.Lines.Count)+']'+_Msg);
- end;
- end;
- //发送消息
- procedure TClient.SendMsgButtonClick(Sender: TObject);
- var ChatDataPackage:TChatDataPackage;
- _ToIP,_SendMsg,_ToAccount:string;
- _ToPORT:Integer;
- tempItem:TListItem;
- begin
- tempItem:=UserList.Selected;
- if (not assigned(tempItem)) or (tempItem=nil) then
- begin
- MessageBox(self.Handle ,'请选择消息接收者!','提示',0);
- exit;
- end;
- _ToAccount:=tempItem.Caption;
- _ToIp:=tempItem.SubItems[0];
- _ToPORT:=StrToInt(tempItem.SubItems[1]);
- _SendMsg:=SendMsgEdit.Text ;
- if length(_SendMsg)>500 then exit;
- with ChatDataPackage do
- begin
- Head.MsgType:=IntToStr(ChatMsgSign);
- StrPCopy(Body.fromAccount,MyAccount);
- StrPCopy(Body.toAccount,_ToAccount);
- StrPCopy(Body.Msg,_SendMsg);
- if CheckBox1.Checked then
- StrPCopy(Body.IsNeedReBack,IsTrue)
- else
- StrPCopy(Body.IsNeedReBack,IsFalse);
- StrPCopy(Body.IsReBackSigh,IsFalse);
- //
- end;
- UdpClient.SendBuffer(_ToIP,_ToPORT,ChatDataPackage,SizeOf(ChatDataPackage));
- end;
- procedure TClient.FormClose(Sender: TObject; var Action: TCloseAction);
- begin
- CallLogout();
- end;
- //发送握手信息P2P
- function TClient.SendHandData(toIP:string;toPORT:Integer):Boolean;
- var HandDataPackage:THandDataPackage;
- LogoutDataPackage:TLogoutDataPackage;
- begin
- with HandDataPackage do
- begin
- Head.MsgType:=IntToStr(HandSign);
- StrPCopy(Body.Account,MyAccount);
- StrPCopy(Body.DesIP,toIP);
- StrPCopy(Body.DesPORT,IntToStr(toPORT));
- StrPCopy(Body.NeedReBack,IsTrue);
- StrPCopy(Body.IsDirected,IsTrue);
- //Head.DataSize:=SizeOf(HandDataPackage);
- end;
- UdpClient.SendBuffer(toIP,toPort,HandDataPackage,SizeOf(HandDataPackage));
- Sleep(1);
- end;
- procedure TClient.P2PTestButtonClick(Sender: TObject);
- var _ToIP,_SendMsg,_ToAccount:string;
- _ToPORT:Integer;
- tempItem:TListItem;
- begin
- tempItem:=UserList.Selected;
- if (not assigned(tempItem)) or (tempItem=nil) then
- begin
- MessageBox(self.Handle ,'请选择消息接收者!','提示',0);
- exit;
- end;
- _ToAccount:=tempItem.Caption;
- _ToIp:=tempItem.SubItems[0];
- _ToPORT:=StrToInt(tempItem.SubItems[1]);
- SendHandData(_toIP,_ToPORT);
- end;
- procedure TClient.Button1Click(Sender: TObject);
- begin
- RecvEdit.Clear ;
- end;
- procedure TClient.Button2Click(Sender: TObject);
- begin
- AboutBox:= TAboutBox.Create(self);
- AboutBox.ShowModal ;
- end;
- end.