iggstreamclient.pas

通信控件

  procedure OnReadBufferREQ(DataREQ: PIBufferDataREQ);
  var
    IBuffer: TIBuffer;
  begin
    if Assigned(DataREQ) then
    begin
      IBuffer := FReadBuffers.Get(DataREQ.ID);
      if (IBuffer <> nil) then
      begin
        IBuffer.Read(DataREQ);
      end;
    end;
  end;

  procedure OnReadBufferCMD(BufCmd: PIBufferCmd);
  var
    IBuffer: TIBuffer;
  begin
    if Assigned(BufCmd) then
    begin
      IBuffer := FReadBuffers.Get(BufCmd.ID);
      if (IBuffer <> nil) then
      begin
        IBuffer.Command(BufCmd.Command, BufCmd.Para1, BufCmd.Para2);
      end;
    end;
  end;

  procedure OnWriteBufferCMD(BufCmd: PIBufferCmd);
  var
    IBuffer: TIBuffer;
  begin
    if Assigned(BufCmd) then
    begin
      IBuffer := FWriteBuffers.Get(BufCmd.ID);
      if (IBuffer <> nil) then
      begin
        IBuffer.Command(BufCmd.Command, BufCmd.Para1, BufCmd.Para2);
        //IBuffer.Query();
      end;
    end;
  end;

  procedure BufferPoolMsg(var PTag: TPacketTag);
  var
    PWH: PWPKHeader;
    PRec: PChar;
    PData: PChar;
  begin
    try
      if PTag.Data <> nil then
      begin
        PWH := PWPKHeader(PTag.Data);
        if FActive and (PWH.dwRecvID = FSelfID) then
        begin
          PRec := PTag.Data + PWH.SPK.wDataOffset;
          PData := PTag.Data + PWH.SPK.wPkSize;
          case PWH.SPK.wCommand of
            BUF_READREQ  : OnReadBufferREQ(PIBufferDataREQ(PRec));
            BUF_WRITESEQU: OnWriteBufferSEQU(PIBufferDataSEQU(PRec), PData);
            BUF_RECORD   : OnWrietBufferRecord(PIBufferAttr(PRec));
            BUF_WRITECMD : OnReadBufferCMD(PIBufferCmd(PRec));
            BUF_READCMD  : OnWriteBufferCMD(PIBufferCmd(PRec));
          end;      
        end;
      end;
    except end;
  end;

begin
  if (not Check) then
  begin
    BufferPoolMsg(PTag);
  end else
  begin
    CheckWritePool();
    CheckReadPool();
  end;
end;

procedure TIClient.TIBufferCallback(AttachID: DWORD; var Rec; RecSize: Integer; PData: Pointer; DataSize: WORD; Cmd: WORD);
begin
  case Cmd of
    1: Cmd := BUF_RECORD;    3: Cmd := BUF_READREQ;
    2: Cmd := BUF_WRITESEQU; 4: Cmd := BUF_WRITECMD; 5: Cmd := BUF_READCMD;
  end;
  SendBufferMsgProc(AttachID, Rec, RecSize, Cmd, 0, PData, DataSize);
end;

function TIClient.GetRoute(AttachID: DWORD): TRoute;
begin
  Result := FRoutePool.Route(AttachID);
  //if (FLoginIP <> 0) and (Route.LoginIP = FLoginIP) then
  //begin
  //  V := (FLocalIP and $00ff0000) - (Route.LocalIP and $00ff0000);
  //  if V >= 0 then
  //  begin
  //    Route.RouteIP := Route.LocalIP;
  //    Route.RoutePort := Route.LocalPort;
  //  end;
  //end;

  if (Result.RouteIP = 0) then
  begin
    Result.RouteIP   := FServerIP;
    Result.RoutePort := FServerPort;
    Result.Revert    := 0;
  end;
end;

function TIClient.Packeted(var PItem: PMessageItem; var Route: TRoute; SelBV: Integer): Pointer;
var
  P: PChar;
  PSH: PSPKHeader;
  PWH: PWPKHeader;
  DataSize: Integer;
begin
  if (SelBV = 0) then P := PktBox.FPThdBuf else P := PktBox.FPOthBuf;
  try
    DataSize := PItem.Msg.RecSize + PItem.Msg.DataSize;
    if (Route.AttachID = 0) or (Route.Revert = 2) then begin
      PSH := PSPKHeader(P);
      PSH^ := SPKHeader(PItem.MsgSequ, DataSize, PItem.Msg.CommandV, PItem.Msg.RespondV, pkSPKH);
      PSH.wReserved[0] := PItem.Msg.DataSize;
      P := P + PSH.wDataOffset;
      Move(PItem.Msg.Rec^, P^, DataSize);
      Result := PSH;
    end else begin
      PWH := PWPKHeader(P);
      PWH^ := WPKHeader(PItem.Msg.RecvID, PItem.MsgSequ, DataSize, PItem.Msg.CommandV, PItem.Msg.RespondV, Route.LoginIP, Route.LoginPort, pkWPKH);
      PWH.SPK.wReserved[0] := PItem.Msg.DataSize;
      P := P + PWH.SPK.wDataOffset;
      Move(PItem.Msg.Rec^, P^, DataSize);
      Result := PWH;
    end;
  except
    Result := nil;
  end;
end;

function TIClient.DoRoutePool(var PTag: TPacketTag; Check: Boolean): Integer;

  procedure ToServer(AttachID: Integer; selTX: TX);
  var
    PHeader: PSPKHeader;
    PData  : PToServer;
  begin
    Packet(Pointer(PHeader), Pointer(PData), ThdBuf_, SPKH_);

    PData.SelfID  := FSelfID;
    PData.Para1   := AttachID;
    PData.SubmitV := Integer(selTX);
    PHeader^ := SPKHeader(0, SizeOf(TToServer), SB_SOCK_TOS, RS_SOCK_FROMS, pkRPKH);
    FUDPServer.SendTo(PHeader, PHeader.wpkSize, FServerIP, FServerPort);
  end;

  procedure ToClient(AttachID: Integer; SubmitV: Integer);
  var
    PHeader: PSPKHeader;
    PData  : PToClient;
    Route  : TRoute;
  begin
    Packet(Pointer(PHeader), Pointer(PData), ThdBuf_, SPKH_);
    Route := GetRoute(AttachID);

    PData.AttachID := FSelfID;
    PData.Para1    := FLoginIP;
    PData.Para2    := FLoginPort;
    PData.SubmitV  := SubmitV;

    PHeader^ := SPKHeader(0, SizeOf(TToClient), SB_SOCK_TOC, RS_SOCK_FROMC, pkRPKH);
    if Route.Revert = 2 then
    begin
      FUDPServer.SendTo(PHeader, PHeader.wpkSize, Route.RouteIP, Route.RoutePort);
    end else begin
      if (Route.LoginIP = FLoginIP) and (PData.SubmitV > 2) then PData.SubmitV := 2;
      FUDPServer.SendTo(PHeader, PHeader.wpkSize, Route.LoginIP, Route.LoginPort);
      FUDPServer.SendTo(PHeader, PHeader.wpkSize, Route.LocalIP, Route.LocalPort);
      FUDPServer.SendTo(PHeader, PHeader.wpkSize, Route.RouteIP, Route.RoutePort);
    end;
  end;

  procedure FromServer(PHeader: PSPKHeader; FromIP: Integer; FromPort: Integer);
  var
    PData: PFromServer;
    Route : TRoute; Status: TRouteStatus;
  begin
    PData := PFromServer(Data(PHeader));

    try
      if PData.SubmitV = Integer(Sth) then
      begin
        //....
        FLoginIP   := PData.LoginIP;
        FLoginPort := PData.LoginPort;
        if (PData.Para = 0) then begin
          //UnRegister....
        end;  
        Exit;
      end;

      if PData.SubmitV = Integer(Stus) then
      begin
        if  PData.Para = 0 then
        begin
          if FRoutePool.GetStatus(PData.AttachID) <> rsIdle then
          begin
            DoConnectNotify(PData.AttachID, 0, 0, 0);
            FRoutePool.Cancel(PData.AttachID);
          end;
        end else begin
          //....
        end;
        Exit;
      end;

      FillChar(Route, SizeOf(Route), 0);
      if (PData.LoginIP <> 0) and (PData.AttachID <> FSelfID) then  begin
        Route.AttachID  := PData.AttachID;
        Route.LoginIP   := PData.LoginIP;
        Route.LoginPort := PData.LoginPort;
        Route.LocalIP   := PData.LocalIP;
        Route.LocalPort := PData.LocalPort;
        Status := FRoutePool.GetStatus(PData.AttachID);
        FRoutePool.Put(PData.AttachID, Route);
        FRoutePool.SetStatus(PData.AttachID, rsHeart);
        ToClient(PData.AttachID, 4);
        if (Status = rsWait) then
          //DoConnectNotify(PData.AttachID, 1, PData.LoginIP, PData.LoginPort);
      end;
    except  end;
  end;

  procedure FromClient(PHeader: PSPKHeader; FromIP: Integer; FromPort: Integer);
  var
    PData : PToClient;
    Route : TRoute; Status: TRouteStatus;
  begin
    PData := PToClient(Data(PHeader));
    FillChar(Route, SizeOf(Route), 0);
    
    if FRoutePool.Get(Route, PData.AttachID) = rsIdle then
    begin
      ToServer(PData.AttachID, AgbSsa);
    end else
    begin
      if (FromIP = FServerIP) and (FromIP <> FLoginIP) and (FromIP <> FLocalIP) then  FromIP := 0;
      FRoutePool.UpdateRoute(PData.AttachID, FromIP, FromPort);
      FRoutePool.SetStatus(PData.AttachID, rsHeart);

      if Route.Revert = 0 then
        DoConnectNotify(PData.AttachID, 1, FromIP, FromPort);

      if PData.SubmitV > 0 then
      begin
        ToClient(PData.AttachID, PData.SubmitV-1);
      end;
    end;
  end;

  function RoutePoolMessage(var PTag: TPacketTag): Integer;
  var
    PHeader: PSPKHeader;
    IP, Port: Integer;
  begin
    Result := 0;
    try
      if Assigned(PTag.Data) then
      begin
        IP := PTag.SockAddr.sin_addr.S_addr;  Port := PTag.SockAddr.sin_port;
        PHeader := PSPKHeader(PTag.Data);

        case PHeader.wCommand of
          RS_SOCK_FROMS:
            FromServer(PHeader, IP, Port);
          SB_SOCK_TOC:
            FromClient(PHeader, IP, Port);
        end;
        PTag.DataSize := 0;
      end;
    except  end;
  end;

  function CheckRoutePool(): Integer;
  var
    PItemX: PRouteItemX;
    Index: Integer;
  begin
    PItemX := nil;  Index := 0;  Result := 0;
    try
      while FActive do
      begin
        if (FInteSec mod ROUTE_HEART_SEC) = 0 then
        begin
          ToServer(0, Hts);
        end;
        Inc(FInteSec);

        PItemX := FRoutePool.IndexByNextX(Index, PItemX);

        if (Index = -1) then Break;
        if (PItemX = nil) or ((PItemX <> nil) and (PItemX.Status = rsIdle)) then Continue;

        if (PItemX.Item.LifeSec <= 0) then
            PItemX.Status := rsOvertime;

        case PItemX.Status of
          rsWait:begin
            if (PItemX.Item.LifeSec mod ROUTE_INTE_SEC = 0) then
              ToServer(PItemX.Item.Route.AttachID, AgbSsa);
          end;
          rsHeart:begin
            if (PItemX.Item.LifeSec mod ROUTE_HEART_SEC = 0) then
              ToClient(PItemX.Item.Route.AttachID, 0);
          end;
          rsOvertime:
            FRoutePool.Cancel(PItemX.Item.Route.AttachID);
        end;
        if PItemX.Item.LifeSec > 0 then
          Dec(PItemX.Item.LifeSec);
      end;
    except
      Result := -1;
    end;
  end;

begin
  if not Check then
    Result := RoutePoolMessage(PTag)
  else
    Result := CheckRoutePool();
end;

function TIClient.DoMsgPool(var PTag: TPacketTag; Check: Boolean): Integer;

  function MsgPoolMessage(const PTag: TPacketTag): Integer;

    procedure RespondSequ(PWH: PWPKHeader; IP: Integer; Port: Word);
    var
      PWSequ: PWPKHeader;
    begin
      PWSequ := PWPKHeader(PktBox.FPThdBuf);
      PWSequ^ := WPKHeader(PWH.SPK.dwSendID, PWH.SPK.wSequ, 0, RS_SOCK_SEQU, 0, IP, Port);
      Result := FUDPServer.SendTo(PWSequ, PWSequ.SPK.wpkSize, IP, Port);
    end;

  var
    PData: Pointer;
    PWH: PWPKHeader;
    PV: PChar;
    IP, Port, L1, L2: Integer;
    Rs: Boolean;
  begin
    Result := 0;
    PWH    := PWPKHeader(PTag.Data);
    Rs     := PWH.SPK.wCommand <> RS_SOCK_SEQU;
    IP     := PTag.SockAddr.sin_addr.S_addr;  Port := PTag.SockAddr.sin_port;

    if (Rs) then
    begin
      if not ((IP = FServerIP) and (Port = FServerPort)) then
        RespondSequ(PWH, IP, Port);

      if (PWH.SPK.dwSendID = 0) or (not FRecvSequ.IsExist(PWH.SPK.dwSendID, PWH.SPK.wSequ)) then
      begin
        PData := Data(PWH);
        //if Assigned(FOnRecvMessage) then
        begin
          L1 := PWH.SPK.wPkSize-(PWH.SPK.wDataOffset+PWH.SPK.wReserved[0]);
          L2 := PWH.SPK.wReserved[0];
          PV := PChar(PData) + (L1);

          //FOnRecvMessage(Self, PData, L1, PV, L2, PWH.SPK.wCommand, PWH.SPK.wRespond);
        end;
      end;
    end else begin
      Rs := (IP <> FServerIP) or ((IP = FServerIP) and (PWH.dwIP <> 0));
      if Rs then
        FMsgPool.SetStatus(PWH.SPK.wSequ, msSendSucc)
      else
        FMsgPool.SetStatus(PWH.SPK.wSequ, msRouteFail);
    end;
  end;

  procedure CheckInBlock();
  var
    I: Integer;
    PItem: PInItem;
    DesRoute: TRoute;
  begin
    if FActive and (FInPool.Count > 0) then
    begin
      for I := 0 to MAX_BLOCK_POOL-1 do begin
        PItem := FInPool.IndexValid(I);
        if (PItem <> nil) and (PItem.Status <> bsIdle) then
        begin
          case PItem.Status of
            bsWait, bsIn: begin
              if (PItem.LifeSecond > 0) and (PItem.LifeSecond mod BLOCK_INTE_SEC = 0) then
              begin
                DesRoute := GetRoute(PItem.OutAttachID);
                AroundDealInBlock(PItem, DesRoute.RouteIP, DesRoute.RoutePort);
              end else if (PItem.LifeSecond <= 0) then
                PItem.Status := bsOvertime;
            end;
            bsComplete:;
              //FInPool.Cancel(PItem.Block.InID);
            bsOvertime:
              FInPool.Cancel(PItem.Block.InID);
          end;
          Dec(PItem.LifeSecond);
        end;
      end;
    end;
  end;
  
  function CheckMsgPool(): Integer;
  var
    PMsgItem: PMessageItem;
    POut: POutItem;
    DesRoute: TRoute;
    Index, ExcIndex: Integer;
  begin
    if FMsgPool = nil then Exit;
    PMsgItem := nil;  Index := 0;  Result := 0;
    ExcIndex := (FMsgPool.Sequ) mod MAX_MESSAGE_POOL;
    Index := ExcIndex;

    try
      while (FMsgPool <> nil) do begin
        PMsgItem := FMsgPool.IndexVaild(Index, ExcIndex);        
        if ((PMsgItem = nil)) then break;
        case PMsgItem.Status of
          msSend:
          begin
            if (PMsgItem.LifeSecond > 0) and (PMsgItem.LifeSecond mod MESSAGE_SEND_RTY = 0) then begin
              Send(PMsgItem.Msg.RecvID, PMsgItem.MsgSequ);
            end else if (PMsgItem.LifeSecond = 1) then
              PMsgItem.Status := msOvertime;
            Dec(PMsgItem.LifeSecond);
          end;
          msWaitBlock:
          begin
            if (PMsgItem.LifeSecond > 0) and (PMsgItem.LifeSecond mod (BLOCK_INTE_SEC) = 0) then begin
              POut := FOutPool.Find(PMsgItem.Msg.OutID);