u_web_dm.pas

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

unit U_WEB_DM;

interface

uses
   SysUtils, Classes, DB, dbisamtb, p2p_public, IdUDPBase, IdUDPClient, IdBaseComponent,
   IdComponent, IdTCPConnection, IdTCPClient, IdUDPServer, IdSocketHandle,
   DBTables;

type
   TF_WEB_DM = class(TDataModule)
      db_webmis: TDBISAMDatabase;
      qy_wangy_dbi: TDBISAMQuery;
      ID_TCP: TIdTCPClient;
      ID_UDP: TIdUDPServer;
      WEBDB: TDatabase;
      qy_wangy: TQuery;
      function save_myip(m_accno, m_ipaddr, m_port: string): boolean;
      procedure ID_UDPUDPRead(Sender: TObject; AData: TStream;
         ABinding: TIdSocketHandle);
   private
      { Private declarations }
      function ProcRecvLogonData(ThisBinding: TIdSocketHandle; LogonData: TLogonData): boolean;
      function ProcRecvChatMsgData(ThisBinding: TIdSocketHandle; ChatData: TChatData): boolean;
      //function ProcRecvFriendData(ThisBinding: TIdSocketHandle; UserData: TUserData): Boolean;
   public
      { Public declarations }
      function CallLogout(): Boolean;
   end;

var
   F_WEB_DM: TF_WEB_DM;

implementation
uses pub_program, u_web_main, U_WEB_XTDL, U_WEB_CHAT;

{$R *.dfm}

function TF_WEB_DM.save_myip(m_accno, m_ipaddr, m_port: string): boolean;
var
   s: string;
   i: integer;
begin
   with qy_wangy do
      begin
         close;
         sql.Clear;
         sql.Add('select flag from userdb where accno=:vaccno');
         parambyname('vaccno').asstring := m_accno;
         open;
         i := fieldbyname('flag').asinteger;
         close;
         sql.Clear;
         sql.Add('insert into userip(accno,flag,ipaddr,port,date) values(:vaccno,:vflag,:vipaddr,:vport,:vdate)');
         parambyname('vaccno').asstring := m_accno;
         parambyname('vflag').asinteger := i;
         parambyname('vipaddr').asstring := m_ipaddr;
         parambyname('vport').asstring := m_port;
         parambyname('vdate').asdatetime := now;
         execsql;
         close;
      end;
end;

function TF_WEB_DM.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;

   Gstr_SerIP := _PeerIP;
   Gint_SerPORT := _PeerPORT;
   gstr_MyIP := LogonData.MyPublicIP;
   Gint_MyPort := StrToInt(LogonData.MyPublicPORT);
   gstr_MyAcc := LogonData.Account;

   tran_str := 'result:' + getstr(_IsLogin, '-1') + '*';
   //登录后，要先清一下本地的无用IP
   with qy_wangy do
      begin
         close;
         sql.Clear;
         sql.Add('delete from userip where accno=:vaccno');
         parambyname('vaccno').asstring := gstr_MyAcc;
         execsql;
         close;
      end;

   save_myip(gstr_MyAcc, gstr_MyIP, inttostr(Gint_MyPort));

   case g_mshow of
      0: f_web_xtdl.showmain;
      1: ;
      else
         ;
   end;
end;

function TF_WEB_DM.CallLogout(): Boolean;
var
   LogoutDataPackage: TLogoutDataPackage;
   i, _ToPORT: integer;
   _toIP: string;
begin
   with LogoutDataPackage do
      begin
         Head.MsgType := IntToStr(LogoutSign);
         StrPCopy(Body.Account, gstr_MyAcc);
         StrPCopy(Body.lResult, '');
      end;
   f_web_dm.id_Udp.SendBuffer(gstr_SerIP, gint_SerPort, 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, gstr_MyAcc);
               StrPCopy(Body.lResult, '');
               //
            end;
         UdpClient.SendBuffer(_toIP, _toPORT, LogoutDataPackage, SizeOf(LogoutDataPackage));
         Sleep(1);
      end;}
end;

procedure TF_WEB_DM.ID_UDPUDPRead(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));
               f_web_main.ProcRecvLogoutData(Abinding, _LogoutData);
            end;
         FriendDataSign:
            begin
               //收到好友列表信息
               Adata.Read(_UserData, sizeof(TUserData));
               f_web_main.ProcRecvFriendData(Abinding, _UserData);
            end;
         HandSign:
            begin
               //处理P2P请求
               Adata.Read(_HandData, sizeof(THandData));
               f_web_main.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 TF_WEB_DM.ProcRecvChatMsgData(ThisBinding: TIdSocketHandle; ChatData: TChatData): boolean;
var
   ChatDataPackage: TChatDataPackage;
   m_fromAcc, m_Msg: string;
begin
   m_fromAcc := ChatData.fromAccount;
   m_Msg := ChatData.Msg;

   case gint_chatfrm of
      frm_web_other: exit;
      frm_web_chat: f_web_chat.deal_chat(ChatData);
   end;

   {if ChatData.IsNeedReBack = IsTrue then
   begin
      with ChatDataPackage do
         begin
            Head.MsgType := IntToStr(ChatMsgSign);
            StrPCopy(Body.fromAccount, gstr_MyAcc);
            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;

end.