uaserviceobjectpool.~pas

基于Midas 技术的多层应用开发包

procedure TPoolThreadList.BeginRead;
begin
  EnterCriticalSection(FLock);
end;

procedure TPoolThreadList.EndRead;
begin
  LeaveCriticalSection(FLock);
end;

procedure TPoolThreadList.BeginWrite;
begin
  EnterCriticalSection(FLock);
end;

procedure TPoolThreadList.EndWrite;
begin
  LeaveCriticalSection(FLock);
end;

procedure TPoolThreadList.Lock;
begin
  BeginWrite;
end;

procedure TPoolThreadList.Unlock;
begin
  EndWrite;
end;

function TPoolThreadList.Add(Item: Pointer): Integer;
begin
  BeginWrite;
  try
    Result := Count;
    Insert(Result, Item);
  finally
    EndWrite;
  end;
end;

procedure TPoolThreadList.Insert(Index: Integer; Item: Pointer);
begin
  BeginWrite;
  try
    ListInsert(FItems, Index, Item);
  finally
    EndWrite;
  end;
end;

procedure TPoolThreadList.Clear;
begin
  BeginWrite;
  try
    ListClear(FItems);
  finally
    EndWrite;
  end;
end;

procedure TPoolThreadList.Remove(Item: Pointer);
begin
  BeginWrite;
  try
    if ListIndexOf(FItems, Item) >= 0 then
      ListRemove(FItems, Item);
  finally
    EndWrite;
  end;
end;

{ TCustomPoolManager }
constructor TCustomPoolManager.Create(iMaxCount: Integer; iTimeout: DWord);
begin
  FItems := TPoolThreadList.Create;
  FTimeout := iTimeout;
  FMaxCount := iMaxCount;
  FSemaphore := CreateSemaphore(nil, FMaxCount, FMaxCount, nil);
end;

destructor TCustomPoolManager.Destroy;
begin
  FItems.Free;
  CloseHandle(FSemaphore);
  inherited;
end;

procedure TCustomPoolManager.Clear;
var
  I: Integer;
begin
  Lock;
  try
    for I := 0 to FItems.Count - 1 do
      Items[I].Free;
    FItems.Clear;
  finally
    Unlock;
  end;
end;

procedure TCustomPoolManager.ClearUnused;
var
  I: Integer;
  Item: TCustomPoolObject;
begin
  Lock;
  try
    for I := FItems.Count - 1 downto 0 do
    begin
      Item := Items[I];
      if not Item.InUse then
      begin
        Item.Free;
        FItems.Remove(Item);
      end;
    end;
  finally
    Unlock;
  end;
end;


procedure TCustomPoolManager.Lock;
begin
  FItems.Lock;
end;

procedure TCustomPoolManager.Unlock;
begin
  FItems.Unlock;
end;

function TCustomPoolManager.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TCustomPoolManager.GetItem(Index: Integer): TCustomPoolObject;
begin
  Result := FItems[Index];
end;

function TCustomPoolManager.LockInstance: TCustomPoolObject;

  procedure RaiseError;
  begin
    raise EInvalidOp.Create('Error for Lock Server Object !');
  end;

var
  I: Integer;
  Instance: TCustomPoolObject;
begin

  Result := nil;
  if WaitForSingleObject(FSemaphore, Timeout) = WAIT_FAILED then
    RaiseError;
  Lock;
  try
    try
      for I := 0 to FItems.Count - 1 do
      begin
        Instance := FItems[I];
        if GetLock(Instance) then
        begin
          LastSrvObjActivityGID := Instance.PoGID;
          Result := Instance;
          Exit;
        end;
      end;
      if FItems.Count < MaxCount then
      begin
        Result := CreateNewInstance;
      end
      else
        RaiseError;
    except

    end;
  finally
    Unlock;
  end;

end;

procedure TCustomPoolManager.UnlockInstance(Instance: TCustomPoolObject);
begin

  Lock;
  try
    LockedInstance(Instance, False);
    Instance.FInUse := False;
    ReleaseSemaphore(FSemaphore, 1, nil);
  finally
    Unlock;
  end;
  
end;

procedure TCustomPoolManager.LockedInstance(Instance: TCustomPoolObject; Value: Boolean);
begin
  // 
end;

procedure TCustomPoolManager.CheckLocked(Instance: TCustomPoolObject; var InUse: Boolean);
begin

  if TCustomPoolObject(Instance) = nil then
  begin

  end
  else
  begin

  end;

end;

function TCustomPoolManager.GetLock(Instance: TCustomPoolObject): Boolean;
begin
  Lock;
  try
    CheckLocked(Instance, Instance.FInUse);
    Result := not Instance.InUse;
    if Result then
    begin
      Instance.FInUse := True; ////
    end;
    LockedInstance(Instance, True);
  finally
    Unlock;
  end;
end;

function TCustomPoolManager.CreateNewInstance: TCustomPoolObject;
begin

  Lock;
  try
    Result := InternalCreateNewInstance;
    if Assigned(Result) then
    try
      Result.FInUse := True;
      Result.FPoGID := GenerateGUID32;
      LastSrvObjActivityGID := Result.PoGID;
      Result.FPoolManager := Self;
      FItems.Add(Result);
      LockedInstance(Result, True);
    except
      Result.Free;
      raise;
    end;
  finally
    Unlock;
  end;

end;



procedure TCustomPoolManager.SetSrvObjMgrType(const Value: TSrvObjMgrType);
begin
  FSrvObjMgrType := Value;
end;


procedure TCustomPoolManager.SetLastSrvObjActivityGID(
  const Value: LongWord);
begin
  FLastSrvObjActivityGID := Value;
end;

procedure TCustomPoolManager.SetSrvObjMgrName(const Value: string);
begin
  FSrvObjMgrName := Value;
end;

procedure TCustomPoolManager.ReleaseAllDirtyObj0;
var
  I:integer;
  Instance: TCustomPoolObject;
  
begin

  for I := FItems.Count - 1 downto 0 do
  begin
    Instance := FItems[I];
    if (not Instance.InUse)
      and (Instance.IsDirty) then
      // rever for ......
     FItems.Remove(Instance);
  end;
    
end;

{ TCustomPoolObject }

procedure TCustomPoolObject.SetIsDirty(const Value: Boolean);
begin
  FIsDirty := Value;
end;

initialization

   PoolManagerList :=  TObjectList.Create;
   PoolManagerList.OwnsObjects := true;

finalization
  if Assigned(PoolManagerList) then
    FreeAndNil(PoolManagerList);

end.