iggclientpool.pas

通信控件

    procedure Exchange(Index1, Index2: Integer);
    function Expand: TIStreamPool;
    function First: TIStreamItem;
    function IndexOf(ID: DWORD): Integer;
    procedure Insert(Index: Integer; var Item: TIStreamItem);
    function Last: TIStreamItem;
    procedure Move(CurIndex, NewIndex: Integer);
    function Remove(ID: DWORD): Integer;
    procedure Pack;
    
    property Count: Integer read FCount write SetCount;
    property Items[Index: Integer]: TIStreamItem read Get write Put; default;
    property Enable: Boolean read FEnable;
  end;

function ElapsedSec(V: Integer): Integer;
function GetSec(): Integer;

implementation

function ElapsedSec(V: Integer): Integer;
var
  SysTime: SYSTEMTIME;
begin
  GetLocalTime(SysTime);
  Result := (SysTime.wHour*3600 + SysTime.wMinute*60 + SysTime.wSecond) - V;
  if Result < 0 then Result := 0;
end;

function GetSec(): Integer;
var
  SysTime: SYSTEMTIME;
begin
  GetLocalTime(SysTime);
  Result := (SysTime.wHour*3600 + SysTime.wMinute*60 + SysTime.wSecond);
end;

  { TIBuffer }
  
constructor TIBuffer.Create();
begin
end;

constructor TIBuffer.Create(AID, ASelfID, AAttachID: DWORD; AData: PChar; ADataSize: Integer;
  AWrite: Boolean; ABlockSize: Integer);
begin
  Init();
  SetPara(AID, ASelfID, AAttachID, AData, ADataSize, AWrite, ABlockSize);
end;

destructor TIBuffer.Destroy();
begin
  Clear();
end;

procedure TIBuffer.Init;
begin
  FEnable  := FALSE;
  FWrite   := TRUE;
  FSecTime := GetSec;
end;

procedure TIBuffer.Clear;
begin
  try
    if Assigned(FData) then
      FreeMem(FData);
  except end;
  try
    if Assigned(FBlock) then
      FreeMem(FBlock);
  except end;
  
  FBlock := nil;
  FData := nil;
  FEnable := FALSE;
end;

procedure TIBuffer.SetPara(AID, ASelfID, AAttachID: DWORD; AData: PChar; ADataSize: Integer;
  AWrite: Boolean; ABlockSize: Integer);
begin
  FID        := AID;
  FSelfID    := ASelfID;
  FAttachID  := AAttachID;
  FDataSize  := ADataSize;
  FBlockSize := ABlockSize;
  FWrite     := AWrite;
  FPosition  := 0;
  FStatus    := BUF_RECORD;
  FRetry     := 6;
  FEnable    := TRUE;
  
  try
    FData  := AllocMem(FDataSize);
    FBlock := AllocMem(FBlockSize);
    if (AData <> nil) then
      Move(AData^, FData^, ADataSize);
  except FEnable := FALSE; end;
end;

procedure TIBuffer.SetEnable(const Value: Boolean);
begin
  FEnable := Value;
end;

function TIBuffer.CheckProcess(Position: Integer; SubSize: Integer): Integer;
begin
  Result := -2;
  if FWrite and ((FStatus = BUF_DATA) or (FStatus = BUF_RECORD)) then
  begin
    if Position = FPosition then
    begin
      Result := FDataSize - (Position + SubSize);
      if Result > 0 then Result := 1;
      if Result < 0 then Result := -1;
    end;
  end else if ((FStatus = BUF_DATA) or (FStatus = BUF_RECORD)) then
  begin
    Result := FDataSize - (Position + SubSize);
    if Result > 0 then Result := 1;
    if Result < 0 then Result := -1;
  end;

  if Result = -1 then
    FErrCode := beBlockPosErr;
end;

function TIBuffer.CheckWork(): Integer;
begin
  Result := 0;
  if (FStatus = BUF_RECORD) then
    Result := 1
  else if (FStatus = BUF_DATA) then
    Result := 2;
end;

procedure TIBuffer.SetStatus(Status: Word; Para1: Word; Para2: Integer; Send: Boolean);

  procedure SendCmd(Cmd: Word; Para1: Word; Para2: Integer);
  var
    BufferCmd: TIBufferCmd;
  begin
    FillChar(BufferCmd, SizeOf(BufferCmd), 0);
    BufferCmd.ID       := FID;
    BufferCmd.SelfID   := FSelfID;
    BufferCmd.Command  := Cmd;
    BufferCmd.Para1    := Para1;
    BufferCmd.Para2    := Para2;
    if FWrite then  Cmd := 4  else  Cmd := 5;

    try
      if Assigned(FCallback) then
        FCallback(FAttachID, BufferCmd, SizeOf(BufferCmd), nil, 0, Cmd);
    except end;
  end;

var
  Cmd: Word;  
begin
  Cmd := BUF_STOP;
  try
    case Status of
      BUF_DATA, BUF_RECORD:
      begin
        FSecTime := GetSec();
        if (Para1 > 0) then FRetry := Para1;
      end;
      BUF_TIMEOUT, BUF_FAIL, BUF_STOP, BUF_COMPLETE:
      begin
        if Send then
          SendCmd(Status, Para1, Para2);
        Status := BUF_DESTROY;
      end;
    end;
  finally
    FStatus := Status;
  end;
end;

procedure TIBuffer.Command(Cmd: Word; Para1: Word; Para2: Integer);
begin
  if (Cmd = BUF_COMPLETE) then
    FPosition := FDataSize;
  SetStatus(Cmd, Para1, Para2, FALSE);
end;

procedure TIBuffer.AutoAdjust(Reserved: Integer);
var
  SecondV: Integer;
begin
  SecondV := ElapsedSec(FSecTime);
  case FStatus of
    BUF_RECORD: begin
      if (FRetry > 0) and (SecondV >= 15) then
      begin
        if FWrite then begin
          if WriteREQ() >= 0 then
            SetStatus(BUF_DATA, 3);
        end else  begin
          ReadREQ();
        end;
        Dec(FRetry);
      end else if (FRetry <= 0) then begin
        SetStatus(BUF_TIMEOUT, 0, 0, TRUE);
      end;
    end;
    BUF_DATA: begin
      if (FRetry > 0) and (SecondV >= 15) then
      begin
        if FWrite then begin
          if WriteREQ() < 0 then
            SetStatus(BUF_FAIL, 0, 0, TRUE);
        end;
        Dec(FRetry);
      end else if (FRetry <= 0) then begin
        SetStatus(BUF_TIMEOUT, 0, 0, TRUE);
      end;
    end;
  end;
end;

function TIBuffer.Query(var Res: Integer; PRec: Pointer; Cmd: DWORD): Integer;
begin
  Res := 0;  Result := 0;
  try
    AutoAdjust;
    Result := FPosition - FDataSize;
    if (FStatus = BUF_DESTROY) then
    begin
       Res := -1;
    end;
  except end;
end;

function TIBuffer.ReadREQ(): Integer;
var
  DataREQ: TIBufferAttr;
begin
  Result := 0;
  try
    Result := CheckProcess(FPosition, 0);
    if (Result > 0) then
    begin
      //SetStatus(BUF_DATA);
      FillChar(DataREQ, SizeOf(DataREQ), 0);
      DataREQ.ID       := FID;
      DataREQ.SelfID   := FSelfID;
      DataREQ.AttachID := FAttachID;
      DataREQ.DataSize := FDataSize;
      StrLCopy(DataREQ.NameID, PChar(FNameID), Length(FNameID));
      StrLCopy(DataREQ.Hash, PChar(FHash), BUFFER_HASH_SIZE-1);
      if Assigned(FCallback) then
        FCallback(FAttachID, DataREQ, SizeOf(DataREQ), nil, 0, 1);
    end;
  except Result := -1; end;
  //if (CheckV < 0) then
  //  SetStatus(BUF_FAIL, 0, 0, TRUE);
end;

function TIBuffer.Read(var DataREQ: PIBufferDataREQ): Integer;
var
  DataSEQU: TIBufferDataSEQU;  CheckV: Integer;
begin
  Result := 0; CheckV := 0;
  try
    CheckV := CheckProcess(DataREQ.Position, DataREQ.ReadSize);
    if (CheckV >= 0) then
    begin
      SetStatus(BUF_DATA, 3);
      
      Move((FData+DataREQ.Position)^, FBlock^, DataREQ.ReadSize);
      FillChar(DataSEQU, SizeOf(DataSEQU), 0);
      DataSEQU.ID       := FID;
      DataSEQU.SelfID   := FSelfID;
      DataSEQU.Position := DataREQ.Position;
      DataSEQU.ReadSize := DataREQ.ReadSize;
      FPosition := DataREQ.Position;
      if Assigned(FCallback) then
        FCallback(FAttachID, DataSEQU, SizeOf(DataSEQU), FBlock, DataREQ.ReadSize, 2);
      Result := DataREQ.ReadSize;
    end;
  except Result := -1; end;
  if CheckV < 0 then
    SetStatus(BUF_FAIL, 0, 0, TRUE);
end;

function TIBuffer.WriteREQ(): Integer;
var
  DataREQ: TIBufferDataREQ;
begin
  try
    Result := CheckProcess(FPosition, 0);
    if (Result > 0) then
    begin
      //SetStatus(BUF_DATA);
      FillChar(DataREQ, SizeOf(DataREQ), 0);
      DataREQ.ID       := FID;
      DataREQ.SelfID   := FSelfID;
      DataREQ.Position := FPosition;
      if (FPosition + FBlockSize > FDataSize) then
        FBlockSize := FDataSize - FPosition;
      DataREQ.ReadSize := FBlockSize;
      if Assigned(FCallback) then
        FCallback(FAttachID, DataREQ, SizeOf(DataREQ), nil, 0, 3);
    end;
  except Result := -1 end;
  //if (CheckV < 0) then
  //  SetStatus(BUF_FAIL, 0, 0, TRUE);
end;

function TIBuffer.Write(var DataSEQU: PIBufferDataSEQU; PData: Pointer; DataSize: Integer): Integer;
var
  DataREQ: TIBufferDataREQ; CheckV: Integer;
  Data: PChar;
begin
  Result := 0;
  try
    CheckV := CheckProcess(DataSEQU.Position, DataSEQU.ReadSize);
    if (CheckV >= 0) then
    begin
      SetStatus(BUF_DATA, 3);
      Data := PChar(DataSEQU)+SizeOf(TIBufferDataSEQU);
      Move(Data^, (FData+FPosition)^, DataSEQU.ReadSize);
      Inc(FPosition, DataSEQU.ReadSize);
      if (FPosition + FBlockSize > FDataSize) then
        FBlockSize := FDataSize - FPosition;

      if CheckV > 0 then begin
        FillChar(DataREQ, SizeOf(DataREQ), 0);
        DataREQ.ID       := FID;
        DataREQ.SelfID   := FSelfID;
        DataREQ.Position := FPosition;
        DataREQ.ReadSize := FBlockSize;
        if Assigned(FCallback) then
          FCallback(FAttachID, DataREQ, SizeOf(DataREQ), nil, 0, 3);
        Result := DataSEQU.ReadSize;
      end else if CheckV = 0 then begin
        FPosition := FDataSize;
        SetStatus(BUF_COMPLETE, 0, 0, TRUE);
      end;
    end;
  except  Result := -1; end;
  
  if (CheckV < 0) then
    SetStatus(BUF_FAIL, 0, 0, TRUE);
end;

  {TIBufferPool }

constructor TIBufferPool.Create(ACapacity: Integer);
begin
  Init();
  SetCapacity(ACapacity);
end;

destructor TIBufferPool.Destroy();
begin
  Clear;
end;

procedure TIBufferPool.Init;
begin
  FCount := 0;
  FCapacity := 0;
  SetLength(FList, 0);
end;

procedure TIBufferPool.Clear;
begin
  try
    //Clear FList....
    FCount := 0;
    FCapacity := 0;
    SetLength(FList, 0);
  except end;  
end;

procedure TIBufferPool.SetCapacity(const Value: Integer);
begin
  if (Value > 0) and (Value < 50) and (Value <> FCapacity) then
  begin
    SetLength(FList, Value);
    FCapacity := Value;
  end;
end;

function TIBufferPool.IdleSlot(): Integer;
begin
  if (FCount < FCapacity) then
    Result := FCount;
end;

function TIBufferPool.IndexOf(const IBuffer: TIBuffer): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to FCount-1 do begin
    if (FList[I] = IBuffer) then begin
      Result := I; Break;
    end;
  end;
end;

function TIBufferPool.IndexOf(const ID: DWORD): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to FCount-1 do begin
    if (FList[I].ID = ID) then begin
      Result := I;  Break;
    end;
  end;
end;

procedure TIBufferPool.Put(Index: Integer; IBuffer: TIBuffer);
begin
  if Index <= FCount then begin
    FList[Index] := IBuffer;
  end;
end;

function TIBufferPool.Add(IBuffer: TIBuffer): Integer;
begin
  Result := IdleSlot();
  if (Result > -1) then begin
    Put(Result, IBuffer);
    Inc(FCount);
  end;
end;

procedure TIBufferPool.Delete(const Index: Integer);
begin
  if (Index >= 0) and (Index < FCount) then
  begin
    Dec(FCount);
    FList[Index] := FList[FCount];
    FList[FCount] := nil;
  end;
end;

procedure TIBufferPool.Remove(const ID: DWORD);
var
  Index: Integer;
begin
  Index := IndexOf(ID);
  if (Index > -1) then
    Delete(Index);
end;

function TIBufferPool.Get(const ID: DWORD): TIBuffer;
var
  Index: Integer;
begin
  Result := nil;
  Index := IndexOf(ID);
  if (Index >= 0) then
    Result := FList[Index];
end;

function TIBufferPool.SearchIn(const Index: Integer): TIBuffer;
begin
  Result := nil;
  if (Index >= 0) and (Index < FCount) then
  begin
    Result := FList[Index];
  end;
end;

class procedure TIBufferPool.Delete(var IBuffer: TIBuffer);
begin
  try
    if Assigned(IBuffer) then
      IBuffer.Free;
  except end;
  IBuffer := nil;
end;

////////////////////////////////////////////////////////////////////////////////
 { TGGOutPool }

constructor TGGOutPool.Create;
begin
  FLock := TCriticalSection.Create;
  Init;
end;

destructor TGGOutPool.Destroy;
begin
  Clear;
  FLock.Free;
end;

procedure TGGOutPool.Init;
var
  PItem: POutItem;
  I: Integer;
  Ok: Boolean;
begin
  Ok := TRUE;
  FEnable := FALSE;
  FLock.Enter;
  try
    for I := 0 to MAX_BLOCK_POOL-1 do begin
      try
        New(PItem);
        FillChar(PItem^, SizeOf(TOutItem), 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;
    FLock.Leave;
  end;
end;

procedure TGGOutPool.Clear(FreeData: Boolean);
var
  I: Integer;
  PItem: POutItem;
begin
  FLock.Enter;