u_web_main.pas

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

unit U_WEB_MAIN;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, IdBaseComponent, IdSocketHandle, IdComponent,
   IdUDPBase, IdUDPServer, p2p_public, TFlatEditUnit, TFlatButtonUnit,
   ExtCtrls, Grids, BaseGrid, AdvGrid;
type
   TF_WEB_MAIN = class(TForm)
      UDPServer: TIdUDPServer;
      SG_JL: TAdvStringGrid;
      PN_NO: TPanel;
      BN_OK: TFlatButton;
      BN_CANL: TFlatButton;
      BN_LOOK: TFlatButton;
      BN_SER: TFlatButton;
      BN_CF: TFlatButton;
      BN_PRN: TFlatButton;
      BN_EXCEL: TFlatButton;
      procedure FormCreate(Sender: TObject);
      procedure UDPServerUDPRead(Sender: TObject; AData: TStream; ABinding: TIdSocketHandle);
      procedure StartUp;
      procedure BN_CANLClick(Sender: TObject);
      procedure SG_JLGetAlignment(Sender: TObject; ARow, ACol: Integer;
         var HAlign: TAlignment; var VAlign: TVAlignment);
   private
      { Private declarations }
      function Check_logon(m_accno, m_pwd, m_PeerIP, m_PeerPORT: string): integer;
   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
   F_WEB_MAIN: TF_WEB_MAIN;

implementation
uses pub_program, u_web_dm;
var
   arow: integer;
   {$R *.dfm}

procedure TF_WEB_MAIN.FormCreate(Sender: TObject);
var
   s: string;
begin
   s := '用户情况*120*';
   bold_sg(sg_jl);
   title_sg_wy(sg_jl, s, false);
   StartUp;
   Hide;
end;

//检查帐号、密码的合法性

function TF_WEB_MAIN.Check_logon(m_accno, m_pwd, m_PeerIP, m_PeerPORT: string): integer;
var
   s: string;
begin
   //-1  :  程序异常
   // 0  :  帐号密码正确
   // 1  :  帐号不存在
   // 2  :  密码错误
   result := -1;
   with f_web_dm.sp_chkpwd_wangy do
      begin
         close;
         parambyname('@vaccno').asstring := uppercase_wy(m_accno);
         parambyname('@vpwd').asstring := m_pwd;
         parambyname('@vipaddr').asstring := m_PeerIP;
         parambyname('@vport').asstring := m_PeerPORT;
         execproc;
         result := parambyname('@vflag').asinteger;
         close;
      end;
end;

//启动服务程序

procedure TF_WEB_MAIN.StartUp;
var
   bind: TIdSocketHandle;
begin
   try
      OnlineUsers := TStringList.create;
      UDPServer.DefaultPort := SERVER_Port;
      udpserver.Active := true;
      with sg_jl do
         begin
            str_grid_wy(sg_jl, arow);
            cells[0, arow] := '服务已经在 [' + IntToStr(SERVER_Port) + '] 端口启动!';
         end;
   except
      on E: Exception do
         with sg_jl do
            begin
               str_grid_wy(sg_jl, arow);
               cells[0, arow] := e.Message;
            end;
   end;
end;

procedure TF_WEB_MAIN.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
         with sg_jl do
            begin
               str_grid_wy(sg_jl, arow);
               cells[0, arow] := e.Message;
            end;
   end;
end;
//登录处理

function TF_WEB_MAIN.ProcRecvLogonData(ThisBinding: TIdSocketHandle; LogonData: TLogonData): boolean;
var
   _LogonDataPackage: TLogonDataPackage;
   _HandDataPackage: THandDataPackage;
   _FriendDataPackage: TFriendDataPackage;
   _tempUserBasicInfo: TServerUserBasicInfo;
   _Account, _Pwd, _PeerIP, _tempIP, _NeedReBack: string;
   i, _PeerPORT, _tempPORT: integer;
begin
   _Account := LogonData.Account;
   _Pwd := LogonData.Pwd;
   _PeerIP := thisbinding.PeerIP;
   _PeerPORT := thisbinding.PeerPort;
   with _LogonDataPackage do
      begin
         Head.MsgType := IntToStr(LogonSign);
         StrPCopy(Body.Account, _Account);
         StrPCopy(Body.Pwd, _Pwd);
         StrPCopy(Body.MyPublicIP, _PeerIP);
         StrPCopy(Body.MyPublicPORT, IntToStr(_PeerPORT));
         //StrPCopy(Body.lResult, IsTrue);
         i := check_logon(_Account, _Pwd, _PeerIP, IntToStr(_PeerPORT));
         StrPCopy(Body.lResult, inttostr(i));
      end;

   //返回自己的登录信息
   UdpServer.SendBuffer(_PeerIP, _PeerPort, _LogonDataPackage, sizeof(_LogonDataPackage));
   sleep(1);
   case i of
      0: ;
      else //帐号或密码不对，不做进一步处理
         exit;
   end;

   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);
   with sg_jl do
      begin
         str_grid_wy(sg_jl, arow);
         cells[0, arow] := '用户:  ' + _Account + '  [' + _PeerIP + ' : ' + IntToStr(_PeerPORT) + ']  登录上线!';
      end;
   //Memo1.Lines.Add('用户:' + _Account + '[' + _PeerIP + ':' + IntToStr(_PeerPORT) + '登录上线!');
end;
//用户注销处理

function TF_WEB_MAIN.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);
         with sg_jl do
            begin
               str_grid_wy(sg_jl, arow);
               cells[0, arow] := '用户:  ' + _Account + '  [' + _PeerIP + ' : ' + IntToStr(_PeerPORT) + ']  注销下线!';
            end;
         //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 TF_WEB_MAIN.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 TF_WEB_MAIN.BN_CANLClick(Sender: TObject);
begin
   Close;
end;

procedure TF_WEB_MAIN.SG_JLGetAlignment(Sender: TObject; ARow,
   ACol: Integer; var HAlign: TAlignment; var VAlign: TVAlignment);
begin
   case arow of
      0: HAlign := tacenter;
   end;
end;

end.