Program Design/Delphi2007/RDB2/RDBEvents.pas - master - YakuninAV/Convertors

Program Design/Delphi2007/RDB2/RDBEvents.pas
829 строк22 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
unit RDBEvents;

interface

uses Types,SysUtils,Classes,ComUnit,Obj,RDB2_TLB,Variants;

const

  evt_BeforeCellInput = '1';
  evt_AfterTransmit   = '2';
  evt_CurPrepare      = '3';
  evt_PlugIn          = '4';
  evt_AfterPaste      = '5';
  evt_OnRecalcExtData = '6';
  evt_OnAutoRecalcCell= '7';
  {evt_Custom>= 10000}

type

  PEvCellInputParams = ^TEvCellInputParams;
  TEvCellInputParams = packed record
    Text: string;
  end;

  PAfterTransmitParams= ^TAfterTransmitParams;
  TAfterTransmitParams= packed record
    SourceBook: IBook;
    SourceCursor: IDataCursor;
    SourceField: string;
    Method: string;
  end;

  PEvCurPrepareParams = ^TEvCurPrepareParams;
  TEvCurPrepareParams = packed record
    ID: string;
  end;

  PEvPlugInParams = ^TEvPlugInParams;
  TEvPlugInParams = packed record
    Selection: OleVariant;
  end;

  PEvAfterPasteParams = ^TEvAfterPasteParams;
  TEvAfterPasteParams = packed record
    Pos,Count: integer;
  end;

const
  red_OnCommand = 0;
  red_OnTmpSave = 1;
  red_OnSaveDoc = 2;
  red_OnPrint   = 3;
  red_OnAddAct  = 4;
  red_OnDelAct  = 5;
  red_ChangeFactors = 6;
  
type
  PEvOnRecalExtDataParams = ^TEvOnRecalExtDataParams;
  TEvOnRecalExtDataParams = packed record
    Reason: integer;
  end;

const

  evf_Handle      = 1;
  evf_Error       = 2;
  evf_NoStdAction = 4;

  evs_Default     = 1;
  evs_Fixed       = 2;
  evs_Hidden      = 4;
  evs_Auto        = 8;

type

  TRDBEventLocation= packed record
    EvType,Project,Driver,DocType,TabName,Level,Cell: string;
  end;

  TRDBEvent= packed record
    Location: TRDBEventLocation;
    Document: IBook;
    Table   : IRDBOleTable;
    Actions : string;
    Flags   : integer;
    Params  : pointer;
    Custom  : OleVariant;
  end;

const

  edf_String  = 1;
  edf_Integer = 2;
  edf_Date    = 3;
  edf_Currency= 4;
  edf_Float   = 5;
  edf_Bool    = 6;
  edf_Enum    = 7;
  edf_FileName= 8;

  epf_OnParam = 1;
  epf_OpenAfterExecute = 2;

type

  PRDBHandlerParamInfo= ^TRDBHandlerParamInfo;
  TRDBHandlerParamInfo= packed record
    ParamID: string;
    DataFormat,Style: word;
    Header,Caption,Hint,Default,ValList: string;
    Left,Top,Width,Height: integer;
    Grid: string;
    Flags: word;
    NextParam: PRDBHandlerParamInfo;
  end;

  PRDBHandlerInfo= ^TRDBHandlerInfo;
  TRDBHandlerInfo= packed record
    Location: TRDBEventLocation;
    Action,Name,Caption: string;
    Priority,Status: integer;
    FormWidth,FormHeight: integer;
    ParamsInfo: PRDBHandlerParamInfo;
  end;

  TRDBHandleEventProc= function(var Event: TRDBEvent; const ClientParams: OleVariant): boolean; stdcall;
  TGeTRDBHandlerInfo= function(Index: integer; var Info: OleVariant): TRDBHandleEventProc; stdcall;

const

  EvLocationLen = SizeOf(TRDBEventLocation) div SizeOf(string);
  StdGetInfoProcName= 'GetEventHandlerInfo';

type

  TRDBHandlerList= class;

  TRDBEventHandler= class(TObject)
  private
    FInfo: TRDBHandlerInfo;
    FOwner: TRDBHandlerList;
    function GetParamVal(AIndex: integer): string;
    procedure SetParamVal(AIndex: integer; const AValue: string);
    function GetParamsCount: integer;
  protected
    FClientParams: OleVariant;
    function GetHandlerModuleName: string; virtual; abstract;
    function GetInfoPtr: PRDBHandlerInfo;
  public
    constructor Create(AInfo: TRDBHandlerInfo);
    destructor Destroy; override;
    procedure SetDefaultParamValues;
    property ModuleName: string read GetHandlerModuleName;
    function HandleEvent(var Event: TRDBEvent): boolean; virtual; abstract;
    function GetVarInfo: OleVariant;
    function GetClientVarInfo: OleVariant;
    function GetParamIndex(const AParamID: string): integer;
    property Name: string read FInfo.Name;
    property Caption: string read FInfo.Caption;
    property Action: string read FInfo.Action;
    property Priority: integer read FInfo.Priority;
    property Driver: string read FInfo.Location.Driver;
    property ParamsVal[AIndex: integer]: string read GetParamVal write SetParamVal;
    property ParamsCount: integer read GetParamsCount;
    property ParamsInfo: PRDBHandlerParamInfo read FInfo.ParamsInfo;
    property Status: integer read FInfo.Status;
    property FormWidth: integer read FInfo.FormWidth;
    property FormHeight: integer read FInfo.FormHeight;
    property EventType: string read FInfo.Location.EvType;
    property DocType: string read FInfo.Location.DocType;
    property TabName: string read FInfo.Location.TabName;
    property Level: string read FInfo.Location.Level;
    property Cell: string read FInfo.Location.Cell;
  end;

  TRDBEventHandlerArray= array of TRDBEventHandler;

  TRDBHandlerList=class(TObject)
  private
    FList: TObjectCollector;
  protected
    function AddItem(AHandler: TRDBEventHandler): integer; virtual;
    function GetCount: integer;
    function GetItem(AIndex: integer): TRDBEventHandler;
  public
    constructor Create;
    destructor Destroy; override;
    function GetHandlerIndex(const AModuleName,AHandlerName: string): integer;
    function SelectItems(const ALocation: TRDBEventLocation; AStatus: Integer): TRDBEventHandlerArray;
    function SelectHandles(const ALocation: TRDBEventLocation; AStatus: Integer): TIntegerDynArray;
    property Item[AIndex: integer]: TRDBEventHandler read GetItem;
    property Count: integer read GetCount;
  end;

  TRDBClientHandler=class(TRDBEventHandler)
  private
    FModuleName: string;
    FHandle: integer;
    FEnabled: boolean;
    procedure SetEnabled(Value: boolean);
  protected
    function GetHandlerModuleName: string; override;
  public
    constructor Create(AInfo: TRDBHandlerInfo; const AModuleName: string; AHandle: integer);
    function HandleEvent(var Event: TRDBEvent): boolean; override;
    function HandleVarEvent(var Event: OleVariant): boolean;
    property Enabled: boolean read FEnabled write SetEnabled;
  end;

  TRDBClientDispatcher=class(TRDBHandlerList)
  private
    FServer: IRDB2Server;
    function SelectEquals(const ALocation: TRDBEventLocation;
      const AHandlerAction: string): TList;
  public
    constructor Create(AServer: IRDB2Server);
    function SelectHandlers(const ALocation: TRDBEventLocation): TList;
    function DispatchEvent(var Event: TRDBEvent): integer;
    function DispatchOnServer(var Event: OleVariant; VList: OleVariant): integer;
  end;

function ClientHListToVList(HLst: TList): OleVariant;
procedure CheckEventLocation(var E: TRDBEvent);
function LocItemIn(const LocItem,Loc: string): boolean;
function EvLocationIn(const Location,Container: TRDBEventLocation): boolean;
procedure FreeRDBEventParams(var Event: TRDBEvent);
function RDBEventToVar(const Event: TRDBEvent): OleVariant;
procedure VarToRDBEvent(const VarEvent: OleVariant; var Event: TRDBEvent);
function HandlerInfoToVar(const Info: TRDBHandlerInfo): OleVariant;
procedure VarToHandlerInfo(const VarInfo: OleVariant; var Info: TRDBHandlerInfo);
function HandlersActionCompare(Item1, Item2: Pointer): integer;
function HandlersPriorityCompare(Item1, Item2: Pointer): integer;

implementation

function ClientHListToVList(HLst: TList): OleVariant;
var
  i: integer;
  VLst,PLst: OleVariant;
begin
  if HLst.Count>0 then
    begin
      VLst:=VarArrayCreate([0,HLst.Count-1],varInteger);
      PLst:=VarArrayCreate([0,HLst.Count-1],varVariant);
      for i:=0 to HLst.Count-1 do
        begin
          VLst[i]:=TRDBClientHandler(HLst.Items[i]).FHandle;
          PLst[i]:=TRDBClientHandler(HLst.Items[i]).FClientParams;
        end;
      Result:=VarArrayOf([VLst,PLst]);
    end
      else
    Result:=NULL;
end;

procedure CheckEventLocation(var E: TRDBEvent);
begin
  if E.Location.Project='' then E.Location.Project:=E.Document.ProjName;
  if E.Location.Driver='' then E.Location.Driver:=E.Document.Author;
  if E.Location.DocType='' then E.Location.DocType:=E.Document.TypeName;
  if (E.Location.TabName='') and (E.Table <> nil) then E.Location.TabName:=E.Table.Name;
  if (E.Location.Level='') and (E.Table <> nil) then E.Location.Level:=IntToStr(E.Table.Cursor.Level);
end;

function LocItemIn(const LocItem,Loc: string): boolean;
begin
  Result:=(StrItemIn(LocItem,Loc,',')) or (Loc='') or (LocItem='');
end;

function EvLocationIn(const Location,Container: TRDBEventLocation): boolean;
var
  i: integer;
begin
  Result:=true;
  i:=0;
  while (Result) and (i<EvLocationLen) do
    begin
      Result:=LocItemIn(PStringArray(@Location)[i],PStringArray(@Container)[i]) and Result;
      inc(i);
    end;
end;

function EvLocationEquals(const L1,L2: TRDBEventLocation): boolean;
var
  i: integer;
begin
  Result:=true;
  i:=0;
  while (Result) and (i<EvLocationLen) do
    begin
      Result:=(PStringArray(@L1)[i]=PStringArray(@L2)[i]) and Result;
      inc(i);
    end;
end;

function EvLocationToVar(const EvLocation: TRDBEventLocation): OleVariant;
begin
  Result:=StringsBufToVar(EvLocation,EvLocationLen);
end;

procedure VarToEvLocation(const SourceVar: OleVariant; var EvLocation: TRDBEventLocation);
begin
  VarToStringsBuf(SourceVar,EvLocation);
end;

function EvParamsToVar(const EvType: string; const Params): OleVariant;
begin
  case StrToInt(EvType) of
    1: Result:=TEvCellInputParams(Params).Text;
    2: with TAfterTransmitParams(Params) do
       begin
         Result:=VarArrayCreate([1,4],varVariant);
         Result[1]:=SourceBook;
         Result[2]:=SourceCursor;
         Result[3]:=SourceField;
         Result[4]:=Method;
       end;
    3: Result:=TEvCurPrepareParams(Params).ID;
    4: Result:=TEvPlugInParams(Params).Selection;
    5: with TEvAfterPasteParams(Params) do
       begin
         Result:=VarArrayCreate([1,2],varInteger);
         Result[1]:=Pos;
         Result[2]:=Count;
       end;
    6: Result:=TEvOnRecalExtDataParams(Params).Reason;
  end;
end;

procedure VarToEvParams(const VarParams: OleVariant; const EvType: string; var Params);
begin
  case StrToInt(EvType) of
    1: TEvCellInputParams(Params).Text:=varParams;
    2: with TAfterTransmitParams(Params) do
       begin
         SourceBook:=IDispatch(VarParams[1]) as IBook;
         SourceCursor:=IDispatch(VarParams[2]) as IDataCursor;
         SourceField:=VarParams[3];
         Method:=VarParams[4];
       end;
    3: TEvCurPrepareParams(Params).ID:=varParams;
    4: TEvPlugInParams(Params).Selection:=VarParams;
    5: with TEvAfterPasteParams(Params) do
       begin
         Pos:=VarParams[1];
         Count:=VarParams[2];
       end;
    6: TEvOnRecalExtDataParams(Params).Reason:=VarParams;
  end;
end;

function NewEvParams(const EvType: string): pointer;
begin
  case StrToInt(EvType) of
    1: New(PEvCellInputParams(Result));
    2: New(PAfterTransmitParams(Result));
    3: New(PEvCurPrepareParams(Result));
    4: New(PEvPlugInParams(Result));
    5: New(PEvAfterPasteParams(Result));
    6: New(PEvOnRecalExtDataParams(Result));
    else Result:=nil;
  end;
end;

procedure DisposeEvParams(const EvType: string; var Params: pointer);
begin
  case StrToInt(EvType) of
    1: Dispose(PEvCellInputParams(Params));
    2: Dispose(PAfterTransmitParams(Params));
    3: Dispose(PEvCurPrepareParams(Params));
    4: Dispose(PEvPlugInParams(Params));
    5: Dispose(PEvAfterPasteParams(Params));
    6: Dispose(PEvOnRecalExtDataParams(Params));
  end;
  Params:=nil;
end;

procedure FreeRDBEventParams(var Event: TRDBEvent);
begin
  if Event.Params<>nil then
    DisposeEvParams(Event.Location.EvType,Event.Params);
end;

function RDBEventToVar(const Event: TRDBEvent): OleVariant;
begin
  Result:=VarArrayCreate([1,7],varVariant);
  Result[1]:=EvLocationToVar(Event.Location);
  Result[2]:=Event.Document;
  Result[3]:=Event.Table;
  Result[4]:=Event.Actions;
  Result[5]:=Event.Flags;
  Result[6]:=EvParamsToVar(Event.Location.EvType,Event.Params^);
  Result[7]:=Event.Custom;
end;

procedure VarToRDBEvent(const VarEvent: OleVariant; var Event: TRDBEvent);
begin
  VarToEvLocation(VarEvent[1],Event.Location);
  Event.Document:=IDispatch(VarEvent[2]) as IBook;
  Event.Table:=IDispatch(VarEvent[3]) as IRDBOLETable;
  Event.Actions:=VarEvent[4];
  Event.Flags:=VarEvent[5];
  if Event.Params=nil then Event.Params:=NewEvParams(Event.Location.EvType);
  VarToEvParams(VarEvent[6],Event.Location.EvType,Event.Params^);
  Event.Custom:=VarEvent[7];
end;

function GetHandlerParamsOderLen(Params: PRDBHandlerParamInfo): integer;
var
  P: PRDBHandlerParamInfo;
begin
  Result:=0;
  P:=Params;
  while P<>nil do
    begin
      inc(Result);
      P:=P.NextParam;
    end;
end;

procedure DisposeHandlerParamsOder(var Params: PRDBHandlerParamInfo);
begin
  if Params<>nil then
    begin
      DisposeHandlerParamsOder(Params^.NextParam);
      Dispose(Params);
      Params:=nil;
    end;
end;

function HandlerParamInfoToVar(const Info: TRDBHandlerParamInfo): OleVariant;
begin
  with Info do
    Result:=VarArrayOf([ParamID,DataFormat,Style,Header,Caption,Hint,Default,ValList,Left,Top,Width,Height,Grid,Flags]);
end;

procedure VarToHandlerParamInfo(const VarInfo: OleVariant; var Info: TRDBHandlerParamInfo);
begin
  with Info do
    begin
      ParamID:=VarInfo[0];
      DataFormat:=VarInfo[1];
      Style:=VarInfo[2];
      Header:=VarInfo[3];
      Caption:=Varinfo[4];
      Hint:=Varinfo[5];
      Default:=VarInfo[6];
      ValList:=VarInfo[7];
      Left:=VarInfo[8];
      Top:=VarInfo[9];
      Width:=VarInfo[10];
      Height:=VarInfo[11];
      Grid:=VarInfo[12];
      Flags:=VarInfo[13];
    end;
end;

function HandlerParamsOderToVar(HeadParam: PRDBHandlerParamInfo): OleVariant;
var
  L,i: integer;
  P: PRDBHandlerParamInfo;
begin
  if HeadParam<>nil then
    begin
      P:=HeadParam;
      L:=GetHandlerParamsOderLen(P);
      Result:=VarArrayCreate([1,L],varVariant);
      for i:=1 to L do
        begin
          Result[i]:=HandlerParamInfoToVar(P^);
          P:=P^.NextParam;
        end;
    end
      else
    Result:=NULL;
end;

function VarToHandlerParamsOder(const VarParams: OleVariant): PRDBHandlerParamInfo;
var
  L,H,i: integer;
  P: PRDBHandlerParamInfo;
begin
  if not(VarIsNULL(VarParams)) then
    begin
      L:=VarArrayLowBound(VarParams,1);
      H:=VarArrayHighBound(VarParams,1);
      New(Result);
      VarToHandlerParamInfo(VarParams[L],Result^);
      P:=Result;
      for i:=L+1 to H do
        begin
          New(P^.NextParam);
          P:=P^.NextParam;
          VarToHandlerParamInfo(VarParams[i],P^);
        end;
      P^.NextParam:=nil;
    end
      else
    Result:=nil;
end;

function HandlerInfoToVar(const Info: TRDBHandlerInfo): OleVariant;
begin
  Result:=VarArrayCreate([1,9],varVariant);
  Result[1]:=EvLocationToVar(Info.Location);
  Result[2]:=Info.Action;
  Result[3]:=Info.Name;
  Result[4]:=Info.Caption;
  Result[5]:=Info.Priority;
  Result[6]:=Info.Status;
  Result[7]:=Info.FormWidth;
  Result[8]:=Info.FormHeight;
  Result[9]:=HandlerParamsOderToVar(Info.ParamsInfo);
end;

procedure VarToHandlerInfo(const VarInfo: OleVariant; var Info: TRDBHandlerInfo);
begin
  VarToEvLocation(VarInfo[1],Info.Location);
  Info.Action:=VarInfo[2];
  Info.Name:=VarInfo[3];
  Info.Caption:=VarInfo[4];
  Info.Priority:=VarInfo[5];
  Info.Status:=VarInfo[6];
  Info.FormWidth:=VarInfo[7];
  Info.FormHeight:=VarInfo[8];
  Info.ParamsInfo:=VarToHandlerParamsOder(VarInfo[9]);
end;

function HandlersActionCompare(Item1, Item2: Pointer): integer;
begin
  Result:=CompareStr(TRDBEventHandler(Item1).Action,TRDBEventHandler(Item2).Action);
end;

function HandlersPriorityCompare(Item1, Item2: Pointer): integer;
begin
  Result:=TRDBEventHandler(Item1).Priority-TRDBEventHandler(Item2).Priority;
end;

{ TRDBEventHandler }

constructor TRDBEventHandler.Create(AInfo: TRDBHandlerInfo);
var
  PC: integer;
begin
  FInfo:=AInfo;
  PC:=GetParamsCount;
  if PC>0 then
    begin
      FClientParams:=VarArrayCreate([0,PC-1],varOleStr);
      SetDefaultParamValues;
    end
      else
    FClientParams:=NULL;
end;

function TRDBEventHandler.GetInfoPtr: PRDBHandlerInfo;
begin
  Result:=@FInfo;
end;

function TRDBEventHandler.GetVarInfo: OleVariant;
begin
  Result:=HandlerInfoToVar(FInfo);
end;

function TRDBEventHandler.GetClientVarInfo: OleVariant;
begin
  Result:=VarArrayCreate([0,1],varVariant);
  Result[0]:=GetVarInfo;
  Result[1]:=ModuleName;
end;

destructor TRDBEventHandler.Destroy;
begin
  DisposeHandlerParamsOder(FInfo.ParamsInfo);
  inherited;
end;

function TRDBEventHandler.GetParamsCount: integer;
begin
  Result:=GetHandlerParamsOderLen(FInfo.ParamsInfo);
end;

procedure TRDBEventHandler.SetDefaultParamValues;
var
  i: integer;
  P: PRDBHandlerParamInfo;
begin
  P:=FInfo.ParamsInfo;
  i:=0;
  while P<>nil do
    begin
      FClientParams[i]:=P^.Default;
      P:=P^.NextParam;
      inc(i);
    end;
end;

function TRDBEventHandler.GetParamVal(AIndex: integer): string;
begin
  Result:=FClientParams[AIndex];
end;

procedure TRDBEventHandler.SetParamVal(AIndex: integer; const AValue: string);
begin
  FClientParams[AIndex]:=AValue;
end;

function TRDBEventHandler.GetParamIndex(const AParamID: string): integer;
var
  P: PRDBHandlerParamInfo;
begin
  P:=FInfo.ParamsInfo;
  Result:=0;
  while (P<>nil) and (P^.ParamID<>AParamID) do
    begin
      P:=P.NextParam;
      inc(Result);
    end;
  if P=nil then Result:=-1;
end;

{ TRDBHandlerList }

function TRDBHandlerList.AddItem(AHandler: TRDBEventHandler): integer;
begin
  AHandler.FOwner:=Self;
  Result:=FList.Add(AHandler);
end;

constructor TRDBHandlerList.Create;
begin
  FList:=TObjectCollector.Create(16);
end;

destructor TRDBHandlerList.Destroy;
begin
  FList.Free;
  inherited;
end;

function TRDBHandlerList.GetCount: integer;
begin
  Result:=FList.Count;
end;

function TRDBHandlerList.GetHandlerIndex(const AModuleName,
  AHandlerName: string): integer;
var
  i: integer;
  M,H: string;
begin
  M:=AnsiUpperCase(AModuleName);
  H:=AnsiUpperCase(AHandlerName);
  i:=0; Result:=-1;
  while (Result<0) and (i<FList.Count) do
    begin
      if (AnsiUpperCase(Item[i].Name)=H) and
        (AnsiUpperCase(Item[i].ModuleName)=M) then Result:=i;
      inc(i);
    end;
end;

function TRDBHandlerList.GetItem(AIndex: integer): TRDBEventHandler;
begin
  Result:=FList.Items[AIndex];
end;

function TRDBHandlerList.SelectItems(const ALocation: TRDBEventLocation; AStatus: Integer): TRDBEventHandlerArray;
var
  I,L: Integer;
begin
  SetLength(Result,Count);
  L:=0;
  for I:=0 to Length(Result)-1 do
    if ((Item[I].Status and AStatus)=AStatus) and EvLocationIn(ALocation,Item[I].FInfo.Location) then
      begin
        Result[L]:=Item[I];
        Inc(L);
      end;
  SetLength(Result,L);
end;

function TRDBHandlerList.SelectHandles(const ALocation: TRDBEventLocation; AStatus: Integer): TIntegerDynArray;
var
  I,L: Integer;
begin
  SetLength(Result,Count);
  L:=0;
  for I:=0 to Length(Result)-1 do
    if ((Item[I].Status and AStatus)=AStatus) and EvLocationIn(ALocation,Item[I].FInfo.Location) then
      begin
        Result[L]:=I;
        Inc(L);
      end;
  SetLength(Result,L);
end;

{ TRDBClientHandler }

constructor TRDBClientHandler.Create(AInfo: TRDBHandlerInfo;
  const AModuleName: string; AHandle: integer);
begin
  inherited Create(AInfo);
  FModuleName:=AModuleName;
  FHandle:=AHandle;
end;

function TRDBClientHandler.GetHandlerModuleName: string;
begin
  Result:=FModuleName;
end;

function TRDBClientHandler.HandleEvent(var Event: TRDBEvent): boolean;
var
  E: OleVariant;
begin
  E:=RDBEventToVar(Event);
  Result:=HandleVarEvent(E);
  VarToRDBEvent(E,Event);
end;

function TRDBClientHandler.HandleVarEvent(var Event: OleVariant): boolean;
var
  VLst,PLst,OLst: OleVariant;
begin
  VLst:=VarArrayCreate([0,0],varInteger);
  VLst[0]:=FHandle;
  PLst:=VarArrayCreate([0,0],varVariant);
  PLst[0]:=FClientParams;
  OLst:=VarArrayOf([VLst,PLst]);
  Result:=TRDBClientDispatcher(FOwner).FServer.DispatchEvent(Event,OLst)>0;
end;

procedure TRDBClientHandler.SetEnabled(Value: boolean);
var
  HL: TList;
  i: integer;
begin
  if Value=FEnabled then Exit;
  if Value then
    begin
      HL:=TRDBClientDispatcher(FOwner).SelectEquals(FInfo.Location,Action);
      for i:=0 to HL.Count-1 do
        TRDBClientHandler(HL.Items[i]).FEnabled:=false;
      HL.Free;
    end;
  FEnabled:=Value;
end;

{ TRDBClientDispatcher }

constructor TRDBClientDispatcher.Create(AServer: IRDB2Server);
var
  VLst,VInfo: OleVariant;
  L,H,i: integer;
  Cur: TRDBClientHandler;
  HInfo: TRDBHandlerInfo;
begin
  inherited Create;
  FServer:=AServer;
  VLst:=FServer.GetHandlersList;
  if not(VarIsNull(VLst)) then
    begin
      L:=VarArrayLowBound(VLst,1);
      H:=VarArrayHighBound(VLst,1);
      for i:=L to H do
        begin
          VInfo:=VLst[i];
          VarToHandlerInfo(VInfo[0],HInfo);
          Cur:=TRDBClientHandler.Create(HInfo,VInfo[1],i);
          AddItem(Cur);
          Cur.Enabled:=Cur.FInfo.Status and evs_Default>0;
        end;
    end;
end;

function TRDBClientDispatcher.SelectHandlers(const ALocation: TRDBEventLocation): TList;
var
  i: integer;
begin
  Result:=TList.Create;
  for i:=0 to Count-1 do
    if TRDBClientHandler(Item[i]).FEnabled and EvLocationIn(ALocation,Item[i].FInfo.Location) then
      Result.Add(Item[i]);
end;

function TRDBClientDispatcher.SelectEquals(const ALocation: TRDBEventLocation;
  const AHandlerAction: string): TList;
var
  i: integer;
begin
  Result:=TList.Create;
  for i:=0 to Count-1 do
    with TRDBClientHandler(Item[i]) do
      if FEnabled and (Action=AHandlerAction) and EvLocationEquals(ALocation,FInfo.Location) then
        Result.Add(Item[i]);
end;

function TRDBClientDispatcher.DispatchEvent(var Event: TRDBEvent): integer;
var
  HLst: TList;
  E,VLst: OleVariant;
begin
  CheckEventLocation(Event);
  HLst:=SelectHandlers(Event.Location);
  if HLst.Count>0 then
    begin
      VLst:=ClientHListToVList(HLst);
      E:=RDBEventToVar(Event);
      Result:=FServer.DispatchEvent(E,VLst);
      VarToRDBEvent(E,Event);
    end
      else
    begin
      Event.Flags:=Event.Flags and not(evf_Handle or evf_NoStdAction);
      Event.Actions:='';
      Result:=0;
    end;
  HLst.Free;
end;

function TRDBClientDispatcher.DispatchOnServer(var Event: OleVariant;
  VList: OleVariant): integer;
begin
  Result:=FServer.DispatchEvent(Event,VList);
end;

end.