IConnectionPoint.Advise Problem, always the same cookie ;-(

[Ingo Düppe]

Hello,

After I readed the tutorial from Binh Ly, I tried to programm my own
Event-Interface.
But now I have a problem with the IConnectionPoint.Advise Methode. It
returns always
with the same cookie "1". (I guess the cookie should be unique, doesn't it?)

When I understood it correctly, then the Advise-Methode checks in the
procedure ObjQueryInterface if the Interface is supported by the
Container-Interface.
Is this right?

Can anyone tell me why I always get the same cookie in the following code?

Server-Unit :

TKassmatServer = class(TAutoObject, IKassmatServer)
protected
procedure ConnectUser(const Computer, Username: WideString; var UserID:
Integer; const Callback: IKassmatEvent); safecall;
procedure DisconnectUser(UserID: Integer); safecall;
protected
fUsers : TConnectionPoints;
fEventSinks : TConnectionPoint;
function ObjQueryInterface(const IID: TGUID; out Obj):Integer;override;
private
procedure Initialize; override;
destructor Destroy; override;
end;

TKassmatConnect = class (TAutoObject, IKassmatConnect)
protected
function Get_KassmatServer: IKassmatServer; safecall;
procedure ConnectUser(const Callback: IKassmatEvent; const Computer,
Username: WideString); safecall;
procedure Initialize; override;
destructor Destroy; override;
private
fUserId : Longint;
end;

var
MainKassmatServer : IKassmatServer = nil;
ClientConnected : Integer = 0;
implementation

uses ComServ, MainFormUnit, dmUnit;

procedure TKassmatConnect.Initialize;
begin
inherited;
if MainKassmatServer=nil then MainKassmatServer:=CoKassmatServer.Create;
end;

destructor TKassmatConnect.Destroy;
begin
MainKassmatServer.DisconnectUser(fUserID);
dec(ClientConnected);
MainForm.Connections.Caption:=IntToStr(ClientConnected);
if ClientConnected=0 then MainKassmatServer:=nil;
inherited;
end;

function TKassmatConnect.Get_KassmatServer: IKassmatServer;
begin
result:=MainKassmatServer;
end;

procedure TKassmatConnect.ConnectUser(const Callback: IKassmatEvent; const
Computer, Username: WideString);
begin
inc(ClientConnected);
MainKassmatServer.ConnectUser(Computer,UserName,fUserID,Callback);
MainForm.Connections.Caption:=IntToStr(ClientConnected);
end;

procedure TKassmatServer.Initialize;
begin
inherited;
fUsers:=TConnectionPoints.Create(Self);
fEventSinks:=fUsers.CreateConnectionPoint(IKassmatEvent, ckMulti,Nil);
end;

destructor TKassmatServer.Destroy;
begin
fEventSinks.Destroy;
fUsers.Destroy;
inherited;
end;

function TKassmatServer.ObjQueryInterface(const iid: TGuid; out
obj):Integer;
begin
result:=inherited ObjQueryInterface(IID,Obj);
if not Succeeded(Result) then
if fUsers.GetInterface(IID,obj) then Result:=s_ok
end;

procedure TKassmatServer.ConnectUser(const Computer, Username: WideString;
var UserID: Integer; const Callback: IKassmatEvent);
begin
OleCheck((fEventSinks as IConnectionPoint).Advise(Callback as
IUnknown,UserID));
MainForm.AddUser(Computer,UserName,UserID);
end;

procedure TKassmatServer.DisconnectUser(UserID: Integer);
begin
MainForm.DelUser(UserId);
OleCheck((fEventSinks as IConnectionPoint).UnAdvise(UserID));
end;

Client-Unit:

unit ConnectUnit;

interface
uses Windows, SysUtils, ComObj, Classes, Kassmat98Server_TLB;

type

TOnDataChange = procedure (Data:OleVariant) of object;
TOnInUseChange = procedure (Data:OleVariant) of object;
TKassmatEvent = class (TAutoIntfObject, IKassmatEvent)

protected
procedure MandantAndKasseDataChange(Data: OleVariant); safecall;
procedure InUseChange(Data: OleVariant); safecall;

private
fOnDataChange : TOnDataChange;
fOnInUseChange : TOnInUseChange;

public
constructor Create;
property OnDataChange : TOnDataChange read fOnDataChange write
fOnDataChange;
property OnInUseChange : TOnInUseChange read fOnInUseChange write
fOnInUseChange;
end;

var ServerConnect : IKassmatConnect;
KassmatServer : IKassmatServer;
KassmatEvent : TKassmatEvent;

procedure ConnectToServer;
procedure DisConnectFromServer;

implementation

uses ActiveX;

constructor TKassmatEvent.Create;
var
ifTypeLib : ITypeLib;
begin
OleCheck (LoadRegTypeLib(LIBID_Kassmat98Server, 1, 0, 0, ifTypeLib));
inherited Create (ifTypeLib, IKassmatEvent);
_AddRef;
end;

procedure TKassmatEvent.MandantAndKasseDataChange(Data:OleVariant);
begin
if Assigned(OnDataChange) then OnDataChange(Data);
end;

procedure TKassmatEvent.InUseChange(Data:OleVariant);
begin
if Assigned(OnInUseChange) then OnInUseChange(Data);
end;

procedure ConnectToServer;
var ComputerName : PChar;
UserName : PChar;
buf : Integer;
begin
KassmatEvent:=TKassmatEvent.Create;
ComputerName:=StrAlloc(Max_ComputerName_Length+1);
UserName:=StrAlloc(31);
buf:=Max_ComputerName_Length+1;
GetComputerName(ComputerName,buf);
buf:=30;
GetUserName(UserName,buf);
ServerConnect:=CoKassmatConnect.Create;
ServerConnect.ConnectUser(KassmatEvent as
IKassmatEvent,WideString(ComputerName),WideString (UserName));
KassmatServer:=ServerConnect.KassmatServer;
StrDispose(ComputerName);
StrDispose(UserName);
end;

procedure DisConnectFromServer;
begin
if ServerConnect<>nil then ServerConnect:=nil;
KassmatEvent.destroy;
end;

Greetings

Ingo

[Scott Samet [TeamB]]

If you don't get a response, I suggest you boil your code down to a smaller
example. Most of the people with the expertise to assist your are probably
not willing to search thru such a large code sample.

Ingo Düppe wrote in message <6e8hbr$ca...@forums.borland.com>...

[Conrad Herrmann]

Are you using an old version of Delphi? There was a bug in D3.0 where a
connection point wouldn't permit more than one connection... It's fixed in
D3.01, I think.

-- Conrad Herrmann

[Ingo Düppe]

>If you don't get a response, I suggest you boil your code down to a smaller
>example. Most of the people with the expertise to assist your are probably
>not willing to search thru such a large code sample.

Hello

Sorry, but I just wanted to give all needed information, well
I tried to boil my code to a smaller one.

But their is still the same problem:

TKassmatServer = class(TAutoObject, IKassmatServer)
protected
procedure ConnectUser(const Computer, Username: WideString; var UserID:
Integer; const Callback: IKassmatEvent); safecall;
procedure DisconnectUser(UserID: Integer); safecall;
protected
fUsers : TConnectionPoints;
fEventSinks : TConnectionPoint;
function ObjQueryInterface(const IID: TGUID; out Obj):Integer;override;
private
procedure Initialize; override;

end;

// In this procedure I always get the same cookie from Advise;

procedure TKassmatServer.ConnectUser(const Computer, Username: WideString;
var UserID: Integer; const Callback: IKassmatEvent);
begin
OleCheck((fEventSinks as IConnectionPoint).Advise(Callback as
IUnknown,UserID));

end;

// Here I get a exception, well I call twice with the same cookie
procedure TKassmatServer.DisconnectUser(UserID: Integer);
begin
OleCheck((fEventSinks as IConnectionPoint).UnAdvise(UserID));
end;

procedure TKassmatServer.Initialize;
begin
inherited;
fUsers:=TConnectionPoints.Create(Self);
fEventSinks:=fUsers.CreateConnectionPoint(IKassmatEvent, ckMulti,Nil);
end;

destructor TKassmatServer.Destroy;
begin
fEventSinks.Destroy;
fUsers.Destroy;
inherited;
end;

function TKassmatServer.ObjQueryInterface(const iid: TGuid; out
obj):Integer;
begin
result:=inherited ObjQueryInterface(IID,Obj);
if not Succeeded(Result) then
if fUsers.GetInterface(IID,obj) then Result:=s_ok
end;

Thanx

Ingo