mainunit.pas

以前写的一个利用P2P 技术的一个通讯的例子。里面用到了 DBISAM 、INDY 控件。

unit MainUnit;
{
   P2P方式模拟QQ即时消息通讯
   [e-mail]
应考虑问题:
    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;
      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
{$R *.dfm}

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
                  begin
                     Listened := false;
                     break;
                  end;
            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;


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;
   //登录成功