udispatcher.pas

多数代码可以直接在Delphi6和Delphi7环境下运行。部分涉及.NET技术内容的代码

unit uDispatcher;

interface

uses SysUtils, Classes, Messages, uMessageConsts, IniFiles;

type
  TMessageHandler = procedure (var aMessage : TMessage) of object;

  TDispatcher = class(TObject)
  private
    Handlers : array[1..100] of TMessageHandler;

    function GetBaseIndex(const iMessageID : Integer) : Integer;
    procedure DoAddHandler(const idx : Integer; aHandler : TMessageHandler);
  public
    Constructor Create;
    Procedure SendMessage(var aMessage : TMessage);
    Procedure SendMessage2(var aMessage : TMessage);
    function AddHandler(const iMessageID : Integer; aHandler : TMessageHandler) : Integer;
    function AddSHandler(const iMessageStr : String; aHandler : TMessageHandler) : Integer;
    function HashOf(const Key: string): Cardinal;
  end;

implementation

{ TDispatcher }

function TDispatcher.AddHandler(const iMessageID: Integer;
  aHandler: TMessageHandler) : Integer;
begin
  Result := GetBaseIndex(iMessageID);
  if (Result <> -1) then
    DoAddHandler(Result, aHandler);
end;

function TDispatcher.AddSHandler(const iMessageStr: String;
  aHandler: TMessageHandler): Integer;
begin
  Result := HashOf(iMessageStr) mod 100;
  if (Result <> -1) then
    DoAddHandler(Result, aHandler);
end;

constructor TDispatcher.Create;
var
  idx : Integer;
begin
  for idx := 1 to 100 do    // Iterate
  begin
    Handlers[idx] := nil;
  end;    // for
end;

procedure TDispatcher.DoAddHandler(const idx : Integer;
  aHandler: TMessageHandler);
begin
  Handlers[idx] := aHandler;
end;

function TDispatcher.GetBaseIndex(const iMessageID: Integer): Integer;
begin
  Result := iMessageID - MY_BASE;
end;

function TDispatcher.HashOf(const Key: string): Cardinal;
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(Key) do
    Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor
      Ord(Key[I]);
end;

procedure TDispatcher.SendMessage(var aMessage: TMessage);
var
  ptr : TMessageHandler;
begin
  ptr := Handlers[GetBaseIndex(aMessage.Msg)];
  if (Assigned(ptr)) then
    ptr(aMessage);
end;

procedure TDispatcher.SendMessage2(var aMessage: TMessage);
var
  ptr : TMessageHandler;
begin
  ptr := Handlers[aMessage.msg];
  if (Assigned(ptr)) then
    ptr(aMessage);
end;

end.