uinterlockedlist.pas

定时扫描局域网络中的电脑的Mac地址情况

//
//  Copyright (c) 2002 by Max Koudelkin
//  Commercial use requires permission.
//  E-mail to: [e-mail]
//

unit uInterlockedList;

interface

uses
  Classes;

type
  PInterlockedEntryRec = ^TInterlockedEntryRec;
  TInterlockedEntryRec = record
    Link  : PInterlockedEntryRec;    //指向下一记录
    Data  : Pointer;
    Owner : Pointer;
  end;

  //链表类
  TInterlockedList = class
  private
    FRootRec : TInterlockedEntryRec;
  protected
    FRoot : PInterlockedEntryRec;
    FLast : PInterlockedEntryRec;
  protected
    function InternalPop : PInterlockedEntryRec; virtual; abstract;
    procedure InternalPush( AEntry : PInterlockedEntryRec ); virtual;
    function InternalFlush : PInterlockedEntryRec; virtual;
  public
    constructor Create;
    destructor Destroy; override;

    function Pop : Pointer;            //从链表删除结点
    procedure Push( AData : Pointer ); //向链表增加结点
    procedure Flush;
  end;

  TInterlockedLIFO = class( TInterlockedList )
  protected
    function InternalPop : PInterlockedEntryRec; override;
  end;

  TInterlockedFIFO = class( TInterlockedList )
  protected
    function InternalPop : PInterlockedEntryRec; override;
  public
    function PopList : TList; overload;
    procedure PopList( AList : TList ); overload;
  end;

implementation

uses
  Windows;

  //交换 Vtarget 和AValue的值，并返回新的AValue的值
function InterlockedExchangeEntry(
  var VTarget : PInterlockedEntryRec;
      AValue  : PInterlockedEntryRec ) : PInterlockedEntryRec; stdcall; forward;

function InterlockedExchangeEntry; external Windows.kernel32 name 'InterlockedExchange';

resourcestring
  SInvalidOperation = 'Invalid operation, use PopList instead';

{ TInterlockedList }

constructor TInterlockedList.Create;
begin
  inherited;
  FRoot := @FRootRec;   //根结点
  FRoot^.Link := FRoot;
  FRoot^.Data := nil;
  InternalFlush;
end;

destructor TInterlockedList.Destroy;
begin
  Flush;
  inherited;
end;

procedure TInterlockedList.Flush;
var LEntry, LLink : PInterlockedEntryRec;
begin
  LEntry := InternalFlush;
  while LEntry <> FRoot do
  begin
    LLink := LEntry^.Link;
    if LEntry.Owner = Self then
      Dispose( LEntry );
    LEntry := LLink;
  end;
end;

function TInterlockedList.Pop : Pointer;
var LEntry : PInterlockedEntryRec;
begin
  LEntry := InternalPop;
  if LEntry <> FRoot then
  begin
    Result := LEntry.Data;
    if LEntry.Owner = Self then
      Dispose( LEntry );
  end
  else
    Result := nil;
end;

procedure TInterlockedList.Push( AData : Pointer );
var LEntry : PInterlockedEntryRec;
begin
  New( LEntry );
  LEntry^.Data := AData;
  LEntry^.Owner := Self;
  InternalPush( LEntry );
end;

function TInterlockedList.InternalFlush : PInterlockedEntryRec;
var
  i: Integer;
begin
  Result := InterlockedExchangeEntry( FLast, FRoot );
end;

procedure TInterlockedList.InternalPush( AEntry : PInterlockedEntryRec );
begin
  AEntry^.Link := InterlockedExchangeEntry( FLast, AEntry );
end;

{ TInterlockedLIFO }

function TInterlockedLIFO.InternalPop : PInterlockedEntryRec;
begin
  Result := InterlockedExchangeEntry( FLast, FLast.Link );
end;

{ TInterlockedFIFO }

function TInterlockedFIFO.InternalPop : PInterlockedEntryRec;
begin
  raise EInvalidOperation.CreateRes( @SInvalidOperation );
end;

procedure TInterlockedFIFO.PopList( AList : TList );
var LCount : Integer; LTop, LEntry : PInterlockedEntryRec;
begin
  LCount := 0;
  LTop := InternalFlush;
  LEntry := LTop;
  while LEntry <> FRoot do
  begin
    Inc( LCount );
    LEntry := LEntry^.Link;
  end;
  AList.Clear;
  AList.Count := LCount;
  for LCount := AList.Count - 1 downto 0 do
  begin
    AList.Items[LCount] := LTop^.Data;
    LEntry := LTop^.Link;
    if LTop.Owner = Self then
      Dispose( LTop );
    LTop := LEntry;
  end;
end;

function TInterlockedFIFO.PopList : TList;
begin
  Result := TList.Create;
  PopList( Result );
end;

end.