一个采用指针管理的队列

unit FifoQueue;

interface

uses

 Classes, Sysutils, Windows, Syncobjs;

type

 TCompareQueueItemMethod = function(Item1, Item2: Pointer): Boolean;

 TPointerArray = array of Pointer;

 TItemEvent = procedure(Item: Pointer) of object;

 TFifoQueue = class(TObject)

 private

   FQueueArray: TPointerArray;

   FQueueLock: TCriticalSection;

{$IFNDEF SERVERMODE}

   FOnPushItem: TItemEvent;

   FOnGetItem: TItemEvent;

{$ENDIF}

   FFirstItemIndex, FLastItemIndex: Integer;

   FCount, FCapacity: Integer;

 public

   constructor Create(QueueLength: Integer);

   destructor Destroy; override;

   function PushItem(Item: Pointer): Boolean;

   function GetItem: Pointer;

   //function GetItems(GetNum: Integer): TPointerArray;

   function FindItem(Item: Pointer; method: TCompareQueueItemMethod): Boolean;

   property Count: Integer read FCount;

{$IFNDEF SERVERMODE}

   property OnPushItem: TItemEvent read FOnPushItem write FOnPushItem;

   property OnGetItem: TItemEvent read FOnGetItem write FOnGetItem;

{$ENDIF}

 end;

 PLinkNode = ^TLinkNode;

 TLinkNode = record

   Prior: PLinkNode;

   Data: Pointer;

   Next: PLinkNode;

 end;

 TExtendQueue = class(TObject)

 private

   FFirstNode, FLastNode: PLinkNode;

{$IFNDEF SERVERMODE}

   FOnPushItem: TItemEvent;

   FOnPopItem: TItemEvent;

{$ENDIF}

   FCount: Integer;

   procedure DeleteNode(node: PLinkNode);

   procedure Clear;

 public

   constructor Create;

   destructor Destroy; override;

   procedure PushItem(Item: Pointer);

   function PopItem: Pointer;

   function GetItem: Pointer;

   function FindItem(Item: Pointer; method: TCompareQueueItemMethod): Boolean;

   function PopFindItem(Item: Pointer; method: TCompareQueueItemMethod): Pointer;

   property Count: Integer read FCount;

{$IFNDEF SERVERMODE}

   property OnPushItem: TItemEvent read FOnPushItem write FOnPushItem;

   property OnPopItem: TItemEvent read FOnPopItem write FOnPopItem;

{$ENDIF}

 end;

implementation

{ TFifoQueue }

constructor TFifoQueue.Create(QueueLength: Integer);

begin

 FCapacity := QueueLength;

 SetLength(FQueueArray, FCapacity);

 FQueueLock := TCriticalSection.Create;

 FFirstItemIndex := -1;

 FLastItemIndex := -1;

 FCount := 0;

end;

destructor TFifoQueue.Destroy;

begin

 FQueueLock.Free;

 FQueueArray := nil;

end;

function TFifoQueue.FindItem(Item: Pointer; method:

 TCompareQueueItemMethod): Boolean;

var

 i: Integer;

begin

 Result := False;

 if FCount = 0 then Exit;

 FQueueLock.Enter;

 try

   for i := FFirstItemIndex to FLastItemIndex do

     if method(Item, FQueueArray[i]) then

     begin

       Result := True;

       Break;

     end;

 finally

   FQueueLock.Leave;

 end;

end;

function TFifoQueue.GetItem: Pointer;

begin

 Result := nil;

 if FCount = 0 then

   Exit;

 FQueueLock.Enter;

 try

   Result := FQueueArray[FFirstItemIndex];

   Dec(FCount);

   if FCount = 0 then

   begin

     FFirstItemIndex := -1;

     FLastItemIndex := -1;

   end

   else

   begin

     if FFirstItemIndex = FCapacity - 1 then

       FFirstItemIndex := 0

     else

       Inc(FFirstItemIndex);

     if FCount = 1 then

       FLastItemIndex := FFirstItemIndex;

   end;

{$IFNDEF SERVERMODE}

   if Assigned(FOnGetItem) then

     FOnGetItem(Result);

{$ENDIF}

 finally

   FQueueLock.Leave;

 end;

end;

{function TFifoQueue.GetItems(GetNum: Integer): TPointerArray;

var

 ResultNum: Integer;

begin

 ResultNum := Min(GetNum, FCount);

 SetLength(Result, ResultNum);

 FQueueLock.Enter;

 try

   if FFirstItemIndex < FCapacity - 1 then

     FFirstItemIndex := ResultNum - 1

   else

     Inc(FFirstItemIndex, ResultNum);

   Dec(FCount, ResultNum);

   Move(FQueueArray[FFirstItemIndex]);

 finally

   FQueueLock.Leave;

 end;

end;}

function TFifoQueue.PushItem(Item: Pointer): Boolean;

begin

 Result := False;

 if FCount = FCapacity then

   Exit;

 FQueueLock.Enter;

 try

   if FLastItemIndex = FCapacity - 1 then

     FLastItemIndex := 0

   else

     Inc(FLastItemIndex);

   Inc(FCount);

   if FCount = 1 then

     FFirstItemIndex := FLastItemIndex;

   FQueueArray[FLastItemIndex] := Item;

   Result := True;

{$IFNDEF SERVERMODE}

   if Assigned(FOnPushItem) then

     FOnPushItem(Item);

{$ENDIF}

 finally

   FQueueLock.Leave;

 end;

end;

{ TExtendQueue }

procedure TExtendQueue.Clear;

var

 tmp, node: PLinkNode;

begin

 node := FFirstNode;

 while Assigned(node) do

 begin

   tmp := node;

   node := node^.Next;

   Dispose(tmp);

 end;

end;

constructor TExtendQueue.Create;

begin

 FCount := 0;

 FFirstNode := nil;

end;

destructor TExtendQueue.Destroy;

begin

 Clear;

 inherited;

end;

function TExtendQueue.FindItem(Item: Pointer;

 method: TCompareQueueItemMethod): Boolean;

var

 node: PLinkNode;

begin

 Result := False;

 if FCount = 0 then

   Exit

 else

 begin

   node := FFirstNode;

   while Assigned(node) do

   begin

     Result := method(Item, node.Data);

     if Result then

       Break;

     node := node^.Next;

   end;

 end;

end;

function TExtendQueue.PopFindItem(Item: Pointer;

 method: TCompareQueueItemMethod): Pointer;

var

 node: PLinkNode;

begin

 Result := nil;

 if FCount = 0 then

   Exit

 else

 begin

   node := FFirstNode;

   while Assigned(node) do

   begin

     if method(Item, node.Data) then

     begin

       Result := node.Data;

       DeleteNode(node);

       Dec(FCount);

{$IFNDEF SERVERMODE}

       if Assigned(FOnPopItem) then

         FOnPopItem(Result);

{$ENDIF}

       Break;

     end;

     node := node^.Next;

   end;

 end;

end;

function TExtendQueue.GetItem: Pointer;

begin

 if FCount = 0 then

   Result := nil

 else

   Result := FFirstNode^.Data;

end;

procedure TExtendQueue.DeleteNode(node: PLinkNode);

begin

 if Assigned(node^.Prior) then

   node^.Prior^.Next := node^.Next;

 if Assigned(node^.Next) then

   node^.Next^.Prior := node^.Prior;

 if FCount = 1 then

 begin

   FFirstNode := nil;

   FLastNode := nil;

 end

 else

 begin

   if node = FFirstNode then

     FFirstNode := node^.Next;

   if node = FLastNode then

     FLastNode := node^.Prior;

 end;

 Dispose(node);

end;

function TExtendQueue.PopItem: Pointer;

var

 node: PLinkNode;

begin

 if FCount = 0 then

   Result := nil

 else

 begin

   node := FFirstNode;

   Result := node^.Data;

   if FCount = 1 then

   begin

     FLastNode := nil;

     FFirstNode := nil;

   end

   else

   begin

     FFirstNode := node^.Next;

     FFirstNode.Prior := nil;

   end;

   Dec(FCount);

{$IFNDEF SERVERMODE}

 if Assigned(FOnPopItem) then

   FOnPopItem(Result);

{$ENDIF}

   Dispose(node);

 end;

end;

procedure TExtendQueue.PushItem(Item: Pointer);

var

 node: PLinkNode;

begin

 if FCount = 0 then

 begin

   New(FFirstNode);

   FFirstNode^.Data := Item;

   FFirstNode^.Next := nil;

   FFirstNode^.Prior := nil;

   FLastNode := FFirstNode;

 end

 else

 begin

   New(node);

   node^.Data := Item;

   node^.Next := nil;

   node^.Prior := FLastNode;

   FLastNode^.Next := node;

   FLastNode := node;

 end;

 Inc(FCount);

{$IFNDEF SERVERMODE}

 if Assigned(FOnPushItem) then

   FOnPushItem(Item);

{$ENDIF}

end;

end.