dxservercoremanager.pas

Well known and usefull component for delphi 7

unit DXServerCoreManager;

interface

uses
   SysUtils,
   DXString,
   DXSock,
   DXServerCore,
   Classes;

Type
   TDX_CreateInstance=procedure(Sender:TObject;Var NewInstance:TObject;const Index:Integer) of object;
   TDX_DestroyInstance=procedure(Sender:TObject;Var NewInstance:TObject;const Index:Integer) of object;

   TDXServerCoreManager=class(TDXComponent)
   private
      fCount:Integer;
      FList:TList;
      fOnCreateInstance:TDX_CreateInstance;
      fOnDestroyInstance:TDX_DestroyInstance;
   protected
      procedure Put(Index: Integer; const Item: TObject);
      function Get(Index: Integer): TObject;
      procedure Clear(Compact:Boolean);
   public
      constructor Create(AOwner:TComponent); override;
      destructor Destroy;override;
      Function CreateInstances:Boolean;
      property Items[Index: Integer]: TObject read Get write Put; default;
   published
      property Count:Integer read fCount write fCount;
      property OnCreateInstance:TDX_CreateInstance read fOnCreateInstance write fOnCreateInstance;
      property OnDestroyInstance:TDX_DestroyInstance read fOnDestroyInstance write fOnDestroyInstance;
   end;

implementation

constructor TDXServerCoreManager.Create(AOwner:TComponent);
Begin
   inherited Create(AOwner);
   FList:=TList.Create;
End;

destructor TDXServerCoreManager.Destroy;
Begin
   Self.Clear(True);
   FList.Free;
   inherited Destroy;
End;

Procedure TDXServerCoreManager.Clear(Compact:Boolean);
Var
   Loop:Integer;
   MaxLoop:Integer;
   Shit:TObject;

Begin
   MaxLoop:=FList.Count-1;
   Loop:=MaxLoop;
   While Loop>-1 do Begin
      Shit:=TObject(FList[Loop]);
      Self.fOnDestroyInstance(Self,Shit,Loop+1);
      Dec(Loop);
   End;
   FList.Clear;
   If Compact then FList.Capacity:=0;
End;

Function TDXServerCoreManager.CreateInstances:Boolean;
Var
   Loop:Integer;
   Shit:TObject;

Begin
   Result:=False;
   If Not Assigned(fOnCreateInstance) then Begin
      EAbort.Create('OnCreateInstance must be assigned!');
   End;
   If Not Assigned(fOnDestroyInstance) then Begin
      EAbort.Create('OnDestroryInstance must be assigned!');
   End;
   Self.MyCriticalSection.StartingWrite;
   Self.Clear(False);
   While FList.Count<fCount do Begin
      Loop:=FList.Add(Self);
      Shit:=TObject(FList[Loop]);
      fOnCreateInstance(Self,Shit,Loop+1);
      FList[Loop]:=Shit;
      Inc(Loop);
   End;
   Self.MyCriticalSection.FinishedWrite;
   Result:=True;
End;

procedure TDXServerCoreManager.Put(Index: Integer; const Item: TObject);
Begin
   If (Index<0) or (Index>FList.Count-1) then Begin
      EAbort.Create('Index is out of range!');
   End;
   FList[Index]:=Item;
End;

function TDXServerCoreManager.Get(Index: Integer): TObject;
Begin
   If (Index<0) or (Index>FList.Count-1) then Begin
      EAbort.Create('Index is out of range!');
   End;
   Result:=FList[Index];
End;


end.