How can I trigger an event to different clients from a Automation server?
I tried to do this with TSyncs and TConnectionPoint container.
I have been able to trigger an event to only one client using both (TSyncs
and TConnectionPoints)
TIA.
This is my code:
unit UGSMServer;
interface
uses
ComObj, ActiveX, AxCtrls, Classes, IPSGSMSv_TLB, StdVcl;
type
TGSMServer = class(TAutoObject, IConnectionPointContainer, IGSMServer)
private
{ Private declarations }
FConnectionPoints: TConnectionPoints;
FConnectionPoint: TConnectionPoint;
FSinkList: TList;
FEvents: IGSMServerEvents;
FActive: boolean;
function GetEnumerator: IEnumConnections;
procedure SendActive;
procedure SendInactive;
public
FObjectID: integer;
procedure Initialize; override;
destructor Destroy; override;
protected
{ Protected declarations }
property ConnectionPoints: TConnectionPoints read FConnectionPoints
implements IConnectionPointContainer;
procedure EventSinkChanged(const EventSink: IUnknown); override;
function Get_Actiu: Shortint; safecall;
procedure Set_Actiu(Value: Shortint); safecall;
end;
implementation
uses ComServ, Dialogs, Inicial, SysUtils;
procedure TGSMServer.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as IGSMServerEvents;
if FConnectionPoint <> nil then
FSinkList := FConnectionPoint.SinkList;
end;
procedure TGSMServer.Initialize;
begin
inherited Initialize;
FConnectionPoints := TConnectionPoints.Create(Self);
if AutoFactory.EventTypeInfo <> nil then begin
FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
AutoFactory.EventIID, ckMulti, EventConnect);
end
else FConnectionPoint := nil;
FActiu := false;
if FEvents <> nil then SendInactiu;
RegisterActiveObject(self as IUnknown, CLASS_GSMServer, ACTIVEOBJECT_WEAK,
FObjectID);
end;
destructor TGSMServer.Destroy;
begin
RevokeActiveObject(FObjectID, nil);
inherited Destroy;
end;
function TGSMServer.Get_Active: Shortint;
begin
if FActive then
Result := 0
else
Result := 1;
end;
procedure TGSMServer.Set_Active(Value: Shortint);
begin
if Value = 0 then begin
FActive := true;
if FEvents <> nil then SendActive;
end
else begin
FActive := false;
if FEvents <> nil then SendInactive;
end;
end;
function TGSMServer.GetEnumerator: IEnumConnections;
var
Container: IConnectionPointContainer;
ConnectionPoint: IConnectionPoint;
begin
OleCheck(QueryInterface(IConnectionPointContainer,Container));
OleCheck(Container.FindConnectionPoint(AutoFactory.EventIID,ConnectionPoint)
);
ConnectionPoint.EnumConnections(Result);
end;
procedure TGSMServer.SendActive;
var
Enum: IEnumConnections;
ConnectData: TConnectData;
Fetched: Cardinal;
begin
Enum := GetEnumerator;
if Enum <> nil then begin
while Enum.Next(1,ConnectData, @Fetched) = S_OK do
if ConnectData.pUnk <> nil then
(ConnectData.pUnk as IGSMServerEvents).OnActive;
end;
end;
procedure TGSMServer.SendInactive;
var
Enum: IEnumConnections;
ConnectData: TConnectData;
Fetched: Cardinal;
begin
Enum := GetEnumerator;
if Enum <> nil then begin
while Enum.Next(1,ConnectData, @Fetched) = S_OK do
if ConnectData.pUnk <> nil then
(ConnectData.pUnk as IGSMServerEvents).OnInActive;
end;
end;
initialization
TAutoObjectFactory.Create(ComServer, TGSMServer, Class_GSMServer,
ciMultiInstance, tmSingle);
end.