⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainunit.pas

📁 序采用网上介绍的方法实现最基本的P2P方式通讯.模拟实现即时消息互发. 2.P2P通讯说明: 1).网关类型是在理想状态下.即非对称型NAT. 2).同在一个内网的两个CLIENT端通讯时,
💻 PAS
字号:
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.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -