mainunit.pas

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

unit MainUnit;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, IdBaseComponent, IdSocketHandle, IdComponent,
   IdUDPBase, IdUDPServer, testQQCommon, TFlatEditUnit, TFlatButtonUnit,
  ExtCtrls, Grids, BaseGrid, AdvGrid;
type
   TServer = class(TForm)
      UDPServer: TIdUDPServer;
    SG_JL: TAdvStringGrid;
    PN_NO: TPanel;
    LB_SER: TLabel;
    BN_OK: TFlatButton;
    BN_CANL: TFlatButton;
    ED_ZH: TFlatEdit;
    BN_LOOK: TFlatButton;
    BN_SER: TFlatButton;
    BN_CF: TFlatButton;
    BN_PRN: TFlatButton;
    BN_EXCEL: TFlatButton;
    bn_dw: TFlatButton;
    BN_OTH: TFlatButton;
      procedure FormCreate(Sender: TObject);
      procedure UDPServerUDPRead(Sender: TObject; AData: TStream; ABinding: TIdSocketHandle);
      procedure StartUp;
    procedure BN_CANLClick(Sender: TObject);
   private
      { Private declarations }
   public
      { Public declarations }
      OnlineUsers: TStringList; //在线用户列表
      function ProcRecvLogonData(ThisBinding: TIdSocketHandle; LogonData: TLogonData): boolean;
      function ProcRecvLogoutData(ThisBinding: TIdSocketHandle; LogoutData: TLogoutData): boolean;
      function ProcRecvP2PData(ThisBinding: TIdSocketHandle; HandData: THandData): boolean;
   end;

var
   Server: TServer;

implementation

{$R *.dfm}

procedure TServer.FormCreate(Sender: TObject);
begin
   StartUp;
   Hide;
end;

//启动服务程序

procedure TServer.StartUp;
var
   bind: TIdSocketHandle;
begin
   try
      OnlineUsers := TStringList.create;
      UDPServer.DefaultPort := SERVER_Port;
      udpserver.Active := true;
      Memo1.Lines.Add('服务已经在 [' + IntToStr(SERVER_Port) + '] 端口启动!');
   except on E: Exception do
         Memo1.lines.add(e.Message);
   end;
end;

procedure TServer.UDPServerUDPRead(Sender: TObject; AData: TStream; ABinding: TIdSocketHandle);
var
   _UDPHead: TTQQUDPHead;
   _LogonData: TLogonData;
   _LogoutData: TLogoutData;
   _HandData: THandData;
   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
               //登录
               Adata.Read(_LogonData, sizeof(TLogonData));
               ProcRecvLogonData(Abinding, _LogonData);
            end;
         LogoutSign:
            begin
               //注销
               Adata.Read(_LogoutData, sizeof(TLogoutData));
               ProcRecvLogoutData(Abinding, _LogoutData);
            end;
         HandSign:
            begin
               //处理P2P请求
               Adata.Read(_HandData, sizeof(THandData));
               ProcRecvP2PData(Abinding, _HandData);
            end;
      end;
   except
      on E: Exception do
         Memo1.lines.add(E.Message);
   end;
end;
//登录处理

function Tserver.ProcRecvLogonData(ThisBinding: TIdSocketHandle; LogonData: TLogonData): boolean;
var
   _LogonDataPackage: TLogonDataPackage;
   _HandDataPackage: THandDataPackage;
   _FriendDataPackage: TFriendDataPackage;
   _tempUserBasicInfo: TServerUserBasicInfo;
   _Account, _PeerIP, _tempIP, _NeedReBack: string;
   i, _PeerPORT, _tempPORT: integer;
begin
   _Account := LogonData.Account;
   _PeerIP := thisbinding.PeerIP;
   _PeerPORT := thisbinding.PeerPort;
   with _LogonDataPackage do
      begin
         Head.MsgType := IntToStr(LogonSign);
         StrPCopy(Body.Account, _Account);
         StrPCopy(Body.MyPublicIP, _PeerIP);
         StrPCopy(Body.MyPublicPORT, IntToStr(_PeerPORT));
         StrPCopy(Body.lResult, IsTrue);
      end;
   //返回自己的登录信息
   UdpServer.SendBuffer(_PeerIP, _PeerPort, _LogonDataPackage, sizeof(_LogonDataPackage));
   sleep(1);
   for i := 0 to OnlineUsers.Count - 1 do
      begin
         _tempUserBasicInfo := TServerUserBasicInfo(Onlineusers.Objects[i]);
         _tempIP := _tempUserBasicInfo.UserData.IP;
         _tempPORT := StrToInt(_tempUserBasicInfo.UserData.PORT);
         with _HandDataPackage do
            begin
               Head.MsgType := IntToStr(HandSign);
               StrPCopy(Body.Account, _Account);
               StrPCopy(Body.Mark, IsTrue);
               StrPCopy(Body.DesIP, _PeerIP);
               StrPCopy(Body.DesPORT, IntToStr(_PeerPort));
               StrPCopy(Body.NeedReBack, IsTrue);
               //Head.DataSize:=SizeOf(_HandDataPackage);
            end;
         //向好友发送上线信息
         UdpServer.SendBuffer(_tempIP, _tempPORT, _HandDataPackage, SizeOf(_HandDataPackage));
         sleep(1);
         //取回此好友信息
         with _FriendDataPackage do
            begin
               Head.MsgType := IntToStr(FriendDataSign);
               StrPCopy(Body.Account, _tempUserBasicInfo.UserData.Account);
               if i = 0 then
                  begin
                     StrPCopy(Body.IsFirstOne, IsTrue);
                  end;
               StrPCopy(Body.IP, _tempUserBasicInfo.UserData.IP);
               StrPCopy(Body.PORT, _tempUserBasicInfo.UserData.PORT);
               //Head.DataSize:=SizeOf( _FriendDataPackage);
               UdpServer.SendBuffer(_PeerIP, _PeerPORT, _FriendDataPackage, SizeOf(_FriendDataPackage));
               Sleep(1);
            end;
      end;
   //注册自己的信息
   _tempUserBasicInfo := TServerUserBasicInfo.Create;
   StrPCopy(_tempUserBasicInfo.UserData.Account, _Account);
   StrPCopy(_tempUserBasicInfo.UserData.IP, _PeerIP);
   StrPCopy(_tempUserBasicInfo.UserData.PORT, IntToStr(_PeerPORT));
   Onlineusers.AddObject(_Account, _tempUserBasicInfo);
   Memo1.Lines.Add('用户:' + _Account + '[' + _PeerIP + ':' + IntToStr(_PeerPORT) + '登录上线!');
end;
//用户注销处理

function TServer.ProcRecvLogoutData(ThisBinding: TIdSocketHandle; LogoutData: TLogoutData): boolean;
var
   _Account, _tempIP, _PeerIP: string;
   i, TheTag, _tempPort, _PeerPORT: Integer;
   _tempUserBasicInfo: TServerUserBasicInfo;
   LogoutDataPackage: TLogoutDataPackage;
begin
   _Account := LogoutData.Account;
   _PeerIP := thisbinding.PeerIP;
   _PeerPORT := thisbinding.PeerPort;
   TheTag := OnlineUsers.IndexOf(_Account);
   if TheTag >= 0 then
      begin
         //删除用户在线信息
         OnlineUsers.Delete(TheTag);
         Memo1.Lines.Add('用户:' + _Account + '[' + _PeerIP + ':' + IntToStr(_PeerPORT) + '注销下线!');
         with LogoutDataPackage do
            begin
               Head.MsgType := IntToStr(LogoutSign);
               StrPCopy(Body.Account, _Account);
               StrPCopy(Body.lResult, IsTrue);
               //
            end;
         UdpServer.SendBuffer(_PeerIP, _PeerPORT, LogoutDataPackage, SizeOf(LogoutDataPackage));
         {//向好友发送下线信号
         for i:=0 to OnlineUsers.Count-1 do
         begin
            _tempUserBasicInfo:=TServerUserBasicInfo(Onlineusers.Objects[i]);
            _tempIP:=_tempUserBasicInfo.UserData.IP;
            _tempPORT:=StrToInt(_tempUserBasicInfo.UserData.PORT);
            with LogoutDataPackage do
            begin
                Head.MsgType:=IntToStr(LogoutSign);
                  StrPCopy(Body.Account,_Account);
                //
            end;
            UdpServer.SendBuffer(_tempIP,_tempPORT,LogoutDataPackage,SizeOf(LogoutDataPackage));
         end;
         }
      end;
end;
//转发处理P2P请求

function TServer.ProcRecvP2PData(ThisBinding: TIdSocketHandle; HandData: THandData): boolean;
var
   toIP, toPort: string;
   HandDataPackage: THandDataPackage;
begin
   toIP := HandData.DesIP;
   toPort := HandData.DesPORT;
   with HandDataPackage do
      begin
         Head.MsgType := IntToStr(HandSign);
         Body.Account := HandData.Account;
         Body.DesIP := HandData.DesIP;
         Body.DesPORT := HandData.DesPORT;
         Body.NeedReBack := HandData.NeedReBack;
         //Head.DataSize:=SizeOf(HandDataPackage);
      end;
   UdpServer.SendBuffer(toIP, StrToInt(toPort), HandDataPackage, SizeOf(HandDataPackage));
   Sleep(1);
end;

procedure TServer.BN_CANLClick(Sender: TObject);
begin
   Server.Close;
end;

end.