Email服务器

开发平台：
Delphi

XPEvent.pas：源码内容
							unit XPEvent;
{
 $Source: /cvsroot/dunit/dunit/Contrib/DUnitWizard/Source/Common/XPEvent.pas,v $
 $Revision: 1.2 $
 $Date: 2004/05/03 15:07:15 $
 Last amended by $Author: pvspain $
 $State: Exp $
 XPEvent:  Base interfaces and classes for management of events with
              multiple listeners (event handlers)
 Events covered: TXPEvent (no arguments)
Unit entry points:
  function CreateIXPEventMulticaster: IXPEventMulticaster;
 Copyright (c) 2001 by The Excellent Programming Company Pty Ltd
 (Australia) (ABN 27 005 394 918).
 Contact Paul Spain via email: paul@xpro.com.au
 This unit is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
 License as published by the Free Software Foundation; either
 version 2.1 of the License, or (at your option) any later version.
 This unit is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 Lesser General Public License for more details.
 You should have received a copy of the GNU Lesser General Public
 License along with this unit; if not, the license can be viewed at:
 http://www.gnu.org/copyleft/lesser.html
 or write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 Boston, MA  02111-1307  USA
}
interface
type
  // Base interface
  IXPCount = interface(IUnknown)
    ['{50D5B041-28A7-11D5-A292-00608CF441D9}']
    function Count: integer;
    end;
/////////////////////////////////////////////////////////////////////////////
///   Base classes TXPEventMulticaster, TXPRefEventMulticaster declaration
/////////////////////////////////////////////////////////////////////////////
type
  TXPEvent = procedure of object;
  TXPEvents = array of TXPEvent;
  IXPEventMulticaster = interface(IXPCount)
    ['{ADE449D1-294B-11D5-8CAD-0080ADB62643}']
    procedure Add(const Handler: TXPEvent);
    function Insert(const Handler: TXPEvent;
      const idx: integer): integer;
    procedure Delete(const Handler: TXPEvent);
    function Handler: TXPEvent;
    end;
function CreateIXPEventMulticaster: IXPEventMulticaster;
type
  // Class to manage multiple event handlers for a single event
  // <TXPEvent> is a necessarily generic method pointer
  //
  // Users should subclass from TXPEventMulticaster for each event type to
  // be handled:
  // * Overwrite Add(), Insert() and Delete() with wrappers taking
  //   arguments of the correct event type for the subclass and invoking
  //   the inherited namesake method with a TXPEvent-cast
  //   argument.
  // * Overwrite Notify() with a method of the same signature
  //   as the subclass event type. This method must iterate over the content
  //   of Events, casting each item to the subclass event type and
  //   executing with the arguments passed in to subclassed Notify().
  //   Typically, the base class Notify is never called. It is provided
  //   as a minimal template, and the off-chance someone needs a Multicaster
  //   with an event signature of TXPEvent.
  // * Implement Handler(), which returns the address of subclassed Notify()
  //
  // Users of the subclass must:
  // * Call the subclasses' Notify() with appropriate arguments to trigger
  //   the event. When plugging into a standard component event, this can
  //   be done indirectly by assigning Handler to the event,
  //   eg Button1.OnClick := FNotifyMulticaster.Handler
  //
  // Clients of a subclass object must:
  // * Register/deregister interest in the event by calling Add() or Insert()
  //   and Delete() respectively with an appropriately typed event handler
  //   argument.
  TXPEventMulticaster = class(TInterfacedObject, IXPCount, IXPEventMulticaster)
    private
    FEvents: TXPEvents;
    FCount: integer;
    FIncSize: integer;
    procedure DeleteIdx(const idx: integer);
    function Find(const Handler: TXPEvent; out idx: integer): boolean;
    protected
    function Count: integer;
    // Returns 0-based resultant index of inserted <Handler>;
    // -1 for nil <Handler>
    function Insert(const Handler: TXPEvent; const idx: integer): integer;
    // Append <Handler> to array elements
    procedure Add(const Handler: TXPEvent);
    procedure Delete(const Handler: TXPEvent);
    // Fire all event handlers in array
    procedure Notify;
    function Handler: TXPEvent;
    procedure Clear;
    property Events: TXPEvents read FEvents;
    public
    constructor Create(const InitSize: integer = 4;
      const IncSize: integer = 4);
    destructor Destroy; override;
    end;
  // Behaviour for events with arguments passed by reference
  // raShortCircuit:
  //   Event propagation stops with first handler to modify argument(s).
  // raIsolationFirstChanged:
  //   Every handler gets the original arguments. The values from
  //   the first handler to *modify* the arguments (else original
  //   arguments) are returned to the event origin.
  // raIsolationFirst:
  //   Every handler gets the original arguments. The values from
  //   the first handler are returned to the event origin.
  // raPropagation:
  //   The (modified) arguments are propagated from handler to
  //   handler. The resultant values are returned to the event
  //   origin.
  TXPRefArgs = (raShortCircuit, raIsolationFirstChanged, raIsolationFirst,
    raPropagation);
  TXPRefEventMulticaster = class(TXPEventMulticaster)
    protected
    FBehaviour: TXPRefArgs;
    public
    constructor Create(const Behaviour: TXPRefArgs = raShortCircuit;
      InitSize: integer = 4; const IncSize: integer = 4);
    end;
implementation
uses
  SysUtils;
  
const
  CVSID = '$Header: /cvsroot/dunit/dunit/Contrib/DUnitWizard/Source/Common/XPEvent.pas,v 1.2 2004/05/03 15:07:15 pvspain Exp $';
/////////////////////////////////////////////////////////////////////////////
///           TXPEventMulticaster implementation
/////////////////////////////////////////////////////////////////////////////
constructor TXPEventMulticaster.Create(const InitSize, IncSize: integer);
  begin
  inherited Create;
  FIncSize := IncSize;
  System.SetLength(FEvents, InitSize);
  end;
destructor TXPEventMulticaster.Destroy;
  begin
  FEvents := nil; // dealloc array
  inherited;
  end;
procedure TXPEventMulticaster.Add(const Handler: TXPEvent);
  begin
  Insert(Handler, FCount);
  end;
procedure TXPEventMulticaster.Delete(const Handler: TXPEvent);
  var
  idx: integer;
  begin
  if Find(Handler, idx) then
    DeleteIdx(idx);
  end;
procedure TXPEventMulticaster.Notify;
  var
  idx: integer;
  begin
  // Iterate over all handlers and execute
  // Subclass versions of Notify() must type-cast the handler (Events[idx])
  // and supply arguments as necessary.
    for idx := 0 to FCount - 1 do
      Events[idx];
  end;
procedure TXPEventMulticaster.DeleteIdx(const idx: integer);
  begin
  if idx < FCount - 1 then
    begin
    // Move remainder of array down to cover 'empty' slot
    System.Move(FEvents[idx + 1], FEvents[idx],
      (FCount - idx - 1) * System.SizeOf(TXPEvent));
    end;
  System.Dec(FCount);
  end;
function TXPEventMulticaster.Find(const Handler: TXPEvent;
  out idx: integer): boolean;
  begin
  idx := 0;
  // Comparing by @Method only compares first pointer <Code> of a
  // method procedural type. Need to compare both <Code> and <Data>
  while (idx < FCount)
    and ((TMethod(Handler).Code <> TMethod(FEvents[idx]).Code)
      or (TMethod(Handler).Data <> TMethod(FEvents[idx]).Data)) do
    System.Inc(idx);
  Result := (idx < FCount);
  end;
function TXPEventMulticaster.Insert(const Handler: TXPEvent;
  const idx: integer): integer;
  begin
  // This check will bail and return the index of the handler
  // if present
  if (not Find(Handler, Result)) and Assigned(Handler) then
    begin
    // Check if we've hit the ceiling, and increment array size if
    // necessary.
    if FCount > High(FEvents) then
      SetLength(FEvents, Length(FEvents) + FIncSize);
    // Check for insertion point outside range
    // and clip if necessary.
    if idx < 0 then
      Result := 0
    else if idx < FCount then
      Result := idx
    else
      Result := FCount;
    if Result < FCount then
      begin
      // Move remainder of array up to make an  empty slot at <Result>.
      System.Move(FEvents[Result], FEvents[Result + 1],
        (FCount - Result) * SizeOf(TXPEvent));
      end;
    // Insert handler and increase array entries count.
    FEvents[Result] := Handler;
    System.Inc(FCount);
    end;
  end;
function TXPEventMulticaster.Count: integer;
  begin
  Result := FCount;
  end;
function TXPEventMulticaster.Handler: TXPEvent;
  begin
  Result := Notify;
  end;
procedure TXPEventMulticaster.Clear;
  begin
  FCount := 0;
  end;
function CreateIXPEventMulticaster: IXPEventMulticaster;
  begin
  Result := TXPEventMulticaster.Create;
  end;
/////////////////////////////////////////////////////////////////////////////
///           TXPRefEventMulticaster implementation
/////////////////////////////////////////////////////////////////////////////
constructor TXPRefEventMulticaster.Create(const Behaviour: TXPRefArgs;
  InitSize: integer; const IncSize: integer);
  begin
  inherited Create(InitSize, IncSize);
  FBehaviour := Behaviour;
  end;
end.

						