Quote
> No, sorry, I suspect the problem is deeper than what you've described, and
> is likely a bug in your code somewhere.
<sigh> yes well I guess deep down I already knew that.
What I'm doing is building a fancy VCL wrapper around the MSAgent server
object (not the ActiveX client but the server). I've implemented the event
sink as in the folloing code and I'm pretty sure the problem ls with my
implementation of the event sink object/Interface because as long as I don't
create and register the sink then unregister and nil I never get the IDE
shut down errors . What I suspect most is what I've done with the IDispatch
methods.
I'd be really grateful if you or someone else here could comment on my code
and tell me where I went wrong.
ToaAgentNotifySink = class(TInterfacedObject, IAgentNotifySink)
private
fAgent: ToaAgent;
protected
{IDispatch methods}
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer):
HResult; stdcall;
{IAgentNotifySink methods}
procedure Command(dwCommandID: Integer; const punkUserInput: IUnknown);
SafeCall;
procedure ActivateInputState(dwCharID: Integer; bActivated: Integer);
SafeCall;
procedure Restart; SafeCall;
procedure Shutdown; SafeCall;
procedure VisibleState(dwCharID: Integer; bVisible: Integer; dwCause:
Integer); SafeCall;
procedure Click(dwCharID: Integer; fwKeys: Smallint; x: Integer; y:
Integer); SafeCall;
procedure DblClick(dwCharID: Integer; fwKeys: Smallint; x: Integer; y:
Integer); SafeCall;
procedure DragStart(dwCharID: Integer; fwKeys: Smallint; x: Integer; y:
Integer); SafeCall;
procedure DragComplete(dwCharID: Integer; fwKeys: Smallint; x: Integer;
y: Integer); SafeCall;
procedure RequestStart(dwRequestID: Integer); SafeCall;
procedure RequestComplete(dwRequestID: Integer; hrStatus: Integer);
SafeCall;
procedure BookMark(dwBookMarkID: Integer); SafeCall;
procedure Idle(dwCharID: Integer; bStart: Integer); SafeCall;
procedure Move(dwCharID: Integer; x: Integer; y: Integer; dwCause:
Integer); SafeCall;
procedure Size(dwCharID: Integer; lWidth: Integer; lHeight: Integer);
SafeCall;
procedure BalloonVisibleState(dwCharID: Integer; bVisible: Integer);
SafeCall;
public
constructor create(Agent: ToaAgent);
end;
Implementation
constructor ToaAgentNotifySinkEx.create(Agent: ToaAgent);
begin
inherited create;
fAgent := Agent;
end;
function ToaAgentNotifySinkEx.GetTypeInfoCount(out Count: Integer): HResult;
begin
Count := 1;
Result := S_OK;
end;
function ToaAgentNotifySinkEx.GetTypeInfo(Index, LocaleID: Integer; out
TypeInfo): HResult;
var
Lib: ITypeLib;
begin
Pointer(TypeInfo) := nil;
if Index <> 0 then
begin
Result := TYPE_E_ELEMENTNOTFOUND;
Exit;
end;
result := LoadRegTypeLib(LIBID_AgentServerObjects, 1, 0, 0, Lib);
If result <> S_OK then exit;
result := Lib.GetTypeInfoOfGuid(IID_IAgentNotifySink,
ITypeInfo(TypeInfo));
end;
function ToaAgentNotifySinkEx.GetIDsOfNames(const IID: TGUID; Names:
Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
var
Info : ITypeInfo;
begin
// IID must be NULL
if not IsEqualIID(IID, GUID_NULL) then
begin
result := HResult(DISP_E_UNKNOWNINTERFACE);
exit;
end;
// Get the TypeInfo for the specified lcid
result := GetTypeInfo(0, LocaleID, Info);
if result <> S_OK then exit;
// Use the TypeInfo to get the DISPIDs of the specified names.
// That's the whole point here. Let TypeInfo do the work so
// we don't have to.
result := Info.GetIDsOfNames(Names, NameCount, DispIDs);
end;
function ToaAgentNotifySinkEx.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
var
Info : ITypeInfo;
begin
// The iid parameter is always supposed to be NULL
if not IsEqualIID(IID, GUID_NULL) then
begin
result := HResult(DISP_E_UNKNOWNINTERFACE);
exit;
end;
// Get the TypeInfo for the specified lcid
result := GetTypeInfo(0, LocaleID, Info);
if result <> S_OK then exit;
// Clear exceptions
SetErrorInfo(0, nil);
Result := Info.Invoke(pointer(integer(Self)), dispID, Flags,
TDispParams(Params), VarResult,
ExcepInfo, ArgErr);
end;
procedure ToaAgentNotifySink.Command(dwCommandID: Integer; const
punkUserInput: IUnknown);
begin
fAgent.Command(dwCommandID, punkUserInput);
end;
procedure ToaAgentNotifySink.ActivateInputState(dwCharID: Integer;
bActivated: Integer);
begin
fAgent.ActivateInputState(dwCharID, bActivated);;
end;
procedure ToaAgentNotifySink.Restart;
begin
// no longer suppoerted by MSAgent
ShowMessage('Restart event, this should never fire');
end;
procedure ToaAgentNotifySink.Shutdown;
begin
// no longer suppoerted by MSAgent
ShowMessage('Shutdown event, this should never fire');
end;
procedure ToaAgentNotifySink.VisibleState(dwCharID: Integer; bVisible:
Integer; dwCause: Integer);
begin
fAgent.VisibleState(dwCharID, bVisible, dwCause);
end;
procedure ToaAgentNotifySink.Click(dwCharID: Integer; fwKeys: Smallint; x:
Integer; y: Integer);
begin
fAgent.Click(dwCharID, fwKeys, x, y);
end;
procedure ToaAgentNotifySink.DblClick(dwCharID: Integer; fwKeys: Smallint;
x: Integer; y: Integer);
begin
fAgent.DblClick(dwCharID, fwKeys, x, y);
end;
procedure ToaAgentNotifySink.DragStart(dwCharID: Integer; fwKeys: Smallint;
x: Integer; y: Integer);
begin
fAgent.DragStart(dwCharID, fwKeys, x, y);
end;
procedure ToaAgentNotifySink.DragComplete(dwCharID: Integer; fwKeys:
Smallint; x: Integer; y: Integer);
begin
fAgent.DragComplete(dwCharID, fwKeys, x, y);
end;
procedure ToaAgentNotifySink.RequestStart(dwRequestID: Integer);
begin
fAgent.RequestStart(dwRequestID);
end;
procedure ToaAgentNotifySink.RequestComplete(dwRequestID: Integer; hrStatus:
Integer);
begin
fAgent.RequestComplete(dwRequestID, hrStatus);
end;
procedure ToaAgentNotifySink.BookMark(dwBookMarkID: Integer);
begin
fAgent.BookMark(dwBookMarkID);
end;
procedure ToaAgentNotifySink.Idle(dwCharID: Integer; bStart: Integer);
begin
fAgent.Idle(dwCharID, bStart);
end;
procedure ToaAgentNotifySink.Move(dwCharID: Integer; x: Integer; y: Integer;
dwCause: Integer);
begin
fAgent.Move(dwCharID, x, y, dwCause);
end;
procedure ToaAgentNotifySink.Size(dwCharID: Integer; lWidth: Integer;
lHeight: Integer);
begin
fAgent.SizeChange(dwCharID, lWidth, lHeight);
end;
procedure ToaAgentNotifySink.BalloonVisibleState(dwCharID: Integer;
bVisible: Integer);
begin
fAgent.BalloonVisibleState(dwCharID, bVisible);
end;
