home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 1999 March
/
Chip_1999-03_cd.bin
/
zkuste
/
delphi
/
INFO
/
DI9806BL.ZIP
/
Intf
/
Server
/
ChatChannel.pas
next >
Wrap
Pascal/Delphi Source File
|
1998-05-08
|
5KB
|
193 lines
{ *****************************************************************************
Implementing COM Component Callbacks in Delphi
Code written for Delphi Informant publication
Comments, questions, suggestions?
Binh Ly, Systems Analyst (bly@brickhouse.com)
Brickhouse Data Systems (http://www.brickhouse.com)
*****************************************************************************
}
unit ChatChannel;
interface
uses
ComObj, ActiveX, ChatServer_TLB, Classes;
type
TChatUsers = class;
TChatChannel = class (TAutoObject, IChatChannel)
protected
{ IChatChannel }
function ConnectUser(const Callback: IChatEvent; var UserId: Integer): WordBool; safecall;
function DisconnectUser(UserId: Integer): WordBool; safecall;
procedure BroadcastMessage (const UserName, Message: WideString); safecall;
protected
FUsers : TChatUsers;
procedure Initialize; override;
public
destructor Destroy; override;
property Users : TChatUsers read FUsers;
end;
TChatUser = class
public
UserId : integer;
Callback : IChatEvent;
end;
TChatUsers = class
protected
FItems : TList;
FLastUserId : integer;
function GetItems (i : integer) : TChatUser;
public
constructor Create;
destructor Destroy; override;
function AddUser (const Callback: IChatEvent; var UserId : integer): boolean;
function DeleteUser (UserId : integer) : boolean;
function FindUser (UserId : integer) : integer;
function Count : integer;
property Items [i : integer] : TChatUser read GetItems; default;
end;
const
MainChatChannel : IChatChannel = NIL;
implementation
uses
ComServ
;
{ TChatChannel }
function TChatChannel.ConnectUser(const Callback: IChatEvent; var UserId: Integer): WordBool;
begin
{ connect new client and return connection id (UserId) }
Result := Users.AddUser (Callback, UserId);
end;
function TChatChannel.DisconnectUser(UserId: Integer): WordBool;
begin
{ disconnect client using specified connection id }
Result := Users.DeleteUser (UserId);
end;
procedure TChatChannel.BroadcastMessage (const UserName, Message: WideString);
var
i : integer;
begin
{ loops through all client connections and issues the callback message broadcast }
for i := 0 to Users.Count - 1 do
begin
try
Users [i].Callback.GotMessage (UserName, Message);
except
{ if error happened, this callback client probably disconnected
prematurely; therefore we just ignore the error and process all
remaining clients.
}
end; { except }
end; { for }
end;
procedure TChatChannel.Initialize;
begin
inherited;
{ create TChatUsers list helper }
FUsers := TChatUsers.Create;
end;
destructor TChatChannel.Destroy;
begin
{ destroy TChatUsers list helper }
FUsers.Free;
inherited;
end;
{ TChatUsers }
function TChatUsers.GetItems (i : integer) : TChatUser;
begin
{ returns a single TChatUser by index }
Result := TChatUser (FItems.Items [i]);
end;
constructor TChatUsers.Create;
begin
inherited;
{ create internal TChatUsers list }
FItems := TList.Create;
end;
destructor TChatUsers.Destroy;
var
i : integer;
begin
{ destroy internal TChatUsers list }
for i := 0 to Count - 1 do
Items [i].Free;
FItems.Free;
inherited;
end;
function TChatUsers.AddUser (const Callback: IChatEvent; var UserId : integer): boolean;
var
User : TChatUser;
begin
{ add a new TChatUser to the internal list and returns a unique UserId to caller }
inc (FLastUserId);
UserId := FLastUserId;
User := TChatUser.Create;
User.UserId := FLastUserId;
User.Callback := Callback;
FItems.Add (User);
Result := TRUE;
end;
function TChatUsers.DeleteUser (UserId : integer) : boolean;
var
i : integer;
begin
{ remove a TChatUser item from the list by UserId }
Result := FALSE;
i := FindUser (UserId);
if (i >= 0) then begin
Items [i].Free;
FItems.Delete (i);
Result := TRUE;
end; { if }
end;
function TChatUsers.FindUser (UserId : integer) : integer;
var
i : integer;
begin
{ locate a TChatUser item in the list by UserId }
Result := -1;
for i := 0 to Count - 1 do
if (Items [i].UserId = UserId) then begin
Result := i;
Break;
end; { if }
end;
function TChatUsers.Count : integer;
begin
{ returns the number of TChatUser items in the list }
Result := FItems.Count;
end;
initialization
TAutoObjectFactory.Create(ComServer, TChatChannel, Class_ChatChannel, ciInternal);
end.