iggclientpool.pas

通信控件

    //GetMem(Item.Block.Data, DataSize);
    if (Item.Block.DataSize <= 1024*32) then
      Result := Put(Item);
  except
  end;
end;
function TGGInPool.Find(const BlockID: Integer): PInItem;
begin
  FLock.Enter;
  try
    Result := CheckValid(BlockID);
  finally
    FLock.Leave;
  end;
end;
function TGGInPool.Get(var Item: TInItem; const BlockID: Integer): Boolean;
var
  PItem: PInItem;
begin
  PItem := Find(BlockID);
  Result := PItem <> nil;
  if (Result) then begin
    Item := PItem^;
  end;
end;
function TGGInPool.IndexByDynamic(var Index: Integer): PInItem;
begin
  FLock.Enter;
  try
    repeat
      Result := IndexValid(Index);
      if (Index = -1) then break;
      Inc(Index);
      if (Result = nil) then Continue;
    until((Result <> nil) and (Result^.Status <> bsIdle));
  finally
    FLock.Leave;
  end;
end;
function TGGInPool.SetStatus(const BlockID: Integer; const Status: TBlockStatus=bsIdle): Boolean;
var
  PItem: PInItem;
begin
  FLock.Enter;
  try
    PItem := CheckValid(BlockID);
    Result := PItem <> nil;
    if (Result) then begin
      PItem^.Status := Status;
    end;
  finally
    FLock.Leave;
  end;
end;
function TGGInPool.GetStatus(const BlockID: Integer): TBlockStatus;
var
  PItem: PInItem;
begin
  FLock.Enter;
  Result := bsEmpty;
  try
    PItem := CheckValid(BlockID);
    if (PItem <> nil) then begin
      Result := PItem^.Status;
    end;
  finally
    FLock.Leave;
  end;
end;

/////////////////////////////////////////////////////////////////////////////
 { TGGMessagePool }

constructor TGGMessagePool.Create;
begin
  FLock := TCriticalSection.Create;
  Init();
end;

destructor TGGMessagePool.Destroy;
begin
  Clear();
  FLock.Free;
end;

procedure TGGMessagePool.Init;
var
  I: Integer;
begin
  FLock.Enter;
  try
    FillChar(FList, SizeOf(FList), 0);
    for I := 0 to MAX_MESSAGE_POOL-1 do begin
      New(FList[I]);
      FillChar(FList[I]^, SizeOf(TMessageItem), 0);
      ResetItem(FList[I]);
    end;
    FCount := 0;  FSequ := 0;  FMsgs := 0; FEnable := TRUE;
  finally
    FLock.Leave;
  end;
end;

procedure TGGMessagePool.Clear;
var
  I: Integer;
begin
  FLock.Enter;
  try
    for I := 0 to MAX_MESSAGE_POOL-1 do begin
      ResetItem(FList[I]);
      Dispose(FList[I]);
    end;
    FCount := 0;  FSequ := 0;  FMsgs := 0;  FEnable := FALSE;
  finally
    FLock.Leave;
  end;
end;

procedure TGGMessagePool.FreeMsg(var Msg: TMessage);
begin
  try
    try
      if (Msg.Rec <> nil) and Assigned(Msg.Rec) then
        FreeMem(Msg.Rec);
    except
      //Msg.Describe := nil;
      //Msg.Data := nil;
    end;
  finally
    FillChar(Msg, SizeOf(Msg), 0);
  end;
end;

procedure TGGMessagePool.ResetItem(var PItem: PMessageItem);
begin
  FreeMsg(PItem.Msg);
  PItem^.MsgSequ := 0;
  PItem^.Retry := 0;
  PItem^.LifeSecond := 0;
  PItem^.Status := msIdle;
end;

function TGGMessagePool.Put(var Item: TMessageItem): Integer;
var
  I: Integer;
begin
  Result := 0;
  FLock.Enter;
  try
    Inc(FSequ);
    if FSequ = 0 then Inc(FSequ);
    Item.MsgSequ := FSequ;
    I := FSequ mod MAX_MESSAGE_POOL;
    FList[I]^ := Item;
    Inc(FCount);
    Result := FSequ;
  finally
    FLock.Leave;
  end;
end;

function TGGMessagePool.Put(var Msg: TMessage): Integer;
var
  Item: TMessageItem;
begin
  FillChar(Item, SizeOf(Item), 0);
  Item.Msg := Msg;
  if msg.Reserved = 1 then
    Item.LifeSecond := BLOCK_LIFE_SEC
  else
    Item.LifeSecond := MESSAGE_LIFE_SEC;
  Item.MsgSequ := 0;
  Item.Retry := MESSAGE_SEND_RTY;
  Item.Status := msSend;
  Result := Put(Item);
end;

function TGGMessagePool.Put(RecvID: Integer; CommandV: Word; RespondV: Word; var Rec; RecSize: Integer;
  Data: PChar; DataSize: Integer; Rule: Integer): Integer;
var
  Msg: TMessage;
  s: Integer;
begin
  Result := 0;
  FillChar(Msg, SizeOf(Msg), 0);
  try
    if ((Data = nil) or Assigned(Data)) then
    begin
      Msg.RecvID := RecvID;  s := 0;
      if (RecSize + DataSize) > MAX_DESCRIBE_SIZE then s := 32;
      Msg.Rec := AllocMem(RecSize+DataSize+s+4);
      Move(Rec, (Msg.Rec+s)^, RecSize);
      Msg.RecSize := RecSize;
      if (Data <> nil) and (DataSize > 0) then
      begin
        Msg.Data := Msg.Rec+RecSize+s;
        Move(Data^, Msg.Data^, DataSize);
        Msg.DataSize := DataSize;
      end;
      Msg.CommandV := CommandV;
      Msg.RespondV := RespondV;
      Msg.Rule := Rule;
      if s > 0 then Msg.Reserved := 1;
      Result := Put(Msg);
    end;
  except;
    Result := -1;
  end;
end;

function TGGMessagePool.IndexVaild(var Index: Integer; ExcIndex: Integer): PMessageItem;
begin
  Result := nil;
  FLock.Enter;
  try
    if (FCount = 0) then Exit;
    try
      repeat
        Result := FList[Index];
        Inc(Index);
        Index := Index mod MAX_MESSAGE_POOL;
        if (Index = ExcIndex) then Break;
        if (Result = nil) then Continue;
      until (Result^.Status <> msIdle) and (Result^.LifeSecond >= 0);
    except
      Result := nil;
    end;
  finally
    FLock.Leave;
  end;
end;

function TGGMessagePool.Remove(Sequ: Integer): Boolean;
var
  PItem: PMessageItem;
begin
  FLock.Enter;
  try
    PItem := Find(Sequ);
    Result := PItem <> nil;
    if (Result) then begin
      ResetItem(PItem);
      Dec(FCount);
    end;
  finally
    FLock.Leave;
  end;
end;

function TGGMessagePool.Find(Sequ: Word): PMessageItem;
var
  I: Integer;
begin
  Result := nil;
  try
    if (Sequ <= FSequ) and (Sequ>FSequ-MAX_MESSAGE_POOL) then begin
      I := Sequ mod MAX_MESSAGE_POOL;
      Result := FList[I];
      if Result.MsgSequ <> Sequ then begin
        ResetItem(Result);
        Result := nil;
      end;
    end;
  except
    Result := nil;
  end;
end;

function TGGMessagePool.SendCheck(const PItem: PMessageItem): Boolean;
begin
  Result := FALSE;
  try
    if (PItem <> nil) and Assigned(PItem) then
    begin
      try
        Result :=  Assigned(PItem.Msg.Rec) and ((PItem.Msg.Data = nil) or Assigned(PItem.Msg.Data));
        if (Result) then
          Result := (PItem.Msg.RecSize > 0) and (PItem.Status = msSend) and ((PItem.Retry > 0) and (PItem.Retry < MESSAGE_SEND_RTY+1));
      except
        Result := FALSE;
      end;
    end;
  except
  end;
end;

function TGGMessagePool.SendOrd(Sequ: Integer; RecvID: Integer; CommandV: Word; Rule: Word): Integer;
var
  I: Integer;
  PItem: PMessageItem;
begin  //need mod: for ...
  Result := 0;
  Rule := Rule and $0F0;
  //FLock.Enter;
  I := (FSequ + 1) mod MAX_MESSAGE_POOL;
  try
    for I := I to MAX_MESSAGE_POOL-1 do
    begin
      if (PItem^.MsgSequ = Sequ) then Break;
      PItem := FList[I];
      if (PItem^.Msg.RecvID = RecvID) and
         ((PItem^.Status = msSend) or (PItem^.Status = msWaitBlock)) and
         (PItem^.Msg.CommandV = CommandV) and ((PItem^.Msg.Rule and Rule) = Rule) then
        Inc(Result);
    end;
  finally
    //FLock.Leave;
  end;
end;

function TGGMessagePool.SendGet(var PItem: PMessageItem; Sequ: Word; CutRetry: Word): Boolean;
begin
  Result := FALSE;
  FLock.Enter;
  try
    PItem := Find(Sequ);
    Result := (PItem <> nil) and SendCheck(PItem);
    if Result {and (SendOrd(PItem^.MsgSequ, PItem^.Msg.RecvID, PItem^.Msg.CommandV, PItem^.Msg.Rule) > 0)} then
    begin
      Dec(PItem^.Retry, CutRetry);
    end;
  finally
    FLock.Leave;
  end;
end;

function TGGMessagePool.SetStatus(Sequ: Word; Status: TMsgStatus): Boolean;
var
  PItem: PMessageItem;
begin
  Result := FALSE;
  FLock.Enter;
  try
    PItem := Find(Sequ);
    Result := PItem <> nil;
    if Result then
      PItem.Status := Status;
  finally
    FLock.Leave;
  end;
end;

function TGGMessagePool.GetStatus(Sequ: Word): TMsgStatus;
var
  PItem: PMessageItem;
begin
  Result := msEmpty;
  FLock.Enter;
  try
    PItem := Find(Sequ);
    if PItem <> nil then
      Result := PItem.Status;
  finally
    FLock.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
  { TGGRecvSequ }

constructor TGGRecvSEQU.Create;
begin
  Init;
end;

destructor TGGRecvSEQU.Destroy;
begin
end;

procedure TGGRecvSEQU.Init;
begin
  FillChar(FTags, SizeOf(FTags), 0);
  FFirst := 0;  FLast := 0;
end;

procedure TGGRecvSEQU.Put(SendID: DWord; SendSequ: Word; LifeHeart: Word);
begin
  FTags[FLast].SendID := SendID;
  FTags[FLast].SendSequ := SendSequ;
  FTags[FLast].LifeHeart := LifeHeart;
  FLast := (FLast + 1) mod MAX_RECV_SEQU;
  if (FFirst = FLast) then begin
    FTags[FFirst].LifeHeart := 0;
    FFirst := (FFirst + 1) mod MAX_RECV_SEQU;
  end;
end;

function TGGRecvSEQU.IsExist(SendID: DWord; SendSequ: Word; CutHeart: Word): Boolean;
var
  I: Integer;
begin
  Result := FALSE;
  I := FFirst;
  while(I <> FLast) do
  begin
    if (FTags[I].SendID = SendID) and (FTags[I].SendSequ = SendSequ) then
    begin
      Dec(FTags[I].LifeHeart, CutHeart);
      Result := TRUE; Break;
    end;
    Inc(I);
    I := I mod MAX_RECV_SEQU;
  end;
  if (not Result) then
    Put(SendID, SendSequ);
end;

procedure TGGRecvSEQU.Check(CutHeart: Word);
var
  I: Integer;
begin
  I := FFirst;
  while(I <> FLast) do
  begin
    if (FTags[I].LifeHeart <= 0) then
    begin
      FTags[I] := FTags[FLast];
      FTags[FLast].LifeHeart := 0;
      FLast := (MAX_RECV_SEQU+FLast-1) mod MAX_RECV_SEQU;
    end else begin
      Dec(FTags[I].LifeHeart, CutHeart);
      Inc(I);
      I := I mod MAX_RECV_SEQU;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
 { TRoutePool }

constructor TIRoutePool.Create;
begin
  inherited;
  FLock := TCriticalSection.Create;
  Init();
end;

destructor TIRoutePool.Destroy;
begin
  FActiveRoute := FALSE;
  Clear;
  FLock.Free;
  inherited Destroy;
end;

procedure TIRoutePool.Init;
var
  PItemX: PRouteItemX;
  I: Integer;
  Ok: Boolean;
begin
  FLock.Enter;
  FActiveRoute := FALSE;
  FCount := 0;
  FCurPItem := nil;
  FIntervalSec := 0;
  Ok := TRUE;
  try
    for I := 0 to MAX_ROUTE_POOL-1 do begin
      try
        New(PItemX);
        FillChar(PItemX^, SizeOf(TRouteItemX), 0);
        if Assigned(PItemX) then
          ResetX(PItemX);
        FList[I] := PItemX;
      except
        Ok := FALSE;
      end;
    end;
  finally
    if (Ok) then FActiveRoute := TRUE;
    FLock.Leave;
  end;
end;

procedure TIRoutePool.Clear;
var
  PItemX: PRouteItemX;
  I: Integer;
begin
  FLock.Enter;
  try
    for I := 0 to MAX_ROUTE_POOL-1 do begin
      PItemX := FList[I];
      while(PItemX <> nil) do begin
        PItemX := FreeX(PItemX);
      end;
      FList[I] := nil;
    end;            
  finally
    FCurPItem := nil;
    FCount := 0;
    FLock.Leave;
  end;
end;

function TIRoutePool.GetIntervalSec: Integer;
begin
  Inc(FIntervalSec);
  Result := FIntervalSec;
end;

procedure TIRoutePool.Reset(var Item: TRouteItem);
begin
  try
    FillChar(Item, SizeOf(TRouteItem), 0);
    Item.AttathIDmod := -1;
  except
  end;
end;

procedure TIRoutePool.ResetX(var PItemX: PRouteItemX);
begin
  try
    if Assigned(PItemX) then begin
      FillChar(PItemX^, SizeOf(TRouteItemX), 0);
      Reset(PItemX.Item);
      PItemX.Status := rsIdle;
      PItemX.Next := nil;
    end;
  except
  end;
end;

function TIRoutePool.FreeX(var PItemX: PRouteItemX): PRouteItemX;
begin
  Result := nil;
  try