⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 iggclientpool.pas

📁 通信控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    try
      if (PItemX <> nil) and Assigned(PItemX) then begin
        Result := PItemX.Next;
        Dispose(PItemX);
      end;
    except
    end;
  finally
    PItemX := nil;
  end;
end;

function TIRoutePool.RescueX(Index: Integer): PRouteItemX;
begin
  Result := nil;
  if (Index > 0) and (Index < (MAX_ROUTE_POOL-1)) then
  begin
    FList[Index] := nil;
    try
      New(Result);
      if (Result <> nil) then begin
        ResetX(Result);
        FList[Index] := Result;
      end;
    except
      Result := nil;
    end;
  end;
end;

function TIRoutePool.NewX(const AttachID: Integer): PRouteItemX;
var
  Index: Integer;
  PEndX: PRouteItemX;
begin
  Result := nil;
  Index := AttachID mod MAX_ROUTE_POOL;
  PEndX := IndexValidEndX(Index);
  if (PEndX <> nil) then begin
    if (PEndX.Status <> rsIdle) then begin
      try
        New(Result);
        if Assigned(Result) then begin
          PEndX.Next := Result;
          ResetX(Result);
        end;
      except
        Result := nil;
      end;
    end else begin Result := PEndX; ResetX(Result); end;
  end;
end;

function TIRoutePool.IndexValidBeginX(Index: Integer): PRouteItemX;
var
  ValidID: Boolean;
begin
  Result := nil;
  ValidID := (Index >= 0) and (Index < MAX_ROUTE_POOL);
  if (ValidID) then begin
    try
      Result := FList[Index];
      if (Result <> nil) and (not Assigned(Result)) then
        Result := nil;
    except
      RescueX(Index);
      Result := nil;
    end;
  end;
end;

function TIRoutePool.IndexValidEndX(Index: Integer): PRouteItemX;
var
  ValidID: Boolean;
  PNextX: PRouteItemX;
begin
  Result := IndexValidBeginX(Index);
  if (Result <> nil) then
  begin
    PNextX := Result;
    while(PNextX.Item.AttathIDmod <> -1) do begin
      PNextX := NextX(Result);
      if (PNextX = nil) then Break;
      Result := PNextX;
    end;
  end;
end;

function TIRoutePool.NextX(var PItemX: PRouteItemX): PRouteItemX;
begin
  try
    Result := PItemX.Next;
    if (Result = nil) or (not Assigned(Result)) then
    begin
      PItemX.Next := nil;
    end;
  except
    PItemX.Next := nil;
    Result := nil;
  end;
end;

function TIRoutePool.PrevX(var PBeginX: PRouteItemX; const AttachID: Integer): PRouteItemX;
var
  PItemX: PRouteItemX;
begin
  Result := nil;
  PItemX := FindX(AttachID);
  if (PItemX <> nil) and (PBeginX <> PItemX) then
  begin
    Result := PBeginX;
    while (Result.Next <> PItemX) do
      Result := Result.Next;
  end else if PItemX <> nil then
    Result := nil;
end;

function TIRoutePool.FindX(const AttachID: Integer): PRouteItemX;
var
  Index: Integer;
begin
  Index := AttachID mod MAX_ROUTE_POOL;
  Result := IndexValidBeginX(Index);
  while ((Result <> nil) and (Result.Item.Route.AttachID <> AttachID)) do begin
    Result := NextX(Result);
  end;
end;

function TIRoutePool.IndexByNextX(var Index: Integer; PItemX: PRouteItemX=nil): PRouteItemX;
begin
  FLock.Enter;
  try
    //if FCount <= 0 then Exit;
    
    repeat
      if (PItemX <> nil) then
        Result := NextX(PItemX)
      else
        Result := nil;
      if (Result = nil) then
      begin
        if (Index < MAX_ROUTE_POOL-1) then
        begin
          Inc(Index);
          Result := IndexValidBeginX(Index);
        end else Index := -1;
      end;
    until((Index = -1) or (Result<>nil) and (Result.Status <> rsIdle));
  finally
    FLock.Leave;
  end;
end;

function TIRoutePool.Exist(const AttachID: Integer): Boolean;
begin
  Result := FindX(AttachID) <> nil;
end;

procedure TIRoutePool.Cancel(const AttachID: Integer);
var
  PBeginX, PItemX: PRouteItemX;
  Index: Integer;
begin
  FLock.Enter;
  try
    if (AttachID <> 0) then begin
      if FindX(AttachID) <> nil then
        Dec(FCount);
      PItemX := nil;
      Index := AttachID mod MAX_ROUTE_POOL;
      PBeginX := IndexValidBeginX(Index);
      PItemX := PrevX(PBeginX, AttachID);
      if (PBeginX = PItemX) then begin
        Reset(PItemX.Next.Item);
        PItemX.Next.Status := rsIdle;
        PItemX.Next := FreeX(PItemX.Next);
      end else if (PItemX <> nil) then
      begin
        PItemX.Next := FreeX(PItemX.Next);
      end else if (PItemX = nil) and (PBeginX <> nil)
          and (PBeginX.Item.AttathIDmod <> -1) then
      begin
        Reset(PBeginX.Item);
        PBeginX.Status := rsIdle;
      end;
    end else begin
      for Index := 0 to MAX_ROUTE_POOL-1 do begin
        PItemX := FList[Index];
        if (PItemX <> nil) then begin
          Reset(PItemX.Item);
          PItemX.Status := rsIdle;
          PItemX := PItemX.Next;
          if (PItemX <> nil) then
            PItemX.Next := nil;
        end;
        while(PItemX <> nil) do begin
          //if (PItemX.Item.Route.AttachID > 0) then
          //  Cancel(PItemX.Item.Route.AttachID);
          //PItemX = NextX(PItemX);
          PItemX := FreeX(PItemX);
        end;
        //FList[Index] := nil;
      end;
      FCount := 0;
    end;
  finally
    FLock.Leave;
  end;
end;

function TIRoutePool.Find(const AttachID: Integer): PRouteItem;
var
  PItemX: PRouteItemX;
begin
  FLock.Enter;
  try
    Result := nil;
    PItemX := FindX(AttachID);
    if (PItemX <> nil) then
      Result := @PItemX.Item;
  finally
    FLock.Leave;
  end;
end;

function TIRoutePool.IndexByState(var Index: Integer; State: TRouteStatus): PRouteItemX;
var
  I: Integer;
begin
  FLock.Enter;
  try
    Result := nil;
    if (Index >= 0) and (Index < MAX_ROUTE_POOL) then
    begin
      for I := Index to MAX_ROUTE_POOL-1 do begin
        Result := IndexValidBeginX(Index);
        while (Result <> nil ) and (Result.Status <> State) do
          Result := Result.Next;
        if (Result <> nil) then Break;
        Inc(Index);
      end;
    end;
  finally
    FLock.Leave;
  end;
end;

function TIRoutePool.IndexByDynamic(var Index: Integer; var EventV: TRouteEventV): PRouteItemX;
begin
end;

function TIRoutePool.SetStatus(const AttachID: Integer; const Status: TRouteStatus): Boolean;
var
  PItemX: PRouteItemX;
begin
  FLock.Enter;
  Result := FALSE;
  try
    PItemX := FindX(AttachID);
    Result := PItemX <> nil;
    if (Result) then
    begin
      PItemX.Status := Status;
      case Status of
        rsWait: begin
          PItemX.Item.LifeSec := ROUTE_WAIT_SEC;
        end;
        rsHeart: begin
          PItemX.Item.LifeSec := ROUTE_LIFE_SEC;
        end;
      end;
    end;
  finally
    FLock.Leave;
  end;
end;

function TIRoutePool.GetStatus(const AttachID: Integer): TRouteStatus;
var
  PItemX: PRouteItemX;
begin
  FLock.Enter;
  Result := rsIdle;
  try
    PItemX := FindX(AttachID);
    if (PItemX <> nil) then
      Result := PItemX.Status;
  finally
    FLock.Leave;
  end;
end;

procedure TIRoutePool.AdjustRoute(var Route: TRoute);
var
  IPV: Integer;
begin
  {if (Route.LoginIP = FLoginIP) then begin
    IPV := (FLocalIP and $00ff0000) - (Route.LocalIP and $00ff0000);
    if (Route.SendRoute and $01) = $00 then begin
      Route.RouteIP := Route.LocalIP;
      Route.RoutePort := Route.LocalPort;
    end;
  end else begin
    if (Route.RecvRoute and $01) = $00 then begin
      Route.RouteIP := Route.LoginIP;
      Route.RoutePort := Route.LoginPort;
    end;
  end; }
end;

function TIRoutePool.Put(var Route: TRoute): PRouteItemX;
begin
  FLock.Enter;
  try
    Result := NewX(Route.AttachID);
    if (Result <> nil) then
    begin
      if (Result^.Status = rsIdle) then begin
        Result^.Item.AttathIDmod := Route.AttachID mod MAX_ROUTE_POOL;
        Result^.Item.Route := Route;
        Result^.Item.LifeSec := ROUTE_WAIT_SEC;
        Result^.Status := rsWait;
        Inc(FCount);
      end;
    end;
  finally
    FLock.Leave;
  end;
end;

function TIRoutePool.Put(const AttachID: Integer): PRouteItemX;
var
  Route: TRoute;
begin
  FillChar(Route, SizeOf(Route), 0);
  Route.AttachID := AttachID;
  Result := Put(Route);
end;
function TIRoutePool.Put(const AttachID: Integer; var Route: TRoute): Integer;
var
  PItemX: PRouteItemX;
begin
  Result := 0;
  PItemX := nil;
  FLock.Enter;

  try
    PItemX := FindX(AttachID);
    if (PItemX = nil) then
    begin
      PItemX := Put(AttachID);
    end;

    if (PItemX <> nil) then
    begin
      if (Route.LoginPort <> PItemX.Item.Route.LoginPort) or
         (Route.LoginIP <> PItemX.Item.Route.LoginIP) then
      begin
        PItemX.Item.Route.LoginIP   := Route.LoginIP;
        PItemX.Item.Route.LoginPort := Route.LoginPort;
        PItemX.Item.Route.LocalIP   := Route.LocalIP;
        PItemX.Item.Route.LocalPort := Route.LocalPort;

        PItemX.Item.Route.RouteIP   := 0;
        PItemX.Item.Route.RoutePort := 0;
        PItemX.Item.Route.Revert    := 0;
      end;
    end;
  finally
    FLock.Leave;
  end;
end;

function TIRoutePool.UpdateRoute(AttachID: Integer; FromIP: Integer; FromPort: Word): Boolean;
var
  PItemX: PRouteItemX;
begin
  FLock.Enter;

  try
    PItemX := FindX(AttachID);
    Result := PItemX <> nil;
    
    if Result then
    begin
      if FromIP <> 0 then
      begin
        PItemX.Item.Route.RouteIP   := FromIP;
        PItemX.Item.Route.RoutePort := FromPort;
        PItemX.Item.Route.Revert    := 2;
      end else if PItemX.Item.Route.Revert = 0 then
        PItemX.Item.Route.Revert := 1;
    end;
  finally
    FLock.Leave;
  end;
end;

function TIRoutePool.Get(var Item: TRouteItem; const AttachID: Integer): Boolean;
var
  PItemX: PRouteItemX;
begin
  FLock.Enter;
  try
    PItemX := FindX(AttachID);
    Result := PItemX <> nil;
    if Result then
      Item := PItemX^.Item;
  finally
    FLock.Leave;
  end;
end;

function TIRoutePool.Get(var Route: TRoute; const AttachID: Integer): TRouteStatus;
var
  PItemX: PRouteItemX;
begin
  Result := rsIdle;
  FLock.Enter;
  try
    PItemX := FindX(AttachID);
    if (PItemX <> nil) then begin
      Route := PItemX^.Item.Route;
      PItemX^.Item.LifeSec := ROUTE_LIFE_SEC;
      Result := PItemX^.Status;
    end;
  finally
    FLock.Leave;
  end;
end;

function TIRoutePool.Route(const AttachID: Integer): TRoute;
var
  Status: TRouteStatus;
begin
  FillChar(Result, SizeOf(Result), 0);
  if AttachID <> 0 then begin
    Status := Get(Result, AttachID);
    if (Status = rsIdle) then
      Put(AttachID);
  end;
  //if (Result.SendRoute = 0) or (Result.RouteIP = 0) then
  begin
    //Result.RouteIP := ServerIP;
    //Result.RoutePort := ServerPort;
    if (AttachID <> 0) then
      Result.AttachID := AttachID;
    //Result.SendRoute := 0;
  end;
end;

function TIRoutePool.CurRoute(const AttachID: Integer): Integer;
var
  Status: TRouteStatus;
begin
  Result := 0;
  Status := GetStatus(AttachID);
  case Status of
    rsIdle:
  end;
end;

  { TIStreamPool }

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

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

procedure TIStreamPool.Init;
begin
  FCount    := 0;
  FCapacity := 0;
  FEnable   := FALSE;
end;

procedure TIStreamPool.Clear;
begin
  FEnable   := FALSE;
  SetCount(0);
  SetCapacity(0);
end;
class procedure TIStreamPool.Error(const Msg: string; Data: Integer);

  function ReturnAddr: Pointer;
  asm
          MOV     EAX,[EBP+4]
  end;

begin
  raise EListError.CreateFmt(Msg, [Data]) at ReturnAddr;
end;

class procedure TIStreamPool.Error(Msg: PResStringRec; Data: Integer);
begin
  TList.Error(LoadResString(Msg), Data);
end;

function TIStreamPool.Get(Index: Integer): TIStreamItem;
begin
  if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);
  Result := FList[Index];
end;
procedure TIStreamPool.Put(Index: Integer; Item: TIStreamItem);
begin
  if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);
  FList[Index] := Item;
end;

procedure TIStreamPool.Grow;
var
  Delta: Integer;
begin
  if FCapacity > 64 then
    Delta := FCapacity div 4
  else
    if FCapacity

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -