iggclientpool.pas

通信控件

  try
    if (FCount <= 0) then Exit;

    for I := 0 to MAX_BLOCK_POOL-1 do begin
      PItem := IndexValid(I);
      if (PItem <> nil) then begin
        try
          //if FreeData and Assigned(PItem^.Block.Data) then
          //  FreeMem(PItem^.Block.Data);
        except
          PItem^.Block.Data := nil;
        end;
        try
          //if Assigned(PItem^.Block.Packet) then
          //  FreeMem(PItem^.Block.Packet);
        except
          PItem^.Block.Packet := nil;
        end;
        Dispose(PItem);
      end;
      FList[I] := nil;
    end;
  finally
    FCount := 0;
    FEnable := FALSE;
    FLock.Leave;
  end;
end;

procedure TGGOutPool.Reset(var Item: TOutItem);
begin
  try
    try
      if (Item.Block.FreeData=1) and (Item.Block.Packet <> nil) and Assigned(Item.Block.Packet) then
        FreeMem(Item.Block.Packet);
    except end;
  finally
    FillChar(Item, SizeOf(TOutItem), 0);
    Item.Status := bsIdle;
  end;  
end;

function TGGOutPool.GetIdle: Integer;
var
  I,IPool: Integer;
begin
  Result := 0;
  I := 0;
  while (TRUE) do
  begin
    Inc(FBlockID); if (FBlockID <= 0) then FBlockID := 1;
    IPool := FBlockID mod MAX_BLOCK_POOL;
    if (FList[IPool].Status = bsIdle) and (I < MAX_BLOCK_POOL-1) then
    begin
      Result := FBlockID; Break;
    end;
    Inc(I);
  end;
end;

function TGGOutPool.Rescue(Index: Integer): POutItem;
begin
  Result := nil;
  if (Index > 0) and (Index < (MAX_BLOCK_POOL-1)) then
  begin
    FList[Index] := nil;
    try
      New(Result);
      if (Result <> nil) then begin
        FillChar(Result^, SizeOf(TOutItem), 0);
        Reset(Result^);
        FList[Index] := Result;
      end;
    except
      Result := nil;
    end;
  end;
end;

function TGGOutPool.IndexValid(Index: Integer): POutItem;
var
  ValidID: Boolean;
begin
  Result := nil;
  ValidID := (Index >= 0) and (Index < MAX_BLOCK_POOL);
  if (ValidID) then begin
    try
      Result := FList[Index];
      if not Assigned(Result) then
        Result := nil;
    except
      Rescue(Index);
      Result := nil;
    end;
  end;
end;

function TGGOutPool.CheckValid(BlockID: Integer): POutItem;
var
  I: Integer;
  ValidID: Boolean;
begin
  Result := nil;
  ValidID := (BlockID > 0) and (BlockID <= FBlockID);
  if (ValidID) then begin
    I := BlockID mod MAX_BLOCK_POOL;
    try
      Result := FList[I];
      if Assigned(Result) then begin
        ValidID := Result^.Block.OutID = BlockID;
        if not ValidID then
          Result := nil;
      end;
    except
      Rescue(I);
      Result := nil;
    end;
  end;
end;

function TGGOutPool.CheckValid(OutID: Integer; InID: Integer): POutItem;
begin
  Result := CheckValid(OutID);
  if (Result <> nil) then begin
    if (Result.Block.InID <> InID) then
      Result := nil;
  end;
end;

function TGGOutPool.Exist(BlockID: Integer): Boolean;
begin
  Result := CheckValid(BlockID) <> nil;
end;

procedure TGGOutPool.Cancel(BlockID: Integer);
var
  PItem: POutItem;
begin
  FLock.Enter;
  try
    PItem := CheckValid(BlockID);
    if (PItem <> nil) then
    begin
      Reset(PItem^);
      Dec(FCount);
    end;
  finally
    FLock.Leave;
  end;
end;

procedure TGGOutPool.FormatBlock(var Block: TBlock);
begin
  if Block.DataSize < SUB_BLOCK_SIZE then
  begin
    Block.SubDataSize := Block.DataSize;
    Block.SubDataAmount := 1;
    Block.DataBit32 := $FFFFFFFE;
  end else
  begin
    Block.SubDataSize := SUB_BLOCK_SIZE;
    if (Block.DataSize mod SUB_BLOCK_SIZE) = 0 then
      Block.SubDataAmount := Block.DataSize div SUB_BLOCK_SIZE
    else
      Block.SubDataAmount := Block.DataSize div SUB_BLOCK_SIZE + 1;
    Block.DataBit32 := $FFFFFFFF shl Block.SubDataAmount;
  end;
end;

function TGGOutPool.Put(var Item: TOutItem): Integer;
var
  I: Integer;
begin
  FLock.Enter;
  try
    Result := GetIdle;
    if (Result > 0) then
    begin
      Item.Block.OutID := Result;
      Item.Status       := bsWait;
      Item.OutTime     := Now;
      Item.LifeSecond  := BLOCK_LIFE_SEC;
      I := Result mod MAX_BLOCK_POOL;
      IndexValid(I);
      FList[I]^ := Item;
      Inc(FCount);
    end;
  finally
    FLock.Leave;
  end;
end;

function TGGOutPool.Put(InAttachID: Integer; Packet: PChar; PacketSize: Integer; Data: PChar; DataSize: Integer; FreeData: Byte): Integer;
var
  Item: TOutItem;
  I: Integer;
begin
  try
    Reset(Item);
    Item.InAttachID         := InAttachID;
    Item.Block.Packet       := Packet;
    Item.Block.PacketSize   := PacketSize;
    Item.Block.Data         := Data;
    Item.Block.DataSize     := DataSize;
    Item.Block.CompleteSize := 0;
    Item.Block.FreeData     := FreeData;
    FormatBlock(Item.Block);
    Result                  := Put(Item);
  except
  end;
end;

function TGGOutPool.Find(const BlockID: Integer): POutItem;
begin
  FLock.Enter;
  try
    Result := CheckValid(BlockID);
  finally
    FLock.Leave;
  end;
end;

function TGGOutPool.Get(var Item: TOutItem; const BlockID: Integer): Boolean;
var
  PItem: POutItem;
begin
  PItem := Find(BlockID);
  Result := PItem <> nil;
  if (Result) then begin
    Item := PItem^;
  end;
end;

function TGGOutPool.RequestBlock(OutID: Integer; InID: Integer; InAttachID: Integer; CompleteBit32: Integer; First: Boolean): POutItem;
var
  Cur: TDateTime;
begin
  Result := nil;
  FLock.Enter;
  try
    if First then
      Result := CheckValid(OutID)
    else
      Result := CheckValid(OutID, InID);
      
    if (Result <> nil) and (Result^.InAttachID = InAttachID) and
       ((Result^.Status = bsWait) or (Result^.Status = bsOut)) then
    begin
      Result^.OutTime := Now;
      Result^.Block.DataBit32 := Result^.Block.DataBit32 or CompleteBit32;

      if (First) then begin
        Result^.Status       := bsOut;
        Result^.Block.InID  := InID;
      end;
      if (Result^.Block.DataBit32 = Integer($FFFFFFFF)) then begin
        Result^.Status := bsComplete;
      end;
    end;
  finally
    FLock.Leave;
  end;
end;

function TGGOutPool.SetStatus(const BlockID: Integer; const Status: TBlockStatus): Boolean;
var
  PItem: POutItem;
begin
  FLock.Enter;
  try
    PItem := CheckValid(BlockID);
    Result := PItem <> nil;
    if (Result) then begin
      PItem^.Status := Status;
    end;
  finally
    FLock.Leave;
  end;
end;

function TGGOutPool.GetStatus(const BlockID: Integer): TBlockStatus;
var
  PItem: POutItem;
begin
  FLock.Enter;
  Result := bsEmpty;
  try
    PItem := CheckValid(BlockID);
    if (PItem <> nil) then begin
      Result := PItem^.Status;
    end;
  finally
    FLock.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
 { TGGInPool }

constructor TGGInPool.Create;
begin
  FLock := TCriticalSection.Create;
  Init;
end;
destructor TGGInPool.Destroy;
begin
  Clear;
  FLock.Free;
end;
procedure TGGInPool.Init;
var
  PItem: PInItem;
  I: Integer;
  Ok: Boolean;
begin
  FEnable := FALSE;
  Ok := TRUE;
  try
    for I := 0 to MAX_BLOCK_POOL-1 do begin
      try
        New(PItem);
        FillChar(PItem^, SizeOf(TInItem), 0);
        if Assigned(PItem) then
          Reset(PItem^);
        FList[I] := PItem;
      except
        Ok := FALSE;
      end;
    end;
  finally
    FCount := 0;
    FBlockID := 0;
    if (Ok) then FEnable := TRUE;
  end;
end;
procedure TGGInPool.Clear;
var
  I: Integer;
  PItem: PInItem;
begin
  FLock.Enter;
  try
    if (FCount <= 0) then Exit;
    
    for I := 0 to MAX_BLOCK_POOL-1 do
    begin
      PItem := IndexValid(I);
      if (PItem <> nil) then begin
        try
          if Assigned(PItem.Block.Packet) then begin
            FreeMem(PItem.Block.Packet);
          end;
        except
          PItem.Block.Packet := nil;
        end;
        Dispose(PItem);
      end;
      FList[I] := nil;
    end;
  finally
    FCount := 0;
    FEnable := FALSE;
    FLock.Leave;
  end;
end;
procedure TGGInPool.Reset(var Item: TInItem);
begin
  try
    try
      if Item.Block.FreeData=1 then begin
        if (Item.Block.Packet <> nil) and Assigned(Item.Block.Packet) then
        begin
          FreeMem(Item.Block.Packet);
        end;
      end;
    except end;
    FillChar(Item, SizeOf(TInItem), 0);
    Item.Status := bsIdle;
  except  end;
end;
function TGGInPool.GetIdle: Integer;
var
  I,IPool: Integer;
begin
  Result := 0;
  I := 0;
  while (TRUE) do
  begin
    Inc(FBlockID); if (FBlockID <= 0) then FBlockID := 1;
    IPool := FBlockID mod MAX_BLOCK_POOL;
    if (FList[IPool]^.Status = bsIdle) and (I < MAX_BLOCK_POOL-1) then
    begin
      Result := FBlockID; Break;
    end;
    Inc(I);
  end;
end;
function TGGInPool.Rescue(Index: Integer): PInItem;
begin
  Result := nil;
  if (Index > 0) and (Index < (MAX_BLOCK_POOL-1)) then
  begin
    FList[Index] := nil;
    try
      New(Result);
      if (Result <> nil) then
      begin
        FillChar(Result^, SizeOf(TInItem), 0);
        Reset(Result^);
        FList[Index] := Result;
      end;
    except
      Result := nil;
    end;
  end;
end;
function TGGInPool.IndexValid(Index: Integer): PInItem;
var
  ValidID: Boolean;
begin
  Result := nil;
  ValidID := (Index >= 0) and (Index < MAX_BLOCK_POOL);
  if (ValidID) then
  begin
    try
      Result := FList[Index];
      if not Assigned(Result) then
        Result := nil;
    except
      Rescue(Index);
      Result := nil;
    end;
  end;
end;
function TGGInPool.CheckValid(BlockID: Integer): PInItem;
var
  I: Integer;
  ValidID: Boolean;
begin
  Result := nil;
  ValidID := (BlockID > 0) and (BlockID <= FBlockID);
  if (ValidID) then
  begin
    I := BlockID mod MAX_BLOCK_POOL;
    try
      Result := FList[I];
      if Assigned(Result) then begin
        ValidID := Result^.Block.InID = BlockID;
        if not ValidID then
          Result := nil;
      end;
    except
      Rescue(I);
      Result := nil;
    end;
  end;
end;
function TGGInPool.CheckValid(InID: Integer; OutID: Integer): PInItem;
begin
  Result := CheckValid(InID);
  if (Result <> nil) then
  begin
    if (Result.Block.OutID <> OutID) then
      Result := nil;
  end;
end;
function TGGInPool.Exist(BlockID: Integer): Boolean;
begin
  Result := CheckValid(BlockID) <> nil;
end;
procedure TGGInPool.Cancel(BlockID: Integer; FreeData: Boolean);
var
  PItem: PInItem;
  Result: Boolean;
begin
  FLock.Enter;
  try
    PItem := CheckValid(BlockID);
    Result := PItem <> nil;
    if (Result) then
    begin
      Reset(PItem^);
      Dec(FCount);
    end;
  finally
    FLock.Leave;
  end;
end;
function TGGInPool.Put(var Item: TInItem): Integer;
var
  I: Integer;
begin
  FLock.Enter;
  try
    Result := GetIdle;
    if (Result > 0) then begin
      Item.Block.InID := Result;
      Item.Status := bsWait;
      Item.InTime := Now;
      Item.LifeSecond := BLOCK_LIFE_SEC;
      I := Result mod MAX_BLOCK_POOL;
      IndexValid(I);
      FList[I]^ := Item;
      Inc(FCount);
    end;
  finally
    FLock.Leave;
  end;
end;
function TGGInPool.Put(OutAttachID: Integer; OutID: Integer; Packet: PChar; PacketSize: Word;
    DataSize: Word; DataBit32: Integer; SubDataSize: Word; SubDataAmount: Word): Integer;
var
  Item: TInItem;
begin
  Result := 0;
  try
    Reset(Item);
    Item.OutAttachID          := OutAttachID;
    Item.Block.OutID          := OutID;
    Item.Block.Packet         := AllocMem(PacketSize+DataSize);
    Item.Block.PacketSize     := PacketSize;
    Item.Block.DataSize       := DataSize;
    Item.Block.DataBit32      := DataBit32;
    Item.Block.SubDataSize    := SubDataSize;
    Item.Block.SubDataAmount  := SubDataAmount;
    Item.Block.CompleteSize   := 0;
    Move(Packet^, Item.Block.Packet^, PacketSize);
    Item.Block.Data           := Item.Block.Packet+PacketSize;
    Item.Block.FreeData       := 1;